adtrmemu.pas

Async Professional 4.04

      property ParentColor;
      property ParentCtl3D;
      property ParentFont;
      property TabOrder;
      property TabStop;
      property Visible;
      property Width;
      property PopupMenu;                                              

      {publish ancestor's events}
      property OnClick;
      property OnDblClick;
      property OnExit;
      property OnKeyDown;
      property OnKeyPress;
      property OnKeyUp;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;

  end;

type
  TAdTTYEmulator = class(TAdTerminalEmulator)
    private
      FCellWidths    : PAdIntegerArray;
      FDisplayStr    : PAnsiChar;
      FDisplayStrSize: integer;
      FPaintFreeList : pointer;
      FRefresh       : Boolean;

    protected
      {property accessor methods}
      function teGetNeedsUpdate : boolean; override;

      {overridden ancestor methods}
      procedure teClear; override;
      procedure teClearAll; override;
      procedure teSetTerminal(aValue : TAdCustomTerminal); override;

      {miscellaneous}
      function  ttyCharToCommand (aCh : AnsiChar) : TAdEmuCommand;     {!!.04}
      procedure ttyDrawChars(aRow, aStartCol, aEndCol : integer;
                             aVisible : boolean);

      {paint node methods}
      procedure ttyExecutePaintScript(aRow    : integer;
                                      aScript : pointer);
      procedure ttyFreeAllPaintNodes;
      procedure ttyFreePaintNode(aNode : pointer);
      function ttyNewPaintNode : pointer;

    public
      constructor Create(aOwner : TComponent); override;
      destructor Destroy; override;

      {overridden ancestor methods}
      procedure KeyPress(var Key : AnsiChar); override;
      procedure LazyPaint; override;
      procedure Paint; override;
      procedure ProcessBlock (aData : pointer; aDataLen : longint;     {!!.04}
                              CharSource : TAdCharSource); override;   {!!.04}
    published
      property OnProcessChar;                                          {!!.04}
  end;

type
  TAdVT100Emulator = class(TAdTerminalEmulator)
    private
      FAnswerback     : string;
      FBlinkers       : pointer;
      FBlinkFreeList  : pointer;
      FCellWidths     : PAdIntegerArray;
      FDisplayStr     : PAnsiChar;
      FDisplayStrSize : integer;
      FDispUpperASCII : boolean;
      FLEDs           : integer;
      FLineAttrArray  : TObject;
      FPaintFreeList  : pointer;
      FRefresh        : boolean;
      FSecondaryFont  : TFont;

      {modes}
      FANSIMode         : boolean;
      FAppKeyMode       : boolean;
      FAppKeypadMode    : boolean;
      FAutoRepeat       : boolean;
      FCol132Mode       : boolean;
      FGPOMode          : boolean;{graphics proc.option not supported}
      FInsertMode       : boolean;
      FInterlace        : boolean;{interlace chgs are not supported}
      FNewLineMode      : boolean;
      FRelOriginMode    : boolean;
      FRevScreenMode    : boolean;
      FSmoothScrollMode : boolean;{smooth scrolling is not supported}
      FWrapAround       : boolean;

      {character sets}
      FUsingG1   : boolean;                                   
      FG0CharSet : integer;
      FG1CharSet : integer;

    protected
      { Answerback Property Maintenance }                              {!!.04}
      procedure DefineProperties (Filer : TFiler); override;           {!!.04}
      function IsAnswerbackStored: Boolean;                            {!!.04}
      procedure ReadAnswerback (Reader : TReader);                     {!!.04}
      procedure WriteAnswerback (Writer : TWriter);                    {!!.04}
      {property accessor methods}
      function teGetNeedsUpdate : boolean; override;
      procedure vttSetCol132Mode(aValue : boolean);
      procedure vttSetRelOriginMode(aValue : boolean);
      procedure vttSetRevScreenMode(aValue : boolean);

      {overridden ancestor methods}
      procedure teClear; override;
      procedure teClearAll; override;
      procedure teSetTerminal(aValue : TAdCustomTerminal); override;

      {miscellaneous}
      procedure vttDrawChars(aRow, aStartVal, aEndVal : integer;
                             aVisible : boolean;
                             aCharValues : boolean);
      procedure vttProcessCommand;
      function vttGenerateDECREPTPARM(aArg : integer) : string;
      procedure vttInvalidateRow(aRow : integer);
      procedure vttProcess8bitChar(aCh : AnsiChar);
      procedure vttScrollRowsHandler(aSender : TObject;
                                     aCount, aTop, aBottom : integer);
      procedure vttToggleNumLock;

      {blink node methods}
      procedure vttCalcBlinkScript;
      procedure vttClearBlinkScript;
      procedure vttDrawBlinkOffCycle(aRow, aStartCh, aEndCh : integer);
      procedure vttFreeAllBlinkNodes;
      procedure vttFreeBlinkNode(aNode : pointer);
      function vttNewBlinkNode : pointer;

      {paint node methods}
      procedure vttExecutePaintScript(aRow    : integer;
                                      aScript : pointer);
      procedure vttFreeAllPaintNodes;
      procedure vttFreePaintNode(aNode : pointer);
      function vttNewPaintNode : pointer;

    public
      constructor Create(aOwner : TComponent); override;
      destructor Destroy; override;

      {overridden ancestor methods}
      procedure BlinkPaint(aVisible : boolean); override;
      function HasBlinkingText : boolean; override;
      procedure KeyDown(var Key : word; Shift: TShiftState); override;
      procedure KeyPress(var Key : AnsiChar); override;
      procedure LazyPaint; override;
      procedure Paint; override;
      procedure ProcessBlock (aData : pointer; aDataLen : longint;     {!!.04}
                              CharSource : TAdCharSource); override;   {!!.04}

      {modes}
      property ANSIMode : boolean
                  read FANSIMode write FANSIMode;
      property AppKeyMode : boolean
                  read FAppKeyMode write FAppKeyMode;
      property AppKeypadMode : boolean
                  read FAppKeypadMode write FAppKeypadMode;
      property AutoRepeat : boolean
                  read FAutoRepeat write FAutoRepeat;
      property Col132Mode : boolean
                  read FCol132Mode write vttSetCol132Mode;
      property GPOMode : boolean
                  read FGPOMode write FGPOMode;
      property InsertMode : boolean
                  read FInsertMode write FInsertMode;
      property Interlace : boolean
                  read FInterlace write FInterlace;
      property NewLineMode : boolean
                  read FNewLineMode write FNewLineMode;
      property RelOriginMode : boolean
                  read FRelOriginMode write vttSetRelOriginMode;
      property RevScreenMode : boolean
                  read FRevScreenMode write vttSetRevScreenMode;
      property SmoothScrollMode : boolean
                  read FSmoothScrollMode write FSmoothScrollMode;
      property WrapAround : boolean
                  read FWrapAround write FWrapAround;

      {miscellaneous}
      property LEDs : integer
                  read FLEDs write FLEDs;

    published
      property Answerback : string
                  read FAnswerback write FAnswerback;
      property DisplayUpperASCII : boolean
                  read FDispUpperASCII write FDispUpperASCII;
      property OnProcessChar;                                          {!!.04}
  end;

implementation

{$IFDEF TRIALRUN}
  {$I TRIAL07.INC}
  {$I TRIAL03.INC}
  {$I TRIAL01.INC}
{$ENDIF}

const
  BeatInterval = 100;

type
  PBlinkNode = ^TBlinkNode;
  TBlinkNode = packed record
    bnNext    : PBlinkNode;
    bnRow     : integer;
    bnStartCh : integer;
    bnEndCh   : integer;
  end;

type
  PPaintNode = ^TPaintNode;
  TPaintNode = packed record
    pnNext : PPaintNode;
    pnStart: integer;              {start column of range}
    pnEnd  : integer;              {end column of range}
    pnFore : TColor;               {foreground color for range}
    pnBack : TColor;               {background color for range}
    pnAttr : TAdTerminalCharAttrs; {attributes for range}
    pnCSet : byte;                 {charset for range}
  end;

const
  VT52DeviceAttrs  = #27'/Z';      {"VT100 acting as VT52"}
  VT100DeviceAttrs = #27'[?1;0c';  {"Base VT100, no options"}
  VT100StatusRpt   = #27'[0n';     {"terminal OK"}
  VT100CursorPos   = #27'[%d;%dR'; {"cursor is at row;col"}
  VT100ReportParm  = #27'[%d;%d;%d;%d;%d;%d;%dx';
                                   {report terminal parameters}

const
  VT100CharSetNames : array [0..4] of string =
                      ('VT100-USASCII',           {charset 0}
                       'VT100-UK',                {charset 1}
                       'VT100-linedraw',          {charset 2}
                       'VT100-ROM1',              {charset 3}
                       'VT100-ROM2');             {charset 4}


{===Terminal/Emulator links==========================================}
type
  PTermEmuLink = ^TTermEmuLink;
  TTermEmuLink = record
    telNext : PTermEmuLink;
    telTerm : TAdCustomTerminal;
    telEmu  : TAdTerminalEmulator;
  end;
{--------}