[Back to ANSI SWAG index]  [Back to Main SWAG index]  [Original]

{ ANSI_IO  [ANSI Input / Output Unit]

  Written: 01/15/97-01/31/97
  Author: Chad Moore
  Requirements:
    - 80386+ CPU
    - Color CGA+ video adaptor (for 80x25C Textmode)
    - Borland Turbo Pascal 6.0+ to compile
    Recommended System:
    - Color VGA video adaptor (for extended textmodes such as 80x50
      or 80x43 on EGA)
  Notes:
    - This unit currently does not support changing the current video
      mode.  If you would like to enter a different mode such as 80x28,
      80x30, 80x35, 80x43, 80x50, or 80x60 you must use a different
      unit or your own code.
    - When using the virtual screen set up for direct video output, all
      cursor movements are still virtual.  The actual text cursor will
      not be modified by this program.  (This does not hinder the unit
      in any way.)
    - To modify the screen size for direct video output, simply modify
      the constant values below.
  History:
    v1.00: 01/15/97-01/20/97
      - Features:
        þ Object oriented code
        þ Error handling
        þ Buffered output (for scrolling)
        þ Also supports direct video output
    v1.01: 01/21/97
      - FIXED: cursor positioning errors
      - FIXED: error handling errors
    v1.02: 01/23/97
      - UPDATED: Changed 'ANSIHandlerObj.WriteCh' to support
        CR/LF characters.
      - FIXED: virtical wrap-around errors
      - UPDATED: direct virtual screen routines _may_ support any
        screen type (ex: 80x25, 80x43, 80x50), including non-standard
        modes (ex: 80x28, 80x30)
      - UPDATED: added "scrolling" to direct video output
    v1.03: 01/26/97-01/28/97
      - FIXED: 'ANSIHandlerObj.ClearFromCursorToEndOfLine' only worked
        when 'VirtualScreen.Cursor.Y' was equal to 0.
      - UPDATED: virtual screen routines were optomized-- some routines
        were written in inline ASM, some lookup constants were added
        to speed up some routines.
      - UPDATED: 286 instructions for faster virtualscreen writing.
      - UPDATED: removed a lot of "if" statements by adding a
        single video screen size constant.
    v1.04: 01/28/97-01/31/97
      - Features:
        þ ANSI routines for both input and output.  These routines
          can be used for converting an image -> ANSI code or ANSI
          codes -> an image!
        þ Much faster routines for faster loading and displaying!
      - UPDATED: Changed 'VirtualScreenObj.WriteCh' to support
        CR/LF characters.
      - FIXED: WriteCh (ansi) didn't support the 'H' or 'f' commands
        w/o parameters.  (now defaults to 1,1)
      - UPDATED: 386 instructions for faster virtualscreen writing.

  Compiled with Borland International's Turbo Pascal 7.0 for DOS.
  Tested on an Intel 486SX-20MHz system w/ a color VGA display.

  Disclaimer:

  There is no garentee that comes with this source code; the author of
  this unit is NOT responsible for any direct or indirect damages
  caused by this program.  Use it at your own risk.

  Contacting the author:

  NOTE: All comments/questions/suggestions are welcome!  Also, any
        additions or modifications are welcome!

  Chad Moore can be reached via Internet e-mail at: war@usaor.net

  Or send a letter to: Chad Moore
                       535 Mellon Ave.
                       Rochester, PA
                       15074-1237
}

{$G+} { Enable 286/287 instructions }
unit ANSI_IO;

interface

