awemu.pas

测试用例

(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                    AWEMU.PAS 4.06                     *}
{*********************************************************}
{* Deprecated terminal emulation                         *}
{*********************************************************}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$F+}

unit AwEmu;
  {-Abstract emulator and all derived emulators}

interface

uses
  WinTypes,
  WinProcs,
  SysUtils,
  OoMisc;

type
  TEmuCommandLo = record
    Ch      : Char;                 {Character}
    Cmd     : Byte;                 {Command}
    X, Y    : Byte;                 {Coordinates}
    FColor  : Byte;                 {Foreground color}
    BColor  : Byte;                 {Background color}
    ExtAttr : Byte;                 {Extended attributes}
    EmuType : Byte;                 {Emulator Type}
    {BCB cannot handle a small string in a variant record}
    case Byte of
      1 : (Other  : array[1..MaxOther] of Byte);  {Other data}
    {$IFDEF AProBCB}
      2 : (OtherStrLen : Byte;
           OtherStr  : array[1..10] of Char);  {Other data}
    {$ELSE}
      2 : (OtherStr : String[10]);
    {$ENDIF}
  end;

  {Emulator callback function type}
  TProcessCharProcLo = procedure(PAnsiEmulator: Pointer; C: Char;
                                 var Command: TEmuCommandLo);

  TKeyEmuCommandLo = record
    KeyCode       : Word;
    ShiftMap      : Word;
    ToggleMap     : Word;
    Extended      : Bool;
    KeyMapped     : Bool;
    KeyboardState : TKeyBoardState;
    Value         : string[KeyMappingLen];
  end;

  TProcessKeyProcLo = procedure(PKeyEmulator: Pointer; Key: Word;
                                var Command: TKeyEmuCommandLo);

function aeInitAnsiEmulator(var P : PAnsiEmulator) : Bool;
procedure aeDoneAnsiEmulator(var P : PAnsiEmulator);
procedure aeProcessAnsiChar(P : Pointer; C : Char;
                            var Command : TEmuCommandLo);

procedure aeOptionsOn(P : PAnsiEmulator; Options : Word);
procedure aeOptionsOff(P : PAnsiEmulator; Options : Word);
function  aeOptionsAreOn(P : PAnsiEmulator; Options : Word) : Bool;

const
  {Default colors}
  aweDefForeground = emWhite;
  aweDefBackground = emBlack;

implementation

