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

    {--------------------------------------------------------------------}
    (*                                                                  *)
    (*         Gansi.Pas -- A Pascal unit containing all of             *)
    (*         ANSI graphics, cursor, keyboard, and screen              *)
    (*         mode manipulation strings.                               *)
    (*                                                                  *)
    (*         Version 2.21   April 26th, 1991                          *)
    (*                                                                  *)
    (*                                   Greg Smith                     *)
    (*                                   Boulder, Co. USA               *)
    (*                                                                  *)
    {--------------------------------------------------------------------}

    unit gansi;

    interface

    uses
      Dos;

    type
      ansicode   = string[12]; { Maximum size for most ANSI strings }

    const
      hdr        = #27+'['; { ansi control sequence }
      clsd       = hdr+'0J'; { Clear Everything below cursor }
      clsu       = hdr+'1J'; { Clear Everything above cursor }
      cls        = hdr+'2J'; { Clear Screen }
      requestpos = hdr+'6n'; { request Cursor pos. StdIn rets Esc[y;xR }
      delline    = hdr+'K'; { delete from cursor to EOL }
      savepos    = hdr+'s'; { save cursor position }
      restpos    = hdr+'u'; { restore cursor position }
      cursorhome = hdr+'H'; { Home cursor }
      normcolor  = hdr+'0m'; { Normal white on black }
      highlight  = hdr+'1m'; { Highlight.  (Bold) }
      RevVideo   = hdr+'7m'; { Reverse the FG and BG }

    function SetPos(x,y:integer): ansicode;
    function CursorUp(n:integer): ansicode;
    function CursorDown(n:integer): ansicode;
    function CursorRight(n:integer): ansicode;
    function CursorLeft(n:integer): ansicode;

    function InsertChar(n:integer): ansicode;
    function DeleteChar(n:integer): ansicode;
    function InsertLine(n:integer): ansicode;
    function DeleteLine(n:integer): ansicode;

    function SetAttr(C:integer): ansicode;
    function SetColor(f,b:integer): ansicode;

    function SetMode(mode:integer): ansicode;
    function Resetmode(mode:integer): ansicode;

    function SetChar(ch:char;st:string): string;
    function SetExtendedKey(key:integer;st:string): string;

    implementation

    type  intstring = string[6];

    { Misc support functions }

    function bts(x:integer): intstring;
    var
      z : intstring;
    begin
      Str(x,z);
      bts := z;
    end;

    function HNum(n:integer): ansicode;
    var
      z : intstring;
    begin
      Str(n,z);
      HNum := hdr+z;
    end;

    { Cursor Control functions }

    function SetPos(x,y:integer): ansicode;
    begin
      SetPos := hnum(y)+';'+bts(x)+'H';
    end;

    function CursorUp(n:integer): ansicode;
    begin
      CursorUp := hnum(n)+'A';
    end;

    function CursorDown(n:integer): ansicode;
    begin
      CursorDown := hnum(n)+'B';
    end;

    function CursorRight(n:integer): ansicode;
    begin
      CursorRight := hnum(n)+'C';
    end;

    function CursorLeft(n:integer): ansicode;
    begin
      CursorLeft := hnum(n)+'D';
    end;

    { Editing Functions }

    function InsertChar(n:integer): ansicode;
    begin
      InsertChar := hnum(n)+'@';
    end;

    function DeleteChar(n:integer): ansicode;
    begin
      DeleteChar := hnum(n)+'P';
    end;

    function InsertLine(n:integer): ansicode;
    begin
      InsertLine := hnum(n)+'L';
    end;

    function DeleteLine(n:integer): ansicode;
    begin
      DeleteLine := hnum(n)+'M';
    end;

    { Color functions }

    function SetAttr(C:integer): ansicode;
    var
      x : integer;
      tmp : ansicode;

      procedure ColorIdentify;
      begin
        case x of
         0 :  tmp := tmp+'0';  { Black }
         1 :  tmp := tmp+'4';  { Blue }
         2 :  tmp := tmp+'2';  { Green }
         3 :  tmp := tmp+'6';  { Cyan }
         4 :  tmp := tmp+'1';  { Red }
         5 :  tmp := tmp+'5';  { Magenta }
         6 :  tmp := tmp+'3';  { Brown/Yellow }
         7 :  tmp := tmp+'7';  { White }
        end; { case }
      end; { ColorIdentify }

    begin
      tmp := hdr;
      if (c and $08)=1 then tmp := tmp+'1' else tmp := tmp+'0';
      tmp := tmp+';3'; { common to all fgnds. }
      x := c and $07; { first three bits. }
      ColorIdentify; { Add Color Value digit }
      tmp := tmp+';4'; { common to all bkgnds. }
      x := (c and $70) shr 4;
      ColorIdentify; { Add color value digit }
      if (c and $80)=$80 then tmp := tmp+';5';
      SetAttr := tmp+'m'; { complete ANSI code! }
    end; { setattr }

    function SetColor(f,b:integer): ansicode;
    begin
      b := (b shl 4); { move to high bits. }
      f := (f and $0f); { zero all high bits. }
      SetColor := SetAttr((b OR f)); {Create Attribute byte from values.}
    end; { SetColor }

    { Mode Setting Functions }

    function SetMode(mode:integer): ansicode;
    begin
      SetMode := hdr+'='+bts(mode)+'h';
      { Modes:
           0     40x25   Black and White
           1     40x25   Color
           2     80x25   Black and White
           3     80x25   Color
           4     320x200 color           (CGA)
           5     320x200 Black and White (CGA)
           6     640x200 Black and White (CGA)
           7     Wrap at end of line.
      }
    end;

    function Resetmode(mode:integer): ansicode;
    begin
      Resetmode := hdr+'='+bts(mode)+'l';  { Same modes as above }
    end;                                   { Wrap at EOL will turn off }

    { Keyboard Re-Defining functions }

    function SetChar(ch:char;st:string): string;
    begin
      SetChar := hdr+bts(ord(ch))+';"'+st+'"p'; { when ch is pressed st is }
    end;                                        { sent instead of ch       }

    function SetExtendedKey(key:integer;st:string): string;
    begin
      SetExtendedKey := hdr+'0;'+bts(key)+';"'+st+'"p'; { Same as above. but the }
    end;                                                { Key is an extended code }

    end.

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