800 lines
30 KiB
ObjectPascal
800 lines
30 KiB
ObjectPascal
{ 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-,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
|
|
{rcg11172000 commented out.}
|
|
(*
|
|
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
|
|
{rcg11172000 commented out.}
|
|
(*
|
|
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
|
|
{rcg11172000 commented out.}
|
|
(*
|
|
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
|
|
{rcg11172000 commented out.}
|
|
(*
|
|
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
|
|
{rcg11172000 commented out.}
|
|
(*
|
|
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
|
|
{rcg11172000 commented out.}
|
|
(*
|
|
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
|
|
{rcg11172000 commented out.}
|
|
(*
|
|
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
|
|
{rcg11172000 commented out.}
|
|
(*
|
|
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.
|