[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]