{ TPANSI Ver 2.2 (c) September 1988 by James R. Louvau. }
{ This code may be freely used and distributed for NON-COMMERCIAL applications}
{ only! Permission for use of any other kind must come from the author, }
{ IN WRITING! It may be distributed under the name TPANSI (any version) only }
{ if left in it's ORIGINAL FORM! Experimentation and additions are expected }
{ and encouraged, but I won't take responsability for anybody else's source }
{ code without seeing and authorizing it first. Have fun, and I hope it helps!}
{USAGE: }
{ Include TPANSIx in your UNITS as: }
{ USES TPansi; }
{ }
{ Whenever you want output thru an ansi filter, just output to the }
{ ansi file as: }
{ writeln(ansi,^[,'[5mThis will display blinking'); }
{ }
{ ansi is defined globally as: }
{ var }
{ ansi: TEXT; }
{ and is automatically set up and opened for OUTPUT by the unit, just }
{ like Turbo's 'output' file. }
{ READS are unaffected by TPANSI. }
{ TPANSI is aware, and conforms to all of Turbo's built in settings }
{ and variables. i.e.: }
{ DirectVideo, CheckSnow, WhereX, Window, etc. work as intended. }
{ }
{ There is also a global boolean variable called 'ansion', that is set }
{ to TRUE upon initialization, that may be used to toggle the }
{ processing of ANSI escape sequences on and off. }
{ }
{HISTORY: }
{ Version 1.0 - Initial release }
{ Version 2.0 - Most low level routines re-coded as inline assembly }
{ code for speed. }
{ Changed PutC to allow direct screen writes. }
{ Implemented global variable 'ansion' for to facilitate }
{ enable/disable of ANSI processing. }
{ Version 2.1 - Changed scroll routine for linefeeds @ bottom of window }
{ or screen, to do direct video ram to video ram moves }
{ when DirectVideo is on, for scrolling speed. }
{ Version 2.2 - Added code to check current video mode and to check for }
{ an EGA/VGA. This procedure automatically sets CheckSnow }
{ to FALSE upon startup if it detects mode 7 (monochrome) }
{ or if it finds an EGA/VGA card - also for speed. }
{ }
{$R-,S+,I+,D+,F-,G+,V-,B-,N-,L+ }
{$M 65520,0,655360 }
unit tpansi;
interface
uses crt,dos;
const
ansion:boolean=TRUE;
ansisz:word=$0080;
leftarrowkey=#75;
rightarrowkey=#77;
insertkey=#82;
deletekey=#83;
homekey=#71;
endkey=#79;
var
ansiin,ansiout:text;
procedure getcursortype(var top,bottom:integer);
procedure assignansi(var f:text);
implementation
var
r:registers;
procedure getcursortype(var top,bottom:integer);
begin
inline($b8/$00/$03/ {mov ax,$0300}
$31/$db/ {xor bx,bx}
$cd/$10/ {int $10}
$31/$c0/ {xor ax,ax}
$88/$e8/ {mov al,ch}
$c4/$be/>top/ {les di,>top[bp]}
$ab/ {stosw}
$88/$c8/ {mov al,cl}
$c4/$be/>bottom/ {les di,>bottom[bp]}
$ab); {stosw}
end;
procedure setcursortype(top,bottom:integer);
begin
inline($b8/$00/$01/ {mov ax,$0100}
$8a/$6e/<top/ {mov ch,<top[bp]}
$8a/$4e/<bottom/ {mov cl,<bottom[bp]}
$cd/$10); {int $10}
end;
procedure getxy(var x,y:integer);
begin
inline($b8/$00/$03/ { mov ax,$0300 }
$31/$db/ { xor bx,bx }
$cd/$10/ { int $10 }
$31/$c0/ { xor ax,ax }
$88/$d0/ { mov al,dl }
$c4/$be/>x/ { les di,>x[bp] }
$ab/ { stosw }
$88/$f0/ { mov al,dh }
$c4/$be/>y/ { les di,>y[bp] }
$ab); { stosw }
end;
procedure setxy(x,y:integer);
begin
inline($8b/$9e/>x/ { mov bx,>x[bp] }
$8b/$86/>y/ { mov ax,>y[bp] }
$3e/$8b/$0e/>windmin/ {ds:mov cx,word PTR[>WindMin] }
$3e/$8b/$16/>windmax/ {ds:mov dx,word PTR[>WindMax] }
$88/$c7/ { mov bh,al }
$38/$cb/ { cmp bl,cl }
$73/$04/ { jae C0 }
$88/$cb/ { mov bl,cl }
$eb/$06/ { jmp short C1 }
$38/$d3/ {C0:cmp bl,dl }
$76/$02/ { jbe C1 }
$88/$d3/ { mov bl,dl }
$38/$ef/ {C1:cmp bh,ch }
$73/$04/ { jae C2 }
$88/$ef/ { mov bh,ch }
$eb/$06/ { jmp short C3 }
$38/$f7/ {C2:cmp bh,dh }
$76/$02/ { jbe C3 }
$88/$f7/ { mov bh,dh }
$89/$da/ {C3:mov dx,bx }
$31/$db/ { xor bx,bx }
$b8/$00/$02/ { mov ax,$0200 }
$cd/$10); { int $10 }
end;
procedure putc(c:char);
begin
inline($3e/$a0/>directvideo/ { ds:mov al,byte PTR[>DirectVideo] }
$3c/$01/ { cmp al,1 }
$75/$5b/ { jne BIOS }
$b8/$40/$00/ { mov ax,$0040 }
$8e/$c0/ { mov es,ax }
$26/$8b/$1e/$50/$00/ { es:mov bx,word PTR[$0050] }
$26/$a1/$4a/$00/ { es:mov ax,word PTR[$004A] }
$31/$c9/ { xor cx,cx }
$88/$f9/ { mov cl,bh }
$f7/$e1/ { mul cx }
$30/$ff/ { xor bh,bh }
$01/$d8/ { add ax,bx }
$d1/$e0/ { shl ax,1 }
$89/$c7/ { mov di,ax }
$26/$a0/$49/$00/ { es:mov al,byte PTR[$0049] }
$3c/$07/ { cmp al,7 }
$75/$05/ { jne COLO }
$b8/$00/$b0/ { mov ax,$B000 }
$eb/$03/ { jmp short MONO }
$b8/$00/$b8/ {COLO: mov ax,$B800 }
$8e/$c0/ {MONO: mov es,ax }
$8a/$46/<c/ { mov al,<c[bp] }
$3e/$8a/$26/>textattr/ { ds:mov ah,byte PTR[>TextAttr] }
$3e/$8a/$1e/>checksnow/ { ds:mov bl,byte PTR[>CheckSnow] }
$80/$fb/$01/ { cmp bl,1 }
$74/$04/ { je SLOW }
$ab/ { stosw }
$e9/$28/$00/ { jmp EXIT }
$89/$c3/ {SLOW: mov bx,ax }
$ba/$da/$03/ { mov dx,$03DA }
$ec/ {HORZ: in al,dx }
$d0/$d8/ { rcr al,1 }
$72/$fb/ { jc HORZ }
$fa/ { cli }
$ec/ {VERT: in al,dx }
$24/$09/ { and al,9 }
$75/$fb/ { jnz VERT }
$89/$d8/ { mov ax,bx }
$ab/ { stosw }
$fb/ { sti }
$e9/$11/$00/ { jmp EXIT }
$b4/$09/ {BIOS: mov ah,$09 }
$8a/$46/<c/ { mov al,<c[bp] }
$b7/$00/ { mov bh,0 }
$3e/$8a/$1e/>textattr/ { ds:mov bl,byte PTR[>TextAttr] }
$b9/$01/$00/ { mov cx,$0001 }
$cd/$10); { int $10 }
{EXIT: }
end;
procedure scroll;
begin
inline($3e/$a0/>directvideo/ { ds:mov al,byte PTR[>DirectVideo] }
$3e/$8b/$0e/>windmin/ { ds:mov cx,word PTR[>WindMin] }
$3e/$8b/$16/>windmax/ { ds:mov dx,word PTR[>WindMax] }
$3c/$01/ { cmp al,1 }
$74/$03/ { je DIRECT }
$e9/$a4/$00/ { jmp BIOS }
$1e/ {DIRECT: push ds }
$31/$c0/ { xor ax,ax }
$8e/$c0/ { mov es,ax }
$26/$8b/$1e/$4a/$04/ { es:mov bx,word PTR[$044A] }
$88/$f0/ { mov al,dh }
$28/$e8/ { sub al,ch }
$50/ { push ax }
$88/$d0/ { mov al,dl }
$28/$c8/ { sub al,cl }
$fe/$c0/ { inc al }
$50/ { push ax }
$88/$e8/ { mov al,ch }
$f7/$e3/ { mul bx }
$30/$ed/ { xor ch,ch }
$01/$c8/ { add ax,cx }
$d1/$e0/ { shl ax,1 }
$89/$c7/ { mov di,ax }
$d1/$e3/ { shl bx,1 }
$01/$d8/ { add ax,bx }
$89/$c6/ { mov si,ax }
$b9/$00/$b0/ { mov cx,$B000 }
$26/$a0/$49/$04/ { es:mov al,byte PTR[$0449] }
$3c/$07/ { cmp al,7 }
$74/$04/ { je MONO }
$81/$c1/$00/$08/ { add cx,$0800 }
$8e/$c1/ {MONO: mov es,cx }
$fc/ { cld }
$59/ { pop cx }
$5A/ { pop dx }
$d1/$eb/ { shr bx,1 }
$29/$cb/ { sub bx,cx }
$d1/$e3/ { shl bx,1 }
$3e/$a0/>checksnow/ { ds:mov al,byte PTR[>CheckSnow] }
$8c/$c0/ { mov ax,es }
$8e/$d8/ { mov ds,ax }
$3c/$01/ { cmp al,1 }
$75/$1f/ { jne FAST }
$52/ {SLOW0: push dx }
$51/ { push cx }
$ba/$da/$03/ {SLOW1: mov dx,$03DA }
$ec/ {HORZ: in al,dx }
$d0/$d8/ { rcr al,1 }
$72/$fb/ { jc HORZ }
$fa/ { cli }
$ec/ {VERT: in al,dx }
$24/$09/ { and al,9 }
$75/$fb/ { jnz VERT }
$a5/ { movsw }
$fb/ { sti }
$e2/$ee/ { loop SLOW1 }
$59/ { pop cx }
$5a/ { pop dx }
$01/$de/ { add si,bx }
$01/$df/ { add di,bx }
$4a/ { dec dx }
$74/$0d/ { jz FILL }
$eb/$e1/ { jmp short SLOW0 }
$51/ {FAST: push cx }
$f2/$a5/ { rep movsw }
$59/ { pop cx }
$01/$df/ { add di,bx }
$01/$de/ { add si,bx }
$4a/ { dec dx }
$75/$f5/ { jnz FAST }
$1f/ {FILL: pop ds }
$3e/$8a/$26/>textattr/ { ds:mov ah,byte PTR[>TextAttr] }
$b0/$20/ { mov al,' ' }
$3e/$8a/$1e/>checksnow/ { ds:mov bl,byte PTR[>CheckSnow] }
$80/$fb/$01/ { cmp bl,1 }
$75/$16/ { jne FAST1 }
$89/$c3/ { mov bx,ax }
$ba/$da/$03/ { mov dx,$03DA }
$ec/ {HORZ1: in al,dx }
$d0/$d8/ { rcr al,1 }
$72/$fb/ { jc HORZ1 }
$fa/ { cli }
$ec/ {VERT1: in al,dx }
$24/$09/ { and al,9 }
$75/$fb/ { jnz VERT1 }
$ab/ { stosw }
$fb/ { sti }
$e2/$f1/ { loop HORZ1 }
$eb/$0e/ { jmp short DONE }
$f2/$ab/ {FAST1: rep stosw }
$eb/$0a/ { jmp short DONE }
$b8/$01/$06/ {BIOS: mov ax,$0601 }
$3e/$8a/$3e/>textattr/ { ds:mov bh,byte PTR[>TextAttr] }
$cd/$10) { int $10 }
{DONE: }
end;
procedure carriagereturn;
var x,y:integer;
begin
getxy(x,y);
if (x>lo(windmin)) then setxy(lo(windmin),y);
end;
procedure linefeed;
var x,y:integer;
begin
getxy(x,y);
if (y<hi(windmax)) then setxy(x,succ(y)) else scroll;
end;
procedure bell;
begin
sound(440);
delay(100);
nosound;
end;
procedure backspace;
var x,y:integer;
begin
getxy(x,y);
if (x>lo(windmin)) then setxy(pred(x),y) else
if (y>hi(windmin)) then setxy(lo(windmax),pred(y));
{* putc(' ');*} {* messing up message ANSI B.S.!!!!! *}
end;
procedure character(c:char);
var x,y:integer;
begin
getxy(x,y); putc(c);
if (x<lo(windmax)) then setxy(succ(x),y) else
if (y<hi(windmax)) then setxy(lo(windmin),succ(y))
else begin
scroll;
setxy(lo(windmin),y);
end;
end;
function getnumber(var s:string):integer;
var t:string;
l:longint;
e,n:integer;
begin
{$I-}
if (length(s)=0) then getnumber:=0
else begin
n:=pos(';',s);
if (n = 0) then begin
t:=s;
s:=''
end else begin
t:=copy(s,1,n-1);
delete(s,1,n)
end;
val(t,l,e);
if (ioresult<>0) or (e<>0) then n:=0 else n:=integer(l);
getnumber:=n;
end;
{$I+}
end;
procedure ansiup(var s:string);
var x,y,n:integer;
begin
getxy(x,y);
n:=getnumber(s);
if (n<1) then n:=1;
y:=y-lo(n);
if (y<hi(windmin)) then y:=hi(windmin) else
if (y>hi(windmax)) then y:=hi(windmax);
setxy(x,y);
end;
procedure ansidn(var s:string);
var x,y,n:integer;
begin
getxy(x,y);
n:=getnumber(s);
if (n<1) then n:=1;
y:=y+lo(n);
if (y>hi(windmax)) then y:=hi(windmax) else
if (y<hi(windmin)) then y:=hi(windmin);
setxy(x,y);
end;
procedure ansilt(var s:string);
var x,y,n:integer;
begin
getxy(x,y);
n:=getnumber(s);
if (n<1) then n:=1;
x:=x-lo(n);
if (x<lo(windmin)) then x:=lo(windmin) else
if (x>lo(windmax)) then x:=lo(windmax);
setxy(x,y);
end;
procedure ansirt(var s:string);
var x,y,n:integer;
begin
getxy(x,y);
n:=getnumber(s);
if (n<1) then n:=1;
x:=x+lo(n);
if (x>lo(windmax)) then x:=lo(windmax) else
if (x<lo(windmin)) then x:=lo(windmin);
setxy(x,y);
end;
procedure ansito(var s:string);
var i,n:integer;
begin
n:=getnumber(s);
i:=getnumber(s);
if (n<1) then n:=1;
if (i<1) then i:=1;
gotoxy(i,n);
end;
procedure ansixy(save:boolean);
const
x:word=0;
y:word=0;
begin
if (save) then begin
x:=wherex;
y:=wherey;
end else
if ((x>0) and (y>0)) then gotoxy(x,y);
end;
procedure ansicl;
begin
clreol;
end;
procedure ansics(var s:string);
begin
if (getnumber(s)=2) then clrscr;
end;
procedure reverse;
begin
inline($3e/$a0/>textattr/ { ds:mov al,byte PTR[TextAttr] }
$88/$c3/ { mov bl,al }
$80/$e3/$07/ { and bl,7 }
$b9/$04/$00/ { mov cx,4 }
$d2/$e3/ { shl bl,cl }
$88/$c7/ { mov bh,al }
$b9/$04/$00/ { mov cx,4 }
$d2/$ef/ { shr bh,cl }
$80/$e7/$07/ { and bh,7 }
$24/$88/ { and al,136 }
$08/$fb/ { or bl,bh }
$08/$d8/ { or al,bl }
$3e/$a2/>textattr); { ds:mov byte PTR[TextAttr],al }
end;
procedure conceal;
begin
inline($3e/$a0/>textattr/ { ds:mov al,byte PTR[>TextAttr] }
$24/$70/ { and al,112 }
$88/$c3/ { mov bl,al }
$b9/$04/$00/ { mov cx,4 }
$d2/$eb/ { shr bl,cl }
$08/$d8/ { or al,bl }
$3e/$a2/>textattr); { ds:mov byte PTR[>TextAttr],al }
end;
procedure ansico(var s:string);
var n:integer;
procedure ftc(f:byte);
begin
textattr:=(textattr and 248) or f;
end;
procedure btc(b:byte);
begin
textattr:=(textattr and 143) or (b shl 4);
end;
begin
if (length(s)=0) then normvideo;
while (length(s)>0) do begin
n:=getnumber(s);
if (n<0) then n:=0;
{ : B : b b b : f f f f : }
case lo(n) of
0:textattr:=7; { normal video }
1:textattr:=textattr or 8; { turn on f1 }
2:textattr:=textattr and 247; { knock off f1 }
5:textattr:=textattr or 128; { turn on B }
6:textattr:=textattr or 128; { turn on B }
7:reverse;
8:conceal;
30:ftc(black);
31:ftc(red);
32:ftc(green);
33:ftc(brown);
34:ftc(blue);
35:ftc(magenta);
36:ftc(cyan);
37:ftc(lightgray);
40:btc(black);
41:btc(red);
42:btc(green);
43:btc(brown);
44:btc(blue);
45:btc(magenta);
46:btc(cyan);
47:btc(lightgray)
end;
end;
end;
procedure ansioutput(c:char);
const isansi:boolean=FALSE;
ansis:string='';
lastc:char=#0;
begin
if (isansi) and (ansion) then begin
if (c in ['H','F','A'..'D','s','u','J','K','m']) then begin
case c of
'H','F':ansito(ansis);
'A':ansiup(ansis);
'B':ansidn(ansis);
'C':ansirt(ansis);
'D':ansilt(ansis);
's':ansixy(TRUE);
'u':ansixy(FALSE);
'J':ansics(ansis);
'K':ansicl;
'm':ansico(ansis);
end;
isansi:=FALSE;
end
else
if (c in ['0'..'9',';']) and (length(ansis)<255) then
ansis:=ansis+c
else
isansi:=FALSE;
end else begin
if (c<' ') then
case c of
#7 : bell;
#8 : backspace;
#10: linefeed;
#12: clrscr;
#13: carriagereturn;
#27: if (lastc=c) then character(^[);
else
character(c);
end
else
if (lastc<>^[) then character(c)
else
if (c='[') and (ansion) then begin
isansi:=TRUE;
ansis:='';
end else begin
character(^[);
character(c);
end;
end;
lastc:=c
end;
procedure showstr(var b:textbuf; p,l:word);
var n:word;
begin
for n:=p to (p+l) do character(b[n]);
end;
procedure setsnow;
begin
inline($3e/$a0/>directvideo/ { ds:mov al,byte PTR[>DirectVideo] }
$3c/$01/ { cmp al,1 }
$74/$07/ { jz DIRECT }
$b8/$00/$0f/ { mov ax,$0F00 }
$cd/$10/ { int $10 }
$eb/$08/ { jmp short CHKMODE }
$31/$c0/ {DIRECT: xor ax,ax }
$8e/$c0/ { mov es,ax }
$26/$a0/$49/$04/ { es:mov al,byte PTR[$0449] }
$3c/$07/ {CHKMODE: cmp al,7 }
$74/$0c/ { je SETFAST }
$b4/$12/ { mov ah,$12 }
$bb/$10/$ff/ { mov bx,$FF10 }
$cd/$10/ { int $10 }
$80/$ef/$ff/ { sub bh,$FF }
$74/$04/ { jz NOTFAST }
$31/$c0/ {SETFAST: xor ax,ax }
$eb/$02/ { jmp short SET }
$b0/$01/ {NOTFAST: mov al,$01 }
$3e/$a2/>checksnow); {SET: ds:mov byte PTR[>CheckSnow],al }
end;
{$F+}
function closeansiout(var t:textrec):integer;
begin
t.mode:=fmclosed;
closeansiout:=0;
end;
function closeansiin(var t:textrec):integer;
begin
t.mode:=fmclosed;
closeansiin:=0;
end;
function sendansiout(var t:textrec):integer;
var p:word;
begin
with t do begin
if (mode=fmoutput) then begin
p:=0;
while (p<bufpos) do begin
ansioutput(bufptr^[p]);
inc(p);
end;
bufpos:=0;
sendansiout:=0;
end
else if (mode=fmclosed) then sendansiout:=103 else sendansiout:=104;
end;
end;
function nilansi(var t:textrec):integer;
begin
nilansi:=0;
end;
function readansiin(var t:textrec):integer;
begin
exit;
end;
(*
function readansiin(var t:textrec):integer;
const inson:boolean=FALSE;
var p,l,m:word;
x,y,top,bottom:integer;
c:char;
begin
getcursortype(top,bottom);
if (inson) then setcursortype(0,bottom)
else setcursortype(pred(bottom and $0F),bottom);
getxy(x,y);
p:=0;
l:=0;
with t do begin
if (mode=fminput) then begin
m:=lo(windmax)-x+1;
if (ansisz<m) then m:=ansisz;
if (bufsize<m) then m:=bufsize;
if (m+2>bufsize) then m:=bufsize-2;
repeat
setxy(x+p,y);
c:=readkey;
case c of
#0:begin
c:=readkey;
case c of
leftarrowkey : if (p>0) then dec(p);
rightarrowkey: if (p<l) and (p<pred(m)) then inc(p);
insertkey : begin
inson:=(not inson);
if (inson) then setcursortype(0,bottom) else
setcursortype(pred(bottom and $0f),bottom);
end;
deletekey : if (p<l) then begin
move(bufptr^[p+1],bufptr^[p],l-p-1);
bufptr^[l-1]:=' ';
showstr(bufptr^,p,l-p);
dec(l);
end;
homekey : p:=0;
endkey : if (l<m) then p:=l else p:=pred(l);
end;
end;
#8:if (l>0) then
if (p=l) then begin
dec(p);
dec(l);
bufptr^[p]:=#0;
setxy(x+p,y);
putc(' ');
end else begin
if (p>0) then dec(p);
move(bufptr^[p+1],bufptr^[p],l-p-1);
bufptr^[l-1]:=' ';
showstr(bufptr^,p,l-p);
dec(l);
end
else if (p>0) and (l=0) then dec(p);
#27:begin
fillchar(bufptr^,l,' ');
showstr(bufptr^,0,l);
l:=0;
p:=0;
end;
#13:{null};
#10:c:=#13
else
begin
if (p<l) and (inson) then begin
if (l=m) then dec(l);
move(bufptr^[p],bufptr^[p+1],l-p);
bufptr^[p]:=c;
inc(l);
showstr(bufptr^,p,l-p);
end else begin
bufptr^[p]:=c;
putc(c);
if (p=l) and (l<m) then inc(l);
end;
if (p<l) and (p<pred(m)) then inc(p);
end;
end;
until (c in [#13,#27]);
bufptr^[l]:=#13;
bufptr^[l+1]:=#10;
bufend:=l+2;
bufpos:=0;
readansiin:=0;
end else
if (mode=fmclosed) then readansiin:=103 else readansiin:=105;
end;
setcursortype(top,bottom);
end;
*)
function openansi(var t:textrec):integer;
begin
with t do begin
if (mode=fminout) then mode:=fmoutput;
bufpos:=0;
if (mode=fmoutput) then begin
inoutfunc:=@sendansiout;
flushfunc:=@sendansiout;
closefunc:=@closeansiout;
end else begin
mode:=fminput;
inoutfunc:=@readansiin;
flushfunc:=@nilansi;
closefunc:=@closeansiin;
end;
openansi:=0;
end;
end;
procedure assignansi(var f:text);
begin
fillchar(f,sizeof(textrec),0);
with textrec(f) do begin
handle:=$FFFF;
mode:=fmclosed;
bufptr:=@buffer;
bufsize:=sizeof(buffer);
openfunc:=@openansi;
end;
end;
{$F-}
begin
assignansi(ansiout);
rewrite(ansiout);
assignansi(ansiin);
reset(ansiin);
ansion:=TRUE;
setsnow;
end.