const
  {Special parser characters for ANSI escape sequences}
  Escape = #27;
  LeftBracket = #91;
  Semicolon = #59;
  FormFeed = #12;

  {Bit settings for emuAttr}
  attrBlink      = $01;
  attrInverse    = $02;
  attrIntense    = $04;
  attrInvisible  = $08;
  attrUnderline  = $10;

  {Emulator types}
  etNone      = 0;
  etANSI      = 1;
  etVT52      = 2;
  etVT100     = 3;
  etANSIBBS   = 4;

  procedure aeOptionsOn(P : PAnsiEmulator; Options : Word);
    {-Enable options}
  begin
    with P^ do
      if Options and teMapVT100 <> 0 then
        emuType := etVT100
      else
        emuType := etANSIBBS;
  end;

  procedure aeOptionsOff(P : PAnsiEmulator; Options : Word);
    {-Disable options}
  begin
    with P^ do
      if Options and teMapVT100 <> 0 then
        emuType := etANSIBBS
      else
        emuType := etVT100;
  end;

  function  aeOptionsAreOn(P : PAnsiEmulator; Options : Word) : Bool;
    {-Return True if all bits in Options are currently set}
  begin
    with P^ do
      if Options and teMapVT100 <> 0 then
        aeOptionsAreOn := emuType = etVT100
      else
        aeOptionsAreOn := False;
  end;

  function aeInitAnsiEmulator(var P : PAnsiEmulator) : Bool;
    {-Initialize an ansi emulator}
  begin
    P := AllocMem(SizeOf(TAnsiEmulator));
    aeInitAnsiEmulator := True;
    with P^ do begin
      emuFlags := 0;
      emuFirst := True;
      emuAttr  := 0;
      emuIndex := 0;
      emuParamIndex := 1;
      FillChar(emuParamStr, SizeOf(emuParamStr), 0);
      emuParserState := GotNone;
    end;
  end;

  procedure aeDoneAnsiEmulator(var P : PAnsiEmulator);
    {-Destroy the emulator}
  begin
    FreeMem(P, SizeOf(TAnsiEmulator));
  end;

  procedure aePutQueue(P : PAnsiEmulator; C : Char);
    {-Save characters}
  begin
    with P^ do begin
      if emuIndex < MaxQueue then begin
        Inc(emuIndex);
        emuQueue[emuIndex] := C;
      end;
    end;
  end;

  procedure aeInitParser(P : PAnsiEmulator);
    {-Reset parser state}
  begin
    with P^ do begin
      emuParamIndex := 1;
      FillChar(emuParamStr, SizeOf(emuParamStr), 0);
      emuParserState := GotNone;
      emuIndex := 0;
    end;
  end;

  procedure aeBuildParam(P : PAnsiEmulator; C : Char);
    {-Build a param string}
  begin
    with P^ do
      emuParamStr[emuParamIndex] := emuParamStr[emuParamIndex] + C;
  end;

  procedure aeConvertParams(P : PAnsiEmulator; C : Char);
    {-Convert param strings to integers}
  var
    I, Code : Integer;
  begin
    with P^ do begin
      for I := 1 to MaxParams do begin
        Val(emuParamStr[I], emuParamInt[I], Code);
        if Code <> 0 then
          emuParamInt[I] := 1;

        {-handle default parameters for default modes}
        if (Length(emuParamStr[1]) = 0) then begin
          if (C in ['J', 'K']) then
            if (emuType = etANSI) or (emuType = etVT100) or
               (emuType = etANSIBBS) then
              emuParamInt[1] := 0
            else
              emuParamInt[1] := 2
          {-if no paramater for the SGR state, then set it to 0}
          else if (C = 'm') then
            emuParamInt[1] := 0;
        end;
      end;
    end;
  end;

  procedure ProcessANSIEmulation(P : PAnsiEmulator; var Command: TEmuCommandLo);
  var
    I : Byte;
  begin
    with P^, Command do begin
      case Ch of
        'A' :
          begin
           {Cursor up}
            Cmd := eCUU; {eUp}
            Y := emuParamInt[1];
          end;
        'B' :
          begin
            {Cursor down}
            Cmd := eCUD; {eDown, eVPR}
            Y := emuParamInt[1];
          end;
        'a' ,
        'C' :
          begin
            {Cursor right}
            Cmd := eCUF; {eRight, eHPR}
            X := emuParamInt[1];
          end;
        'D' :
          begin
            {Cursor left}
            cmd := eCUB; {eLeft}
            X := emuParamInt[1];
          end;
        'E' :
          begin
            {Cursor next line}
            Cmd := eCNL;
            Y := emuParamInt[1];
          end;
        'F' :
          begin
            {Cursor preceding line}
            Cmd := eCPL;
            Y := emuParamInt[1];
          end;
        'G', '`' :
          begin
            {Cursor horizontal absolute}
            Cmd := eCHA; {eHPA}
            X := emuParamInt[1];
          end;
        'H' :
          begin
            {Cursor position}
            Cmd := eCUP;{eGotoXY, eHVP}
            X   := emuParamInt[2];
            Y   := emuParamInt[1];
          end;
        'I' :
          begin
            {Cursor horizontal tabulation}
            Cmd := eCHT;
            X := emuParamInt[1];
          end;
        'J' :
          begin
            {Erase in Display}
            Cmd := eED;
            X := emuParamInt[1];
            Y := 0;
          end;
       'K' :
         begin
           {Erase in line}
           X := emuParamInt[1];
           Y := 1;
           Cmd := eEL;
         end;
        'L' :
          begin
            {Insert line}
            Cmd := eIL;
            Y := emuParamInt[1];
          end;
        'M' :
          begin
            {Delete line}
            Cmd := eDL;
            Y := emuParamInt[1];
          end;
        'N' :
          begin
            {Erase in field}
            Cmd := eEF;
            X := emuParamInt[1];
          end;
        'O' :
          begin
            {Erase in area}
            Cmd := eEA;
            X := emuParamInt[1];
          end;
        'P' :
          begin
            {Delete character}
            Cmd := eDCH;
            X := emuParamInt[1];
          end;
        'Q' :
          begin
            {selected editing extent mode}
            Cmd := eSEM;
            X := emuParamInt[1];
          end;
        'R' :
          begin
            {cursor position report}
            Cmd := eCPR;
            X := emuParamInt[2];
            Y := emuParamInt[1];
          end;
        'S' :
          begin
            {Scroll up}
            Cmd := eSU;
            Y := emuParamInt[1];