{
 ßßßßßßßß  ßßßßßß    ßß   ßß
   ßß     ßß   ßß   ßß  ßß
  ßß     ßß   ßßß  ßßßßß  The DoorKit!
 ßß     ßß   ßß   ßß  ßß
ßß     ßßßßßß    ßß    ßß
The BBS Door Development Kit By The People - For The People!


   Feel free to modify or optimize this code at will. All I ask is that if
   find a better way to do things (and you will), please send me a copy of
   your modifications. Thanks in advance!....Larry L. Athey....}

{$A+,B-,D+,E+,F+,G+,I-,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+}

UNIT ANSIUNIT;

INTERFACE

USES TDK_VARS, CRT, DOS;

PROCEDURE AnsiWrite(Ch : CHAR);
PROCEDURE AnsiWriteLn(S : STRING);
PROCEDURE PlaceCursor;

IMPLEMENTATION

CONST
  RecANSI : BOOLEAN = FALSE;

VAR
  Escape        : BYTE;
  Saved_X       : BYTE;
  Saved_Y       : BYTE;
  Control_Code  : STRING;
  Screen_Bottom : WORD;
  ThisSeg       : WORD;

PROCEDURE My_GotoXY(X,Y : BYTE);
BEGIN
  VirtX := X;
  VirtY := Y;
END;

PROCEDURE TABULATE;
VAR
  X : INTEGER;
BEGIN
  X := VirtX;
  IF X < 80 THEN REPEAT INC(X) UNTIL (X MOD 8) = 0;
  IF X = 80 THEN X := 1;
  My_GotoXY(X,VirtY);
  IF X = 1 THEN INC(VirtY);
END;

PROCEDURE BACKSPACE;
VAR
  X : INTEGER;
BEGIN
  IF VirtX > 1 THEN
  BEGIN
    DEC(VirtX);
    WRITE(' ');
    DEC(VirtX);
  END ELSE IF VirtY > 1 THEN BEGIN
    My_GotoXY(80,VirtY - 1);
    WRITE(' ');
    My_GotoXY(80,VirtY - 1);
  END;
END;

PROCEDURE WRITE(Ch : CHAR);
BEGIN
  CASE Ch OF
   ^G : BEGIN
          SOUND(2000);
          DELAY(100);
          NOSOUND;
        END;
   ^H : Backspace;
   ^I : Tabulate;
   ^J : BEGIN
          TEXTBACKGROUND(0);
          INC(VirtY);
        END;
   ^K : My_GotoXY(1,1);
   ^L : BEGIN
          TEXTBACKGROUND(0);
          My_GotoXY(1,1);
        END;
   ^M : BEGIN
          TEXTBACKGROUND(0);
          VirtX := 1;
        END;
    ELSE BEGIN
      Mem[ThisSeg : (160 * (VirtY - 1)) + (2 * (VirtX - 1))] := ORD(Ch);
      Mem[ThisSeg : (160 * (VirtY - 1)) + (2 * (VirtX - 1)) + 1] := TextAttr;
      INC(VirtX);
      IF VirtX = 81 THEN BEGIN
        VirtX := 1;
        INC(VirtY);
      END;
    END;
  END;
  IF (VirtY > Screen_Bottom) THEN Screen_Bottom := VirtY;
END;

FUNCTION GetNumber(VAR Line : STRING) : INTEGER;
VAR
  I,J,K : INTEGER;
  Temp0,
  Temp1 : STRING;
BEGIN
  Temp0 := Line;
  VAL(Temp0,I,J);
  IF J = 0 THEN temp0 := '' ELSE BEGIN
    Temp1 := COPY(Temp0,1,J-1);
    DELETE(Temp0,1,J);
    VAL(Temp1,I,J);
  END;
  Line := Temp0;
  GetNumber := I;
END;

PROCEDURE LoseIt;
BEGIN
  Escape := 0;
  Control_Code := '';
  RecANSI := FALSE;
