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

Unit Ansi; (* Ho ho ho -Santa Clause) *)

Interface

Uses Crt;

Procedure Display_ANSI(ch:Char);
{ Displays ch following ANSI Graphics protocol }

{---------------------------------------------------------------------- -----}
{ Useful information For porting this thing over to other computers:

  Change background Text color        Change foreground Text color
  TextBackground(0) = black           TextColor(0) = black
  TextBackground(1) = blue            TextColor(1) = blue
  TextBackground(2) = green           TextColor(2) = green
  TextBackground(3) = cyan            TextColor(3) = cyan
  TextBackground(4) = red             TextColor(4) = red
  TextBackground(5) = Magenta         TextColor(5) = magenta
  TextBackground(6) = brown           TextColor(6) = brown
  TextBackground(7) = light grey      TextColor(7) = white
                                      TextColor(8) = grey
  Delete(s,i,c);                      TextColor(9) = bright blue
    Delete c Characters from          TextColor(10)= bright green
    String s starting at i            TextColor(11)= bright cyan
  Val(s,v,c);                         TextColor(12)= bright red
    convert String s to numeric       TextColor(13)= bright magenta
    value v. code=0 if ok.            TextColor(14)= bright yellow
  Length(s)                           TextColor(15)= bright white
    length of String s
}

Implementation