const
  { Release information }
  Version = $0104;
  { Defaults }
  VideoSegment = $B800; { $B800 for color; DOES NOT SUPPORT MONO }
  TextModeLength = 25; { # of lines in selected textmode }
  TextModeWidth = 80;
  { Virtual screen constants }
  VirtualScreenLength = 400; { Set to 'TextModeRows' for __ONLY__ direct video output }
  VirtualScreenWidth = 80;
  VirtualScreenSize = VirtualScreenLength * VirtualScreenWidth;
  { ANSI parameter constants }
  ParameterBufferLength = 5;
  ParameterBufferSize = ParameterBufferLength * 3;
  { ANSI Error values }
  ANSIErrorListLength = 7;
  ANSIErrorList : array [0..ANSIErrorListLength - 1] of string = (
  'None',
  'ANSI routines not initialized',
  'Virtual screen not initialized',
  'Invalid format',
  'Too many parameters',
  'Parameter too long',
  'Cannot execute command'
  );

type
  PosRec = record
    X : Byte;
    Y : Integer;
  end;
  ScreenCharRec = record
    Character,
    Attribute : Byte;
  end;
  PScreenType = ^ScreenType;
  ScreenType = array [0..VirtualScreenSize - 1] of ScreenCharRec;
  VirtualScreenObj = object
    ActiveAttribute : Byte;
    DirectVideo : Boolean;
    Data : PScreenType;
    MemForData : Word;
    EndOfBuffer : Boolean; { Not used w/ direct video }
    Cursor : PosRec;
    Initialized : Boolean;
    procedure Error ( Command : Byte );
    function Init : Byte;
    function InitDirectVideo : Byte;
    procedure DeInit;
    procedure Clear;
    procedure GotoXY ( X : Byte; Y : Integer );
    procedure ScrollScreenUp; { Direct video __ONLY__ }
    procedure WriteCR;
    procedure WriteCh ( Ch : Char );
    procedure WriteStr ( Str : string );
    procedure WriteStrLn ( Str : string );
  end;
  ANSIHandlerObj = object
    ParameterBuffer : array [0..ParameterBufferLength - 1,0..2] of Char;
    ParameterRow,
    ParameterColumn : Byte;
    LastCharacter : Char;
    Escape, EscapeSequence : Boolean;
    SavedCursor : PosRec;
    LastError : Byte;
    procedure Init;
    procedure DeInit;
    procedure ClearParameterBuffer;
    function ReturnParameters : string;
    function Attribute : Boolean;
    function ClearCommand : Boolean;
    function EraseFromCursorToEndOfLine : Boolean;
    function PositionCursor ( Command : Char ) : Boolean;
    function CursorUp : Boolean;
    function CursorDown : Boolean;
    function CursorRight : Boolean;
    function CursorLeft : Boolean;
    function CursorUpCommand : Boolean;
    function CursorDownCommand : Boolean;
    function CursorRightCommand : Boolean;
    function CursorLeftCommand : Boolean;
    procedure SaveCursorLocation;
    procedure RestoreCursorLocation;
    function ProcessCommand ( Command : Char ) : Boolean;
    function WriteCh ( Ch : Char ) : Byte;
    procedure WriteStr ( Str : string );

    function SetClearScreen : string;
    function SetAttribute ( FromAttribute : Integer; ToAttribute : Byte ) : string;
    function SetCursorPosition ( X, Y : Byte ) : string;
    function SetCursorUp ( Num : Byte ) : string;
    function SetCursorDown ( Num : Byte ) : string;
    function SetCursorLeft ( Num : Byte ) : string;
    function SetCursorRight ( Num : Byte ) : string;
    function SetSaveCursorPosition : string;
    function SetRestoreCursorPosition : string;
  end;

var
  ScreenWidth, ScreenLength, ScreenSize : Word;
  VirtualScreen : VirtualScreenObj;
  ANSIHandler : ANSIHandlerObj;

implementation

procedure VirtualScreenObj.Error ( Command : Byte );

type
  ErrRec = record
    Msg : string;
    Cmd : Byte;
      { Cmd:  $00 : None }
      {       $01 : Halt }
  end;

const
  NumErrorTypes = $02;
  ErrorHandler : array [0..NumErrorTypes - 1] of ErrRec = (
  (Msg : ''; Cmd : $00),
  (Msg : 'Out of Memory'; Cmd : $01)
  { This format of storing the errors & commands is very configurable }
  );

begin
  if ErrorHandler[Command].Msg <> '' then begin
    WriteLn;
    WriteLn('ERROR: ', ErrorHandler[Command].Msg);
  end;
  case ErrorHandler[Command].Cmd of
    $01 : begin
      Halt($0000);
    end;
  end;
end;

function VirtualScreenObj.Init : Byte;
begin
  Init := $00;
  MemForData := SizeOf(Data^);
  if MaxAvail > MemForData then begin
    { Get memory }
    GetMem(Data, MemForData);
    { Initialize values }
    Clear;
    EndOfBuffer := False;
    ActiveAttribute := 7;
    ScreenLength := VirtualScreenLength;
    ScreenWidth := VirtualScreenWidth;
    ScreenSize := ScreenLength * ScreenWidth;
    Initialized := True;
    DirectVideo := False;
  end
  else Init := $01;
end;

function VirtualScreenObj.InitDirectVideo : Byte;
begin
  InitDirectVideo := $00;
  { Set Data -> VideoSegment:$0000 }
  Data := Ptr(VideoSegment,$0000);
  ScreenLength := TextModeLength;
  ScreenWidth := TextModeWidth;
  ScreenSize := TextModeLength * TextModeWidth;
  DirectVideo := True;
  { Initialize values }
  Clear;
  EndOfBuffer := False;
  Cursor.X := 0;
  Cursor.Y := 0;
  ActiveAttribute := 7;
  Initialized := True;
end;

procedure VirtualScreenObj.DeInit;
begin
  FreeMem(Data, MemForData);
  ScreenWidth := 0;
  ScreenLength := 0;
  ScreenSize := 0;
end;

procedure VirtualScreenObj.Clear;

var
  AA : Byte;

begin
  AA := VirtualScreen.ActiveAttribute;
  asm
    mov cx,VideoSegment
    mov es,cx
    xor di,di
    mov cx,ScreenSize        { CX = ScreenSize/2 }
    shr cx,1                 { CX = ScreenSize/4 }
    mov ah,AA
    mov al,$20
    db 66h; shl ax,16        { move AX to high word of EAX }
    mov ah,AA
    mov al,$20               { set AX again }
    db 66h; rep stosw        { REP STOSD }
  end;
  Cursor.X := 0; Cursor.Y := 0;
  EndOfBuffer := False;
end;

procedure VirtualScreenObj.GotoXY ( X : Byte; Y : Integer );
begin
  if (Cursor.Y < ScreenLength) and (Cursor.X < ScreenWidth) then begin
    Cursor.X := X;
    Cursor.Y := Y;
    EndOfBuffer := False;
  end;
end;

procedure VirtualScreenObj.ScrollScreenUp;
begin
  { adjust display }
  Move(Mem[$B800:160],Mem[$B800:0],ScreenSize shl 1);
  Dec(Cursor.Y);
end;

procedure VirtualScreenObj.WriteCR;
begin
  Cursor.X := 0;
  Inc(Cursor.Y);
  if DirectVideo then begin
    while Cursor.Y >= ScreenLength do ScrollScreenUp;
  end
  else begin
    if Cursor.Y >= ScreenLength then begin
      EndOfBuffer := True;
      while Cursor.Y >= ScreenLength do Dec(Cursor.Y);
    end;
  end;
end;

procedure VirtualScreenObj.WriteCh ( Ch : Char );

var
  Value : Integer;

begin
  Value := Cursor.Y * ScreenWidth + Cursor.X;
  { This speeds up the routine ever so SLIGHTLY... }
  if Ch = #10 then begin
    Cursor.X := 0;
  end
  else if Ch = #13 then begin
    Inc(Cursor.Y);
    if DirectVideo then begin
      while Cursor.Y >= ScreenLength do ScrollScreenUp;
    end
    else begin
      if Cursor.Y >= ScreenLength then begin
        EndOfBuffer := True;
        while Cursor.Y >= ScreenLength do Dec(Cursor.Y);
      end;
    end;
  end
  else begin
    VirtualScreen.Data^[Value].Character := Ord(Ch);
    VirtualScreen.Data^[Value].Attribute := ActiveAttribute;
    Inc(Cursor.X);
    if Cursor.X >= ScreenWidth then begin
      Cursor.X := 0;
      Inc(Cursor.Y);
      if DirectVideo then begin
        while Cursor.Y >= ScreenLength do ScrollScreenUp;
      end
      else begin
        if Cursor.Y >= ScreenLength then begin
          EndOfBuffer := True;
          while Cursor.Y >= ScreenLength do Dec(Cursor.Y);
        end;
      end;
    end;
  end;
end;

procedure VirtualScreenObj.WriteStr ( Str : string );

var
  I : Byte;

begin
  for I := 1 to Length(Str) do WriteCh(Str[I]);
end;

procedure VirtualScreenObj.WriteStrLn ( Str : string );

var
  I : Byte;

begin
  for I := 1 to Length(Str) do WriteCh(Str[I]);
  WriteCR;
end;

procedure ANSIHandlerObj.Init;
begin
  LastError := 0;
  Escape := False;
  EscapeSequence := False;
  ClearParameterBuffer;
end;

procedure ANSIHandlerObj.DeInit;
begin
  LastError := 1;
end;

procedure ANSIHandlerObj.ClearParameterBuffer;
begin
  FillChar(ParameterBuffer,ParameterBufferSize,#255);
  ParameterRow := 0;
  ParameterColumn := 0;
end;

function ANSIHandlerObj.ReturnParameters : string;

var
  I, J : Integer;
  ParameterString : string;

begin
  ParameterString := '';
  for J := 0 to ParameterRow do
    if J = ParameterRow then begin
      for I := 0 to ParameterColumn do begin
        if (I = 0) and (J > 0) then
          if ParameterBuffer[J,I] <> #255 then ParameterString := ParameterString + ';';
        if ParameterBuffer[J,I] <> #255 then ParameterString := ParameterString + ParameterBuffer[J,I];
      end;
    end
    else begin
      for I := 0 to 2 do begin
        if (I = 0) and (J > 0) then ParameterString := ParameterString + ';';
        if ParameterBuffer[J,I] <> #255 then ParameterString := ParameterString + ParameterBuffer[J,I];
      end;
    end;
  ReturnParameters := ParameterString;
end;

function ANSIHandlerObj.Attribute : Boolean;

const
  Colors : array [0..7] of Byte = (0, 4, 2, 6, 1, 5, 3, 7);

var
  I, Foreground, Background,
  Number, OldAttribute : Byte;
  Intensity, Blink : Boolean;

begin
  Attribute := True;
  OldAttribute := VirtualScreen.ActiveAttribute;
  if OldAttribute >= 128 then begin
    Blink := True;
    OldAttribute := OldAttribute - 128;
  end
  else Blink := False;
  Background := (OldAttribute shr 4);
  if (OldAttribute mod 16) > 7 then begin
    Intensity := True;
    Foreground := (OldAttribute mod 16) - 8;
  end
  else begin
    Intensity := False;
    Foreground := (OldAttribute mod 16);
  end;
  for I := 0 to ParameterBufferLength - 1 do begin
    if ParameterBuffer[I,0] <> #255 then begin
      if ParameterBuffer[I,1] = #255 then begin
        Number := Ord (ParameterBuffer[I,0]) - 48;
      end
      else if ParameterBuffer[I,2] = #255 then begin
        Number := (Ord (ParameterBuffer[I,0]) - 48) * 10;
        Number := Number + (Ord (ParameterBuffer[I,1]) - 48);
      end
      else begin
        Number := (Ord (ParameterBuffer[I,0]) - 48) * 100;
        Number := Number + (Ord (ParameterBuffer[I,1]) - 48) * 10;
        Number := Number + (Ord (ParameterBuffer[I,2]) - 48);
      end;
      case Number of
        0 : begin
          Foreground := 7;
          Background := 0;
          Intensity := False;
          Blink := False;
        end;
        1 : Intensity := True;
        5 : Blink := True;
        7 : begin
          OldAttribute := Foreground;
          Foreground := Background;
          Background := OldAttribute;
        end;
        30..37 : Foreground := Colors [Number - 30];
        40..47 : Background := Colors [Number - 40];
        else begin { Unknown command }
          Attribute := False;
          { In this instance, the unknown command is ignoured and the
            current block is not terminated.  If desired, uncomment
            the next line. }
          { Exit; }
        end;
      end;
    end;
  end;
  VirtualScreen.ActiveAttribute := Background shl 4;
  if Intensity then VirtualScreen.ActiveAttribute := VirtualScreen.ActiveAttribute + (Foreground + 8)
  else VirtualScreen.ActiveAttribute := VirtualScreen.ActiveAttribute + Foreground;
  if Blink then VirtualScreen.ActiveAttribute := VirtualScreen.ActiveAttribute + 128;
end;

function ANSIHandlerObj.ClearCommand : Boolean;
begin
  ClearCommand := True;
  if ParameterRow = 0 then begin
    if ParameterBuffer[0,0] = #255 then ClearCommand := False
    else if ParameterBuffer[0,1] = #255 then begin
      case ParameterBuffer[0,0] of
{        '0' : ; }{ Clear from cursor up? }
{        '1' : ; }{ Clear from cursor down? }
        '2' : VirtualScreen.Clear; { Clear screen }
        else ClearCommand := False;
      end;
    end
    else if ParameterBuffer[0,2] = #255 then ClearCommand := False;
  end
  else ClearCommand := False;
end;

function ANSIHandlerObj.EraseFromCursorToEndOfLine : Boolean;

var
  ValueY : Word;
  I, X, AA, Count : Byte;

begin
  EraseFromCursorToEndOfLine := True;
  if VirtualScreen.Initialized then begin
    X := VirtualScreen.Cursor.X;
    if VirtualScreen.DirectVideo then begin
      ValueY := VirtualScreen.Cursor.Y * ScreenWidth;
      Count := ScreenWidth - X;
    end
    else begin
      ValueY := VirtualScreen.Cursor.Y * ScreenWidth;
      Count := ScreenWidth - X;
    end;
    AA := VirtualScreen.ActiveAttribute;
    asm
      mov cx,VideoSegment
      mov es,cx
      mov di,ValueY
      shl di,1
      xor ah,ah
      mov al,X
      shl ax,1
      add di,ax
      shl di,1
      xor ch,ch
      mov cl,Count
      shr cl,1
      mov ah,AA              { Set AX }
      mov al,$20
      db 66h; shl ax,16      { Shift AX -> high end of EAX }
      mov ah,AA              { Set AX }
      mov al,$20
      db 66h; rep stosw      { REP STOSD }
    end;
    VirtualScreen.WriteCR;
  end
  else EraseFromCursorToEndOfLine := False;
end;

function ANSIHandlerObj.PositionCursor ( Command : Char ) : Boolean;

var
  Number : Byte;

begin
  PositionCursor := True;
  if ParameterRow = 1 then begin
    if ParameterBuffer[0,1] = #255 then Number := Ord (ParameterBuffer[0,0]) - 48
    else if ParameterBuffer[0,2] = #255 then begin
      Number := 10 * (Ord (ParameterBuffer[1,0]) - 48);
      Number := Number + (Ord (ParameterBuffer[1,1]) - 48);
    end
    else begin
      Number := 100 * (Ord (ParameterBuffer[0,0]) - 48);
      Number := Number + (10 * (Ord (ParameterBuffer[0,1]) - 48));
      Number := Number + (Ord (ParameterBuffer[0,2]) - 48);
    end;
    if (Number > 0) and (Number <= ScreenLength) then VirtualScreen.Cursor.Y := Number - 1;
    if ParameterBuffer[1,1] = #255 then Number := Ord (ParameterBuffer[1,0]) - 48
    else if ParameterBuffer[1,2] = #255 then begin
      Number := 10 * (Ord (ParameterBuffer[1,0]) - 48);
      Number := Number + (Ord (ParameterBuffer[1,1]) - 48);
    end
    else begin
      Number := 100 * (Ord (ParameterBuffer[1,0]) - 48);
      Number := Number + (10 * (Ord (ParameterBuffer[1,1]) - 48));
      Number := Number + (Ord (ParameterBuffer[1,2]) - 48);
    end;
    if (Number > 0) and (Number <= ScreenWidth) then VirtualScreen.Cursor.X := Number - 1;
  end
  else begin
    VirtualScreen.Cursor.X := 0;
    VirtualScreen.Cursor.Y := 0;
  end;
end;

function ANSIHandlerObj.CursorUp : Boolean;
begin
  CursorUp := True;
  if VirtualScreen.Cursor.Y > 0 then begin
    Dec(VirtualScreen.Cursor.Y);
  end
  else CursorUp := False;
end;

function ANSIHandlerObj.CursorDown : Boolean;
begin
  CursorDown := True;
  if VirtualScreen.Cursor.Y < ScreenLength - 1 then begin
    Inc(VirtualScreen.Cursor.Y);
  end
  else CursorDown := False;
end;

function ANSIHandlerObj.CursorRight : Boolean;
begin
  CursorRight := True;
  if VirtualScreen.Cursor.X < ScreenWidth - 1 then begin
    Inc(VirtualScreen.Cursor.X);
  end
  else begin
    if VirtualScreen.Cursor.Y < ScreenLength - 1 then begin
      Inc(VirtualScreen.Cursor.Y);
      VirtualScreen.Cursor.X := 0;
    end
    else CursorRight := False;
  end;
end;

function ANSIHandlerObj.CursorLeft : Boolean;
begin
  CursorLeft := True;
  if VirtualScreen.Cursor.X > 0 then begin
    Dec(VirtualScreen.Cursor.X);
  end
  else CursorLeft := False;
end;

function ANSIHandlerObj.CursorUpCommand : Boolean;

var
  I, Number : Byte;

begin
  CursorUpCommand := True;
  if ParameterRow = 0 then begin
    if ParameterBuffer[0,0] = #255 then Number := 1
    else if ParameterBuffer[0,1] = #255 then Number := Ord (ParameterBuffer[0,0]) - 48
    else if ParameterBuffer[0,2] = #255 then begin
      Number := 10 * (Ord (ParameterBuffer[0,0]) - 48);
      Number := Number + (Ord (ParameterBuffer[0,1]) - 48);
    end
    else begin
      Number := 100 * (Ord (ParameterBuffer[0,0]) - 48);
      Number := Number + (10 * (Ord (ParameterBuffer[0,1]) - 48));
      Number := Number + (Ord (ParameterBuffer[0,2]) - 48);
    end;
    if Number > 0 then for I := 1 to Number do begin
      if not CursorUp then CursorUpCommand := False;
    end;
  end
  else CursorUpCommand := False;
end;

function ANSIHandlerObj.CursorDownCommand : Boolean;

var
  I, Number : Byte;

begin
  CursorDownCommand := True;
  if ParameterRow = 0 then begin
    if ParameterBuffer[0,0] = #255 then Number := 1
    else if ParameterBuffer[0,1] = #255 then Number := Ord (ParameterBuffer[0,0]) - 48
    else if ParameterBuffer[0,2] = #255 then begin
      Number := 10 * (Ord (ParameterBuffer[0,0]) - 48);
      Number := Number + (Ord (ParameterBuffer[0,1]) - 48);
    end
    else begin
      Number := 100 * (Ord (ParameterBuffer[0,0]) - 48);
      Number := Number + (10 * (Ord (ParameterBuffer[0,1]) - 48));
      Number := Number + (Ord (ParameterBuffer[0,2]) - 48);
    end;
    if Number > 0 then for I := 1 to Number do begin
      if not CursorDown then CursorDownCommand := False;
    end;
  end
  else CursorDownCommand := False;
end;

function ANSIHandlerObj.CursorRightCommand : Boolean;

var
  I, Number : Byte;

begin
  CursorRightCommand := True;
  if ParameterRow = 0 then begin
    if ParameterBuffer[0,0] = #255 then Number := 1
    else if ParameterBuffer[0,1] = #255 then Number := Ord (ParameterBuffer[0,0]) - 48
    else if ParameterBuffer[0,2] = #255 then begin
      Number := 10 * (Ord (ParameterBuffer[0,0]) - 48);
      Number := Number + (Ord (ParameterBuffer[0,1]) - 48);
    end
    else begin
      Number := 100 * (Ord (ParameterBuffer[0,0]) - 48);
      Number := Number + (10 * (Ord (ParameterBuffer[0,1]) - 48));
      Number := Number + (Ord (ParameterBuffer[0,2]) - 48);
    end;
    if Number > 0 then for I := 1 to Number do begin
      if not CursorRight then CursorRightCommand := False;
    end;
  end
  else CursorRightCommand := False;
end;

function ANSIHandlerObj.CursorLeftCommand : Boolean;

var
  I, Number : Byte;

begin
  CursorLeftCommand := True;
  if ParameterRow = 0 then begin
    if ParameterBuffer[0,0] = #255 then Number := 1
    else if ParameterBuffer[0,1] = #255 then Number := Ord (ParameterBuffer[0,0]) - 48
    else if ParameterBuffer[0,2] = #255 then begin
      Number := 10 * (Ord (ParameterBuffer[0,0]) - 48);
      Number := Number + (Ord (ParameterBuffer[0,1]) - 48);
    end
    else begin
      Number := 100 * (Ord (ParameterBuffer[0,0]) - 48);
      Number := Number + (10 * (Ord (ParameterBuffer[0,1]) - 48));
      Number := Number + (Ord (ParameterBuffer[0,2]) - 48);
    end;
    if Number = 255 then VirtualScreen.Cursor.X := 0 { Cursor at beginning of line }
    else if Number > 0 then for I := 1 to Number do begin
      if not CursorLeft then CursorLeftCommand := False;
    end;
  end
  else CursorLeftCommand := False;
end;

procedure ANSIHandlerObj.SaveCursorLocation;
begin
  SavedCursor.X := VirtualScreen.Cursor.X;
  SavedCursor.Y := VirtualScreen.Cursor.Y;
end;

procedure ANSIHandlerObj.RestoreCursorLocation;
begin
  VirtualScreen.Cursor.X := SavedCursor.X;
  VirtualScreen.Cursor.Y := SavedCursor.Y;
end;

function ANSIHandlerObj.ProcessCommand ( Command : Char ) : Boolean;
begin
  ProcessCommand := True;
  case Command of
    'm' : begin
      if not Attribute then
        ProcessCommand := False;
    end;
    'H','f' : begin
      if not PositionCursor(Command) then
        ProcessCommand := False;
    end;
    'J' : begin
      if not ClearCommand then
        ProcessCommand := False;
    end;
    'K' : begin
      if not EraseFromCursorToEndOfLine then
        ProcessCommand := False;
    end;
    'A' : begin
      if not CursorUpCommand then
        ProcessCommand := False;
    end;
    'B' : begin
      if not CursorDownCommand then
        ProcessCommand := False;
    end;
    'C' : begin
      if not CursorRightCommand then
        ProcessCommand := False;
    end;
    'D' : begin
      if not CursorLeftCommand then
        ProcessCommand := False;
    end;
    's' : SaveCursorLocation;
    'u' : RestoreCursorLocation;
  end;
  Escape := False;
  EscapeSequence := False;
end;

function ANSIHandlerObj.WriteCh ( Ch : Char ) : Byte;
begin
  WriteCh := 0; { No errors }
  if LastError = 1 then begin
    WriteCh := 1; { Error #1 }
  end
  else if not VirtualScreen.Initialized then begin
    WriteCh := 2; { Error #2 }
  end
  else case Ch of
    #10 : begin { Line feed }
      if Escape then begin
        if EscapeSequence then begin
          Escape := False;
          EscapeSequence := False;
          VirtualScreen.WriteStr(#27#91 + ReturnParameters);
          Inc(VirtualScreen.Cursor.Y);
          if VirtualScreen.DirectVideo then begin
            while VirtualScreen.Cursor.Y >= ScreenLength do VirtualScreen.ScrollScreenUp;
          end
          else begin
            if VirtualScreen.Cursor.Y >= ScreenLength then begin
              VirtualScreen.EndOfBuffer := True;
              while VirtualScreen.Cursor.Y >= ScreenLength do Dec(VirtualScreen.Cursor.Y);
            end;
          end;
          WriteCh := 3; { Error #3 }
        end
        else begin
          Escape := False;
          VirtualScreen.WriteCh(#27);
          Inc(VirtualScreen.Cursor.Y);
          if VirtualScreen.DirectVideo then begin
            while VirtualScreen.Cursor.Y >= ScreenLength do VirtualScreen.ScrollScreenUp;
          end
          else begin
            if VirtualScreen.Cursor.Y >= ScreenLength then begin
              VirtualScreen.EndOfBuffer := True;
              while VirtualScreen.Cursor.Y >= ScreenLength do Dec(VirtualScreen.Cursor.Y);
            end;
          end;
          WriteCh := 3; { Error #3 }
        end;
      end
      else begin
        Inc(VirtualScreen.Cursor.Y);
        if VirtualScreen.DirectVideo then begin
          while VirtualScreen.Cursor.Y >= ScreenLength do VirtualScreen.ScrollScreenUp;
        end
        else begin
          if VirtualScreen.Cursor.Y >= ScreenLength then begin
            VirtualScreen.EndOfBuffer := True;
            while VirtualScreen.Cursor.Y >= ScreenLength do Dec(VirtualScreen.Cursor.Y);
          end;
        end;
      end;
    end;
    #13 : begin { CR }
      if Escape then begin
        if EscapeSequence then begin
          Escape := False;
          EscapeSequence := False;
          VirtualScreen.WriteStr(#27#91 + ReturnParameters);
          VirtualScreen.Cursor.X := 0;
          WriteCh := 3; { Error #3 }
        end
        else begin
          Escape := False;
          VirtualScreen.WriteCh(#27);
          VirtualScreen.Cursor.X := 0;
          WriteCh := 3; { Error #3 }
        end;
      end
      else VirtualScreen.Cursor.X := 0;
    end;
    #27 : begin { Esc }
      if Escape then begin
        if EscapeSequence then begin
          Escape := True;
          EscapeSequence := False;
          VirtualScreen.WriteStr(#27#91 + ReturnParameters);
          WriteCh := 3; { Error #3 }
        end
        else VirtualScreen.WriteCh(#27);
      end
      else Escape := True;
    end;
    #91 : begin { [ }
      if Escape then begin
        if EscapeSequence then begin
          Escape := False;
          EscapeSequence := False;
          VirtualScreen.WriteStr(#27#91 + ReturnParameters + Ch);
          WriteCh := 3; { Error #3 }
        end
        else begin
          EscapeSequence := True;
          ClearParameterBuffer;
        end;
      end
      else VirtualScreen.WriteCh(Ch);
    end;
    '0'..'9' : begin
      if Escape then begin
        if EscapeSequence then begin
          if ParameterColumn <= 2 then begin
            ParameterBuffer[ParameterRow,ParameterColumn] := Ch;
            Inc (ParameterColumn);
          end
          else begin
            Escape := False;
            EscapeSequence := False;
            VirtualScreen.WriteStr(#27#91 + ReturnParameters + Ch);
            WriteCh := 5; { Error #5 }
          end;
        end
        else begin
          Escape := False;
          VirtualScreen.WriteStr(#27 + Ch);
          WriteCh := 3; { Error #3 }
        end;
      end
      else VirtualScreen.WriteCh(Ch);
    end;
    ';' : begin
      if Escape then begin
        if EscapeSequence then begin
          if LastCharacter in ['0'..'9'] then begin
            Inc(ParameterRow);
            if ParameterRow > ParameterBufferLength - 1 then begin
              ParameterRow := ParameterBufferLength - 1;
              Escape := False;
              EscapeSequence := False;
              VirtualScreen.WriteStr(#27#91 + ReturnParameters + ';');
              WriteCh := 4; { Error #4 }
            end
            else ParameterColumn := 0;
          end
          else begin
            Escape := False;
            EscapeSequence := False;
            VirtualScreen.WriteStr(#27#91 + ReturnParameters + ';');
            WriteCh := 3; { Error #3 }
          end;
        end
        else begin
          Escape := False;
          VirtualScreen.WriteStr(#27 + ';');
          WriteCh := 3; { Error #3 }
        end;
      end
      else VirtualScreen.WriteCh(';');
    end;
    'm','H','f','J','K','A','B','C','D','s','u' : begin
      if Escape then begin
        if EscapeSequence then begin
          if LastCharacter = ';' then begin
            Escape := False;
            EscapeSequence := False;
            VirtualScreen.WriteStr(#27#91 + ReturnParameters + ';' + Ch);
            WriteCh := 3; { Error #3 }
          end
          else begin
            if not ProcessCommand(Ch) then begin
              VirtualScreen.WriteStr(#27#91 + ReturnParameters + Ch);
              WriteCh := 6; { Error #6 }
            end;
          end;
        end
        else begin
          Escape := False;
          VirtualScreen.WriteStr(#27 + Ch);
        end;
      end
      else VirtualScreen.WriteCh(Ch);
    end;
    else begin
      if Escape then begin
        if EscapeSequence then begin
          Escape := False;
          EscapeSequence := False;
          VirtualScreen.WriteStr(#27#91 + ReturnParameters + Ch);
          WriteCh := 3; { Error #3 }
        end
        else begin
          Escape := False;
          VirtualScreen.WriteStr(#27 + Ch);
          WriteCh := 3; { Error #3 }
        end;
      end
      else VirtualScreen.WriteCh(Ch);
    end;
  end;
  LastCharacter := Ch;
end;

procedure ANSIHandlerObj.WriteStr ( Str : string );

var
  I : Byte;

begin
  for I := 1 to Length(Str) do ANSIHandler.WriteCh(Str[I]);
end;

function ANSIHandlerObj.SetClearScreen : string;
{ This function returns the ANSI string for clearing the screen
  (written for saving an image in ANSI characters) }
begin
  SetClearScreen := '';
end;

function ANSIHandlerObj.SetAttribute ( FromAttribute : Integer; ToAttribute : Byte ) : string;
{ This function returns the ANSI string for setting the attribute
  (written for saving an image in ANSI characters) }
const
  Colors : array [0..7] of Char = ('0', '4', '2', '6', '1', '5', '3', '7');

var
  Str : string;
  WasBlink, WasInten : Boolean;
  WasBG, WasFG : Byte;
  NowBlink, NowInten : Boolean;
  NowBG, NowFG : Byte;
  Param : Boolean;

begin
  Param := False;
  Str := '';
  if FromAttribute <> -1 then begin
    if FromAttribute > 127 then WasBlink := True
    else WasBlink := False;
    if FromAttribute mod 16 > 7 then begin
      WasInten := True;
      WasFG := FromAttribute mod 16 - 8;
    end
    else begin
      WasInten := False;
      WasFG := FromAttribute mod 16;
    end;
    WasBG := FromAttribute div 16;
  end
  else begin
    Str := #27#91#48; { '[0' }
    Param := True;
    WasBlink := False;
    WasInten := False;
    WasBG := 0;
    WasFG := 7;
  end;
  if ToAttribute > 127 then NowBlink := True
  else NowBlink := False;
  if ToAttribute mod 16 > 7 then begin
    NowInten := True;
    NowFG := ToAttribute mod 16 - 8;
  end
  else begin
    NowInten := False;
    NowFG := ToAttribute mod 16;
  end;
  NowBG := ToAttribute div 16;
  if ((WasBlink) and (not NowBlink)) or ((WasInten) and (not NowInten)) then begin
    Str := #27#91#48; { '[0' }
    Param := True;
    WasBlink := False;
    WasInten := False;
    WasBG := 0;
    WasFG := 7;
  end;
  if NowBlink then
    if not WasBlink then begin
      if Param then Str := Str + ';5'
      else begin
        Str := #27#91 + '5';
        Param := True;
      end;
    end;
  if NowInten then
    if not WasInten then begin
      if Param then Str := Str + ';1'
      else begin
        Str := #27#91 + '1';
        Param := True;
      end;
    end;
  if NowBG <> WasBG then begin
    if Param then Str := Str + ';4' + Colors[NowBG]
    else begin
      Str := #27#91 + '4' + Colors[NowBG];
      Param := True;
    end;
  end;
  if NowFG <> WasFG then begin
    if Param then Str := Str + ';3' + Colors[NowFG]
    else begin
      Str := #27#91 + '3' + Colors[NowFG];
      Param := True;
    end;
  end;
  if Param then Str := Str + #109; { Str + 'm' }
  SetAttribute := Str;
end;

function NumStr ( N : Byte ) : string;
{ Used for following routines ONLY }
const
  NM : array [0..2] of Byte = (1,10,100);

var
  I, Num, Digits : Byte;
  Str : string;

begin
  Str := '';
  Digits := 0;
  Num := N;
  for I := 2 downto 0 do
    if (Num div NM[I] > 0) or (Digits > 0) then begin
      Str := Str + Chr(Num div NM[I] + 48);
      Num := Num mod NM[I];
      Inc(Digits);
    end;
  NumStr := Str;
end;

function ANSIHandlerObj.SetCursorPosition ( X, Y : Byte ) : string;
{ This function returns the ANSI string for setting the cursor position
  (written for saving an image in ANSI characters) }
var
  Str : string;

begin
  if (X = 0) and (Y = 0) then Str := ''
  else Str := '[' + NumStr(Y + 1) + ';' + NumStr(X + 1) + 'H';
  SetCursorPosition := Str;
end;

function ANSIHandlerObj.SetCursorUp ( Num : Byte ) : string;
{ This function returns the ANSI string for moving the cursor up
  (written for saving an image in ANSI characters) }
var
  Ch : string;

begin
  Ch := NumStr(Num);
  if Ch = #48 then Ch := '';
  SetCursorUp := '[' + Ch + 'A';
end;

function ANSIHandlerObj.SetCursorDown ( Num : Byte ) : string;
{ This function returns the ANSI string for moving the cursor down
  (written for saving an image in ANSI characters) }
var
  Ch : string;

begin
  Ch := NumStr(Num);
  if Ch = #48 then Ch := '';
  SetCursorDown := '[' + Ch + 'B';
end;

function ANSIHandlerObj.SetCursorLeft ( Num : Byte ) : string;
{ This function returns the ANSI string for moving the cursor left
  (written for saving an image in ANSI characters) }
var
  Ch : string;

begin
  Ch := NumStr(Num);
  if Ch = #48 then Ch := '';
  SetCursorLeft := '[' + Ch + 'D';
end;

function ANSIHandlerObj.SetCursorRight ( Num : Byte ) : string;
{ This function returns the ANSI string for moving the cursor right
  (written for saving an image in ANSI characters) }
var
  Ch : string;

begin
  Ch := NumStr(Num);
  if Ch = #48 then Ch := '';
  SetCursorRight := '[' + Ch + 'C';
end;

function ANSIHandlerObj.SetSaveCursorPosition : string;
{ This function returns the ANSI string for saving the cursor position
  (written for saving an image in ANSI characters) }
begin
  SetSaveCursorPosition := '';
end;

function ANSIHandlerObj.SetRestoreCursorPosition : string;
{ This function returns the ANSI string for restoring the cursor position
  (written for saving an image in ANSI characters) }
begin
  SetRestoreCursorPosition := '';
end;

begin
  VirtualScreen.Initialized := False;
  ANSIHandler.LastError := 1;
  ScreenWidth := 0;
  ScreenLength := 0;
  ScreenSize := 0;
end.

[Back to ANSI SWAG index]  [Back to Main SWAG index]  [Original]