END;

PROCEDURE Ansi_Cursor_Move;
VAR
  X,Y : INTEGER;
BEGIN
  Y := GetNumber(Control_Code);
  IF Y = 0 THEN Y := 1;
  X := GetNumber(Control_Code);
  IF X = 0 THEN X := 1;
  IF Y > 25 THEN Y := 25;
  IF X > 80 THEN X := 80;
  My_GotoXY(X,Y);
  LoseIt;
END;

PROCEDURE Ansi_Cursor_Up;
VAR
  Y,New_Y,OffSet : INTEGER;
BEGIN
  Offset := GetNumber(Control_Code);
  IF Offset = 0 THEN Offset := 1;
  Y := VirtY;
  IF (Y - Offset) < 1 THEN New_Y := 1 ELSE New_Y := Y - Offset;
  My_GotoXY(VirtX,New_Y);
  LoseIt;
END;

PROCEDURE Ansi_Cursor_Down;
VAR
  Y,New_Y,Offset : INTEGER;
BEGIN
  Offset := GetNumber(Control_Code);
  IF Offset = 0 THEN Offset := 1;
  Y := VirtY;
  IF (Y + Offset) > 25 THEN New_Y := 25 ELSE New_Y := Y + Offset;
  My_GotoXY(VirtX,New_Y);
  Loseit;
END;

PROCEDURE Ansi_Cursor_Left;
VAR
  x,new_x,offset : INTEGER;
BEGIN
  Offset := GetNumber(Control_Code);
  IF Offset = 0 THEN Offset := 1;
  X := VirtX;
  IF (X - Offset) < 1 THEN New_X := 1 ELSE New_X := X - Offset;
  My_GotoXY(New_X,VirtY);
  LoseIt;
END;

PROCEDURE Ansi_Cursor_Right;
VAR
  X,New_X,Offset : INTEGER;
BEGIN
  Offset := GetNumber(Control_Code);
  IF Offset = 0 THEN Offset := 1;
  X := VirtX;
  IF (X + Offset) > 80 THEN New_X := 1 ELSE New_X := X + Offset;
  My_GotoXY(New_X,VirtY);
  LoseIt;
END;

PROCEDURE Ansi_Clear_Screen;
BEGIN
  CLRSCR;
  My_GotoXY(1,1);
  LoseIt;
END;

PROCEDURE Ansi_Clear_EoLine;
VAR
  Temp : BYTE;
BEGIN
  Temp := VirtX;
  REPEAT
    Mem[ThisSeg : (160 * (VirtY - 1)) + (2 * (Temp - 1))] := ORD(' ');
    Mem[ThisSeg : (160 * (VirtY - 1)) + (2 * (Temp - 1)) + 1] := TextAttr;
    INC(Temp)
  UNTIL Temp > 80;
  LoseIt;
END;

PROCEDURE Reverse_Video;
VAR
  TempAttr, tBlink, TempAttrLO, TempAttrHI : BYTE;
BEGIN
  LOWVIDEO;
  TempAttrLO := (TextAttr AND $7);
  TempAttrHI := (TextAttr AND $70);
  tBlink     := (Textattr AND $80);
  TempAttrLO := TempattrLO * 16;
  TempAttrHI := TempAttrHI DIV 16;
  TextAttr   := TempAttrHI + TempAttrLO + tBlink;
END;

PROCEDURE Ansi_Set_Colors;
VAR
  Temp0,Color_Code : INTEGER;