Var
  ANSI_St   :String ;  {stores ANSI escape sequence if receiving ANSI}
  ANSI_SCPL :Integer;  {stores the saved cursor position line}
  ANSI_SCPC :Integer;  {   "    "    "      "       "    column}
  ANSI_FG   :Integer;  {stores current foreground}
  ANSI_BG   :Integer;  {stores current background}
  ANSI_C,ANSI_I,ANSI_B,ANSI_R:Boolean ;  {stores current attribute options}

p,x,y : Integer;

Procedure Display_ANSI(ch:Char);
{ Displays ch following ANSI Graphics protocal }

  Procedure TABULATE;
  Var x:Integer;
  begin
    x:=WhereX;
    if x<80 then
      Repeat
        Inc(x);
      Until (x MOD 8)=0;
    if x=80 then x:=1;
    GotoXY(x,WhereY);
    if x=1 then WriteLN;
  end;

  Procedure BACKSPACE;
  Var x:Integer;
  begin
    if WhereX>1 then
      Write(^H,' ',^H)
    else
      if WhereY>1 then begin
        GotoXY(80,WhereY-1);
        Write(' ');
        GotoXY(80,WhereY-1);
      end;
  end;

  Procedure TTY(ch:Char);
  Var x:Integer;
  begin
    if ANSI_C then begin
      if ANSI_I then ANSI_FG:=ANSI_FG or 8;
      if ANSI_B then ANSI_FG:=ANSI_FG or 16;
      if ANSI_R then begin
        x:=ANSI_FG;
        ANSI_FG:=ANSI_BG;
        ANSI_BG:=x;
      end;
      ANSI_C:=False;
    end;
    TextColor(ANSI_FG);
    TextBackground(ANSI_BG);
    Case Ch of
      ^G: begin
            Sound(2000);
            Delay(75);
            NoSound;
          end;
      ^H: Backspace;
      ^I: Tabulate;
      ^J: begin
            TextBackground(0);
            Write(^J);
          end;
      ^K: GotoXY(1,1);
      ^L: begin
            TextBackground(0);
            ClrScr;
          end;
      ^M: begin
            TextBackground(0);
            Write(^M);
          end;
      else Write(Ch);
    end;
  end;

  Procedure ANSIWrite(S:String);
  Var x:Integer;
  begin
    For x:=1 to Length(S) do
      TTY(S[x]);
  end;

  Function Param:Integer;   {returns -1 if no more parameters}
  Var S:String;
      x,XX:Integer;
      B:Boolean;
  begin
    B:=False;
    For x:=3 to Length(ANSI_St) DO
      if ANSI_St[x] in ['0'..'9'] then B:=True;
    if not B then
      Param:=-1
    else begin
      S:='';
      x:=3;
      if ANSI_St[3]=';' then begin
        Param:=0;
        Delete(ANSI_St,3,1);
        Exit;
      end;
      Repeat
        S:=S+ANSI_St[x];
        x:=x+1;
      Until (NOT (ANSI_St[x] in ['0'..'9'])) or (Length(S)>2) or (x>Length(ANSI_St));
      if Length(S)>2 then begin
        ANSIWrite(ANSI_St+Ch);
        ANSI_St:='';
        Param:=-1;
        Exit;
      end;
      Delete(ANSI_St,3,Length(S));
      if ANSI_St[3]=';' then Delete(ANSI_St,3,1);
      Val(S,x,XX);
      Param:=x;
    end;
  end;

begin
  if (Ch<>#27) and (ANSI_St='') then begin
    TTY(Ch);
    Exit;
  end;
  if Ch=#27 then begin
    if ANSI_St<>'' then begin
      ANSIWrite(ANSI_St+#27);
      ANSI_St:='';
    end else ANSI_St:=#27;
    Exit;
  end;
  if ANSI_St=#27 then begin
    if Ch='[' then
      ANSI_St:=#27+'['
    else begin
      ANSIWrite(ANSI_St+Ch);
      ANSI_St:='';
    end;
    Exit;
  end;
  if (Ch='[') and (ANSI_St<>'') then begin
    ANSIWrite(ANSI_St+'[');
    ANSI_St:='';
    Exit;
  end;
  if not (Ch in ['0'..'9',';','A'..'D','f','H','J','K','m','s','u']) then begin
    ANSIWrite(ANSI_St+Ch);
    ANSI_St:='';
    Exit;
  end;
  if Ch in ['A'..'D','f','H','J','K','m','s','u'] then begin
    Case Ch of
    'A': begin
           p:=Param;
           if p=-1 then p:=1;
           if WhereY-p<1 then
             GotoXY(WhereX,1)
           else GotoXY(WhereX,WhereY-p);
         end;
    'B': begin
           p:=Param;
           if p=-1 then p:=1;
           if WhereY+p>25 then
             GotoXY(WhereX,25)
           else GotoXY(WhereX,WhereY+p);
         end;
    'C': begin
           p:=Param;
           if p=-1 then p:=1;
           if WhereX+p>80 then
             GotoXY(80,WhereY)
           else GotoXY(WhereX+p,WhereY);
         end;
    'D': begin
           p:=Param;
           if p=-1 then p:=1;
           if WhereX-p<1 then
             GotoXY(1,WhereY)
           else GotoXY(WhereX-p,WhereY);
         end;
'H','f': begin
           Y:=Param;
           x:=Param;
           if Y<1 then Y:=1;
           if x<1 then x:=1;
           if (x>80) or (x<1) or (Y>25) or (Y<1) then begin
             ANSI_St:='';
             Exit;
           end;
           GotoXY(x,Y);
         end;
    'J': begin
           p:=Param;
           if p=2 then begin
             TextBackground(0);
             ClrScr;
           end;
           if p=0 then begin
             x:=WhereX;
             Y:=WhereY;
             Window(1,y,80,25);
             TextBackground(0);
             ClrScr;
             Window(1,1,80,25);
             GotoXY(x,Y);
           end;
           if p=1 then begin
             x:=WhereX;
             Y:=WhereY;
             Window(1,1,80,WhereY);
             TextBackground(0);
             ClrScr;
             Window(1,1,80,25);
             GotoXY(x,Y);
           end;
         end;
    'K': begin
           TextBackground(0);
           ClrEol;
         end;
    'm': begin
           if ANSI_St=#27+'[' then begin
             ANSI_FG:=7;
             ANSI_BG:=0;
             ANSI_I:=False;
             ANSI_B:=False;
             ANSI_R:=False;
           end;
           Repeat
             p:=Param;
             Case p of
               -1:;
                0:begin
                    ANSI_FG:=7;
                    ANSI_BG:=0;
                    ANSI_I:=False;
                    ANSI_R:=False;
                    ANSI_B:=False;
                  end;
                1:ANSI_I:=True;
                5:ANSI_B:=True;
                7:ANSI_R:=True;
               30:ANSI_FG:=0;
               31:ANSI_FG:=4;
               32:ANSI_FG:=2;
               33:ANSI_FG:=6;
               34:ANSI_FG:=1;
               35:ANSI_FG:=5;
               36:ANSI_FG:=3;
               37:ANSI_FG:=7;
               40:ANSI_BG:=0;
               41:ANSI_BG:=4;
               42:ANSI_BG:=2;
               43:ANSI_BG:=6;
               44:ANSI_BG:=1;
               45:ANSI_BG:=5;
               46:ANSI_BG:=3;
               47:ANSI_BG:=7;
             end;
             if ((p>=30) and (p<=47)) or (p=1) or (p=5) or (p=7) then
ANSI_C:=True;
           Until p=-1;
         end;
    's': begin
           ANSI_SCPL:=WhereY;
           ANSI_SCPC:=WhereX;
         end;
    'u': begin
           if ANSI_SCPL>-1 then GotoXY(ANSI_SCPC,ANSI_SCPL);
           ANSI_SCPL:=-1;
           ANSI_SCPC:=-1;
         end;
    end;
    ANSI_St:='';
    Exit;
  end;
  if Ch in ['0'..'9',';'] then
    ANSI_St:=ANSI_St+Ch;
  if Length(ANSI_St)>50 then begin
    ANSIWrite(ANSI_St);
    ANSI_St:='';
    Exit;
  end;
end;


begin
  ANSI_St:='';
  ANSI_SCPL:=-1;
  ANSI_SCPC:=-1;
  ANSI_FG:=7;
  ANSI_BG:=0;
  ANSI_C:=False;
  ANSI_I:=False;
  ANSI_B:=False;
  ANSI_R:=False;
END.

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