{$IFNDEF OS2}
{$F+}
{$ENDIF}

Unit Avatar;

Interface

Procedure WriteCharAvt (Ch: Char);
Procedure WriteStringAvt (S: String);

Function AvtGotoXY (X, Y: Byte): String;
Function AvtColor (Fg, Bg: Byte): String;
Function AvtUp (Lines: Byte): String;
Function AvtDown (Lines: Byte): String;
Function AvtLeft (Cols: Byte): String;
Function AvtRight (Cols: Byte): String;
Function AvtClearWindow (X1, Y1, X2, Y2: Byte): String;

Const
  BC: Byte = 0;

Implementation

Uses
{$IFDEF WIN32}
  Console,
  Wapro,
{$ENDIF}
  OpCrt,
  tGlob;

Const
  DefAttr = 3;

Var
  Buf: Array [1..5] Of Char;
  Tmp: String;

Procedure WriteStringAvt;
Var
  i : Byte;

Begin
  For i := 1 To Length (S) Do WriteCharAvt (S [i]);
End;

Procedure WriteCharAvt;
Var
  i: Char;

Begin
  If BC = 0 Then
  Case Ch Of
    #12: Begin
           TextAttr := DefAttr;
           SetCrtColor;
           ClrScr;
           Exit;
         End;

    #25: Begin
           BC := 2;
           Buf [2] := Ch;
           Exit;
         End;
  Else
    If (Ch <> #1) And (Ch <> #22) Then
    Begin
      Write (Ch);
      Exit;
    End Else
    Begin
      Buf [1] := Ch;
      BC := 1;
      Exit;
    End;
  End;

  If BC=1 Then
  Case Ch Of
    #1,
    #8,
    #25: Begin
           BC := 2;
           Buf [2] := Ch;
           Exit;
         End;

    #2 : Begin
            BC := 0;
            TextAttr := TextAttr Or 128;
            SetCrtColor;
            Exit;
         End;

    #3 : Begin
           BC := 0;
           If WhereY > 0 Then GoToXY (WhereX, WhereY-1);
           Exit;
         End;

    #4 : Begin
           BC := 0;
           If WhereY < 24 Then GoToXY (WhereX, WhereY+1);
           Exit;
         End;

    #5 : Begin
           BC := 0;
           If WhereX>0 Then GoToXY(WhereX-1, WhereY);
           Exit;
         End;

    #6 : Begin
           BC := 0;
           If WhereX < 79 Then GoToXY (WhereX+1, WhereY);
           Exit;
         End;

    #7 : Begin
           BC := 0;
           ClrEoL;
           Exit;
         End;

  Else
    If Buf [1] = #1 Then
    Begin
      WaitReturn;
    End Else
    Begin
      Write (Buf [1]);
      Write (Ch);
    End;

    BC := 0;
    Exit;
  End;

  If BC = 2 Then
  If Buf [2] = #1 Then
  Begin
    TextAttr := Byte (Ch);
    SetCrtColor;
    BC := 0;
    Exit;
  End Else
  Begin
    BC := 3;
    Buf [3] := Ch;
    Exit;
  End;

  If BC = 3 Then
  Begin
    Case Buf [2] Of
      #25: Begin
            For I := #1 to Ch Do
            If Buf [3] = #1 Then WaitReturn Else Write (Buf [3]);
            BC := 0;
            Exit;
          End;

      #8 : Begin
             GoToXY (Byte (Ch), Byte (Buf[3]));
             BC := 0;
             Exit;
           End;
    End;
  End;
End;

Function AvtGoToXY;
Begin
  AvtGoToXY := ^V + ^H + Chr (Y) + Chr (X);
End;

Function AvtUp;
Var
  i      : Byte;

Begin
  tmp := '';
  For i := 1 To Lines Do tmp := tmp + ^V + ^C;
  AvtUp := tmp;
End;

Function AvtDown;
Var
  i      : Byte;

Begin
  tmp := '';
  For i := 1 To Lines Do tmp := tmp + ^V + ^D;
  AvtDown := tmp;
End;

Function AvtLeft;
Var
  i      : Byte;

Begin
  tmp := '';
  For i := 1 To Cols Do tmp := tmp + ^V + ^E;
  AvtLeft := tmp;
End;

Function AvtRight;
Var
  i      : Byte;

Begin
  tmp := '';
  For i := 1 To Cols Do tmp := tmp + ^V + ^F;
  AvtRight := tmp;
End;

Function AvtColor;
Var
  tmp: String [12];
  attr: Byte;

Begin
  attr := (Bg ShL 4) Or (Fg And $0f);
  tmp := ^V + ^A + Chr (attr And $7f);
  If attr > 127 Then tmp := tmp + ^V + ^B;
  AvtColor := tmp;
End;

Function AvtClearWindow (X1, Y1, X2, Y2: Byte): String;
Begin
  AvtClearWindow := ^V^J + Chr (X1) + Chr (Y1) + Chr (X2) + Chr (Y2) + Chr (Y2-Y1+1);
End;

End.