BEGIN
  IF LENGTH(Control_Code) = 0 THEN Control_Code := '0';
  WHILE (LENGTH(Control_Code) > 0) DO BEGIN
    Color_Code := GetNumber(Control_Code);
    CASE Color_code OF
      0  :  BEGIN
              LOWVIDEO;
              TEXTCOLOR(7);
              TEXTBACKGROUND(0);
            END;
      1  : HIGHVIDEO;
      5  : TextAttr := (TextAttr OR $80);
      7  : Reverse_Video;
      30 : TextAttr := (TextAttr AND $F8) + 0;
      31 : TextAttr := (TextAttr AND $f8) + 4;
      32 : TextAttr := (TextAttr AND $f8) + 2;
      33 : TextAttr := (TextAttr AND $f8) + 6;
      34 : TextAttr := (TextAttr AND $f8) + 1;
      35 : TextAttr := (TextAttr AND $f8) + 5;
      36 : TextAttr := (TextAttr AND $f8) + 3;
      37 : TextAttr := (TextAttr AND $f8) + 7;
      40 : TEXTBACKGROUND(0);
      41 : TEXTBACKGROUND(4);
      42 : TEXTBACKGROUND(2);
      43 : TEXTBACKGROUND(14);
      44 : TEXTBACKGROUND(1);
      45 : TEXTBACKGROUND(5);
      46 : TEXTBACKGROUND(3);
      47 : TEXTBACKGROUND(15);
    END;
  END;
  LoseIt;
END;

PROCEDURE Ansi_Save_Cur_pos;
BEGIN
  Saved_X := VirtX;
  Saved_Y := VirtY;
  LoseIt;
END;

PROCEDURE Ansi_Restore_Cur_Pos;
BEGIN
  My_GotoXY(Saved_X,Saved_Y);
  LoseIt;
END;

PROCEDURE Ansi_Check_Code(Ch : CHAR);
BEGIN
  CASE Ch OF
    '0'..'9',
    ';' : Control_Code := Control_Code + Ch;
    'H',
    'f' : Ansi_Cursor_Move;
    'A' : Ansi_Cursor_Up;
    'B' : Ansi_Cursor_Down;
    'C' : Ansi_Cursor_Right;
    'D' : Ansi_Cursor_Left;
    'J' : Ansi_Clear_Screen;
    'K' : Ansi_Clear_EoLine;
    'm' : Ansi_Set_Colors;
    's' : Ansi_Save_Cur_Pos;
    'u' : Ansi_Restore_Cur_pos;
    '?' : {Garbage From TheDraw Screens....Why?....Who Knows....};
    ELSE LoseIt;
  END;
END;

PROCEDURE AnsiWrite(Ch : CHAR);
VAR
  Temp0 : INTEGER;
BEGIN
  IF Escape > 0 THEN BEGIN
    CASE Escape OF
      1 : BEGIN
            IF Ch = '[' THEN BEGIN
            Escape := 2;
            Control_Code := '';
            END ELSE escape := 0;
          END;
      2 : Ansi_Check_Code(Ch);
      ELSE BEGIN
        Escape := 0;
        Control_Code := '';
        RecANSI := FALSE;
      END;
    END;
  END ELSE BEGIN
    CASE Ch OF
      #27 : Escape := 1;
      #9  : BEGIN
              Temp0 := VirtX;
              Temp0 := Temp0 DIV 8;
              Temp0 := Temp0 + 1;
              Temp0 := Temp0 * 8;
              My_GotoXY(Temp0,VirtY);
            END;
      ELSE BEGIN
        IF ((VirtX = 80) AND (VirtY = 25)) THEN BEGIN
          WindMax := (80 + (24 * 256));
          WRITE(Ch);
          WindMax := (79 + (24 * 256));
        END ELSE WRITE(Ch);
        Escape := 0;
      END;
    END;
  END;
  RecANSI := (Escape <> 0);
END;

PROCEDURE PlaceCursor;
BEGIN
  GOTOXY(VirtX,VirtY);
END;

PROCEDURE AnsiWriteLn(S : STRING);
VAR
  I : BYTE;
BEGIN
  FOR I := 1 TO LENGTH(S) DO AnsiWrite(S[I]);
END;

BEGIN
  ThisSeg   := Segb800;
END.
