{*******************************************************}
{                                                       }
{       Turbo Pascal Version 7.0                        }
{       ANSI Output Unit                                }
{                                                       }
{       Copyright (c) 1994,95 by Solar Designer         }
{                                                       }
{*******************************************************}

unit SendANSI;
{$B-,G+}
interface

const
   ScreenAddr      :Pointer= Ptr($B800, 0);
   ScreenWidth     :Word =   80;
   SendWidth       :Word =   80;
   SendHeight      :Word =   24;

   ScreenSize      :Word =   0;
   SavedScreen     :Pointer= nil;

   MaxSendTime =   9;

   SendCharANSI    :Procedure (c       :Char) =  nil;
   CDANSI          :Function           :Boolean= nil;

procedure InitSendANSI;

procedure DoneSendANSI;

procedure UpdateSendANSI;

implementation

type
   TByteArray =    Array [0..32767] of Byte;
   PByteArray =    ^TByteArray;

procedure SendString(const s           :String);
var
   i               :Integer;
begin
   if @SendCharANSI<>nil then
   for i:=1 to Length(s) do SendCharANSI(s[i]);
end;

procedure SendXY(x, y                  :Integer);
var
   Buf1, Buf2      :String[3];
begin
   Str(y+1, Buf1); Str(x+1, Buf2);
   SendString(#27'['+Buf1+';'+Buf2+'H');
end;

procedure SendAttr(Attr                :Byte);
var
   Buf1            :Char;
   Buf2, Buf3      :String[3];
const
   Colors          :Array [0..7] of Byte =
   (0, 4, 2, 6, 1, 5, 3, 7);
begin
   if Attr=$07 then SendString(#27'[0m') else
   begin
      if Attr and $80<>0 then Buf1:='5' else
      if Attr and $08<>0 then Buf1:='1' else Buf1:='0';
      Str(30+Colors[Attr and $07], Buf2);
      Str(40+Colors[(Attr and $70) shr 4], Buf3);
      SendString(#27'['+Buf1+';'+Buf2+';'+Buf3+'m');
   end;
end;

procedure SendClear;
begin
   SendString(#27'[2J');
end;

procedure InitSendANSI;
begin
   DoneSendANSI;
   ScreenSize:=ScreenWidth*SendHeight shl 1;
   if ScreenSize>MaxAvail then
   begin
      ScreenSize:=0; Exit;
   end;
   GetMem(SavedScreen, ScreenSize);
   FillChar(SavedScreen^, ScreenSize, 0);

   SendClear;
end;

procedure DoneSendANSI;
begin
   if ScreenSize<>0 then
   begin
      FreeMem(SavedScreen, ScreenSize); ScreenSize:=0;
      SendAttr($07); SendClear;
   end;
end;

function  GetChar(s                    :Pointer;
                  x, y                 :Integer) :Char;
assembler;
asm
   mov  ax,y
   mul  ScreenWidth
   add  ax,x
   add  ax,ax
   mov  bx,ax
   les  di,s
   mov  al,es:[di+bx]
end;

function  GetAttr(s                    :Pointer;
                  x, y                 :Integer) :Byte;
assembler;
asm
   inc  word ptr s
   leave
   jmp  GetChar
end;

procedure MoveChar(Src, Dst            :Pointer;
                   x, y                :Integer);
assembler;
asm
   push ds
   mov  ax,y
   mul  ScreenWidth
   add  ax,x
   add  ax,ax
   lds  si,Src
   les  di,Dst
   add  si,ax
   add  di,ax
   movsw
   pop  ds
end;

procedure UpdateSendANSI;
var
   x, y,
   cx, cy, ca,
   cp              :Integer;
   CShp            :Byte;
   CpChg           :Boolean;
   c               :Char;
   Timer           :Word absolute 0:$46C;
   LTimer          :Word;
const
   Lcp   :Integer= -1;
   LCShp :Byte=    $FF;
begin
   if (ScreenSize=0) or not Assigned(SendCharANSI) or not Assigned(CDANSI) then Exit;

   cx:=-1; cy:=-1; ca:=-1; CpChg:=False;

   asm
      mov  ah,03h
      xor  bx,bx
      int  10h
      mov  cp,dx
      mov  CShp,ch
   end;

   LTimer:=Timer;
   for y:=0 to SendHeight-1 do
   begin
      for x:=0 to SendWidth-1 do
      if ((GetChar(ScreenAddr, x, y)<>GetChar(SavedScreen, x, y)) or
         (GetAttr(ScreenAddr, x, y)<>GetAttr(SavedScreen, x, y))) and
         ((y<>SendHeight-1) or (x<>SendWidth-1)) then
      begin
         if (x<>cx) or (y<>cy) then SendXY(x, y);
         if GetAttr(ScreenAddr, x, y)<>ca then SendAttr(GetAttr(ScreenAddr, x, y));
         c:=GetChar(ScreenAddr, x, y);
         case c of
            #16, #26: c:='>';
            #17, #27: c:='<';
            #0, #255: c:=' ';
         end;
         SendCharANSI(c);
         ca:=GetAttr(ScreenAddr, x, y);
         cx:=x+1; cy:=y; if cx>=SendWidth then cx:=-1;
         CpChg:=True;

         MoveChar(ScreenAddr, SavedScreen, x, y);

         if not CDANSI then Exit;
      end;

      if (Timer<LTimer) or (Timer-LTimer>MaxSendTime) then Break;
   end;

   if (cp<>Lcp) or (CShp<>LCShp) or CpChg then
   if CShp=$20 then SendXY(0, 0) else SendXY(Lo(cp), Hi(cp));
   Lcp:=cp; LCShp:=CShp;
end;

end.