unit ddansi2;
interface
uses dos, crt;
{----------------------------------------------------------------------------}
{ Ansi screen emulation routines }
{ By Scott Baker }
{ Revised By Derrick Parkhurst
{----------------------------------------------------------------------------}
{ }
{ Purpose: to execute ansi escape sequences locally. This includes changing }
{ color, moving the cursor, setting high/low intensity, setting }
{ blinking, and playing music. }
{ }
{ Remarks: These routines use a few global variables which are defined }
{ below. So far, only ESC m, J, f, C, and ^N are supported by these }
{ routines. I hope to include more in the future. }
{ }
{ Routines: Here is a listing of the subroutines: }
{ }
{ change_color(x): Change to ansi color code X. }
{ Eval_string(s): Evaluate/execute ansi string }
{ ansi_write(ch): Write a character with ansi checking }
{ }
{----------------------------------------------------------------------------}
var
escape,blink,high,norm,any,any2,fflag,gflag: boolean;
ansi_string: string;
const
ddansibanner: boolean = true;
procedure ansi_write(ch: char);
procedure ansi_write_str(var s: string);
procedure initddansi;
implementation
const
scale: array[0..7] of integer = (0,4,2,6,1,5,3,7);
scaleh: array[0..7] of integer = (8,12,10,14,9,13,11,15);
var
bbb: boolean;
t: char;
restx,resty,curcolor: integer;
Note_Octave: integer;
Note_Fraction, Note_Length, Note_Quarter: real;
procedure change_color(c: integer);
begin;
case c of
00: begin;any:=true;blink:=false;high:=false;norm:=true;end;
01: begin;high:=true;end;
02: begin;clrscr;any:=true;end;
05: begin;blink:=true;any:=true;end;
end;
if (c>29) and (c<38) then begin;
any:=true;
any2:=true;
c:=c-30;
curcolor:=c;
if (high=true) and (blink=true) then textcolor(scaleh[c]+32);
if (high=true) and (blink=false) then textcolor(scaleh[c]);
if (high=false) and (blink=true) then textcolor(scale[c]+32);
if (high=false) and (blink=false) then textcolor(scale[c]);
fflag:=true;
end;
if (c>39) and (c<48) then begin;
any:=true;
c:=c-40;
textbackground(scale[c]);
gflag:=true;
end;
end;
procedure eval_string(var s: string);
var
cp: integer;
T: CHAR;
b:byte;
jj,a,ttt,tttt: integer;
flag1:boolean;
begin;
t:=s[length(s)];
cp:=2;
case t of
'k','K': clreol;
'u': gotoxy(restx,resty);
's': begin;
restx:=wherex;
resty:=wherey;
end;
'm','J':begin;
repeat;
a:=-1;
val(s[cp],a,tttt);
if tttt=0 then begin;
cp:=cp+1;
val(s[cp],ttt,tttt);
if tttt=0 then begin;
a:=a*10;
a:=a+ttt;
end;
change_color(a);
end;
cp:=cp+1;
until cp>=length(s);
if norm then begin;
if (fflag=false) and (gflag=false) then begin;textcolor(7);textbackground(0);curcolor:=7;end;
if (fflag=false) and (gflag=true) then begin;textcolor(7);curcolor:=7;end;
if (high=true) and (fflag=false) then textcolor(scaleh[curcolor]);
if (blink=true) and (fflag=false) then textcolor(scale[curcolor]+32);
if (blink=true) and (high=true) and (fflag=false) then textcolor(scaleh[curcolor]+32);
if (fflag=true) and (gflag=false) then begin;textbackground(0);end;
end;
if any=false then textcolor(scaleh[curcolor]);
{ 5/12/95 srl }
if (any2=false) then
if (high=true) then
begin
if (blink=true) then
textcolor(scaleh[curcolor]+32)
else
textcolor(scaleh[curcolor]);
end
else
if (blink=true) then textcolor(scale[curcolor]+32);
any2:=false;any:=false;fflag:=false;gflag:=false;norm:=false;
end;
'C': begin;
a:=1;
val(s[cp],a,tttt);
if tttt=0 then begin;
cp:=cp+1;
val(s[cp],ttt,tttt);
if tttt=0 then begin;
a:=a*10;
a:=a+ttt;
end;
end else a:=1;
ttt:=wherex;
if a+ttt<=80 then gotoxy(a+ttt,wherey);
end;
'D': begin;
a:=1;
val(s[cp],a,tttt);
if tttt=0 then begin;
cp:=cp+1;
val(s[cp],ttt,tttt);
if tttt=0 then begin;
a:=a*10;
a:=a+ttt;
end;
end else a:=1;
ttt:=wherex;
if ttt-a>=1 then gotoxy(ttt-a,wherey);
end;
'A': begin;
a:=1;
val(s[cp],a,tttt);
if tttt=0 then begin;
cp:=cp+1;
val(s[cp],ttt,tttt);
if tttt=0 then begin;
a:=a*10;
a:=a+ttt;
end;
end else a:=1;
ttt:=wherey;
if ttt-a>=1 then gotoxy(wherex,ttt-a);
end;
'B': begin;
a:=1;
val(s[cp],a,tttt);
if tttt=0 then begin;
cp:=cp+1;
val(s[cp],ttt,tttt);
if tttt=0 then begin;
a:=a*10;
a:=a+ttt;
end;
end else a:=1;
ttt:=wherey;
if ttt+a<=25 then gotoxy(wherex,ttt+a);
end;
'f','H': begin;
flag1:=false;
a:=1;
val(s[cp],a,tttt);
if tttt=0 then begin;
cp:=cp+1;
val(s[cp],ttt,tttt);
if tttt=0 then begin;
a:=a*10;
a:=a+ttt;
flag1:=true;
end;
end else a:=1;
jj:=a;
if flag1=false then cp:=cp+1;
if flag1=true then cp:=cp+2;
if cp<length(s) then begin;
a:=1;
val(s[cp],a,tttt);
if tttt=0 then begin;
cp:=cp+1;
val(s[cp],ttt,tttt);
if tttt=0 then begin;
a:=a*10;
a:=a+ttt;
end;
end else a:=1;
end else a:=1;
gotoxy(a,jj);
end;
else writeln(s);
end;
end;
Procedure ansi_write(ch: char);
begin;
case ch of
#12: clrscr;
#09: repeat; write(' '); until wherex/8 = wherex div 8;
#27: begin; escape:=true; bbb:=true; end;
else begin;
if escape then begin;
if (bbb=true) and (ch<>'[') then begin;
blink:=false;
high:=false;
escape:=false;
ansi_string:='';
write(#27);
end else bbb:=false;
if escape then begin;
ansi_string:=ansi_string+ch;
if ch=#13 then escape:=false;
if (ch in ['u','s','A','B','C','D','H','m','J','f','K','k',#14]) then begin;
escape:=false;
eval_string(ansi_string);
ansi_string:='';
end;
end;
end else write(ch);
end;
end;
end;
Procedure ansi_write_str(var s: string);
var
a: integer;
begin;
for a:=1 to length(s) do begin;
case s[a] of
#12: clrscr;
#09: repeat; write(' '); until wherex/8 = wherex div 8;
#27: begin; escape:=true; bbb:=true; end;
else begin;
if escape then begin;
if (bbb=true) and (s[a]<>'[') then begin;
blink:=false;
high:=false;
escape:=false;
ansi_string:='';
write(#27);
end else bbb:=false;
if escape then begin;
ansi_string:=ansi_string+s[a];
if s[a]=#13 then escape:=false;
if (s[a] in ['u','s','A','B','C','D','H','m','J','f','K','k',#14]) then begin;
escape:=false;
eval_string(ansi_string);
ansi_string:='';
end;
end;
end else write(s[a]);
end;
end;
end;
end;
procedure InitDDAnsi;
begin;
escape:=false;
ansi_string:='';
blink:=false;
high:=false;
end;
end.
