Unit G320;

Interface

Type
  _WindowPtr = ^_Win;
  _Win       = Record
                 _X1        : Word;
                 _Y1        : Word;
                 _X2        : Word;
                 _Y2        : Word;
                 _Size      : Word;
                 _FillColor : Byte;
                 _Back      : Pointer;
                 _Active    : Boolean;
               End;
  _ListPtr   = ^_List;
  _List      = Record
                 _Next   : _ListPtr;
                 _Prev   : _ListPtr;
                 _Window : _WindowPtr;
               End;

Var
  FontPtr        : Pointer;
  _WindowList    : _ListPtr;
  _ListWork      : _ListPtr;

Procedure PutPixel(X,Y: Word; Color: Byte);
Procedure Line(X1,Y1,X2,Y2,Color: Word);
Procedure PutChar(X,Y: Word; C: Char; Color: Word);
Procedure WriteOut(X,Y: Word; St: String; Color: Word);
Procedure Box(X1,Y1,X2,Y2: Word; Color: Byte);
Procedure FBox(X1,Y1,X2,Y2: Word; Color: Byte);
Procedure Go_Mode(ModeNum : Byte);
Function  __MakeWin(Var W: _WindowPtr; X1,Y1,X2,Y2: Word; Fill: Byte): Boolean;
Function  __DispWin(Var W: _WindowPtr): Boolean;
Function  __RemWin: Boolean;

Implementation

Uses Dos,Mouse;

{Var
  FontPtr        : Pointer;
  _WindowList    : _ListPtr;
  _ListWork      : _ListPtr;}

Procedure PutPixel(X,Y: Word; Color: Byte);
Var M: Boolean;
Begin
  M := MouseVisible;
  If M Then ToggleMouseVisibility;
  Mem[$A000:Y * 320 + X] := Color;
  If M Then ToggleMouseVisibility;
End; { PutPixel }


{$F+}
Procedure _Line(X1,Y1,X2,Y2,Color: Word); External;
{$F-}

{$L 320LINE.OBJ}


Procedure Line(X1,Y1,X2,Y2,Color: Word);
Var M: Boolean;
Begin
  M := MouseVisible;
  If M Then ToggleMouseVisibility;
  _Line(X1,Y1,X2,Y2,Color);
  If M Then ToggleMouseVisibility;
End; { Line }


Procedure PutChar(X,Y: Word; C: Char; Color: Word);
Var
  I,J : Byte;
  A   : Word;
  M   : Boolean;

Begin
  M := MouseVisible;
  If M Then ToggleMouseVisibility;
  For I := 0 To 7 Do
  Begin
    For J := 0 To 7 Do
    Begin
      A := (Y + I) * 320 + X + J;
      If Mem[Seg(FontPtr^):Ofs(FontPtr^) + Ord(C) * 8 + I] And (1 Shl (7 - J)) <> 0
       Then Mem[$A000:A] := Lo(Color)
       Else Mem[$A000:A] := Hi(Color);
    End;
  End; { For I }
  If M Then ToggleMouseVisibility;
End; { PutChar }


Procedure WriteOut(X,Y: Word; St: String; Color: Word);
Var I: Byte;
Begin
  If St = '' Then Exit;
  For I := 0 To Length(St) - 1 Do PutChar(X + (I * 8),Y,St[I + 1],Color);
End; { WriteOut }


Procedure Box(X1,Y1,X2,Y2: Word; Color: Byte);
Begin
  Line(X1,Y1,X2,Y1,Color);
  Line(X1,Y2,X2,Y2,Color);
  Line(X1,Y1,X1,Y2,Color);
  Line(X2,Y1,X1,Y2,Color);
End; { Box }


Procedure FBox(X1,Y1,X2,Y2: Word; Color: Byte);
Var I: Word;
Begin
  For I := Y1 To Y2 Do Line(X1,I,X2,I,Color);
End; { FBox }


Procedure Swap(Var A,B: Word);
Var C: Word;
Begin
  C := A;
  A := B;
  B := C;
End; { Swap }


Procedure Go_Mode(ModeNum : Byte);
Var Regs: Registers;
Begin
  Regs.AH := 0;
  Regs.AL := ModeNum;
  Intr($10,Regs);
End; { Go_Mode }


Function __MakeWin(Var W: _WindowPtr; X1,Y1,X2,Y2: Word; Fill: Byte): Boolean;
Begin
  If W = Nil Then New(W);
  If X2 < X1 Then Swap(X1,X2);
  If Y2 < Y2 Then Swap(Y1,Y2);
  W^._X1        := X1;
  W^._Y1        := Y1;
  W^._X2        := X2;
  W^._Y2        := Y2;
  W^._Size      := (Y2 - Y1 + 1) * (X2 - X1 + 1);
  W^._Back      := Nil;
  W^._Active    := False;
  W^._FillColor := Fill;
  __MakeWin := True;
End; { __MakeWin }


Function __DispWin(Var W: _WindowPtr): Boolean;
Var
  I,J : Word;
  M   : Boolean;

Begin
  If W = Nil Then                           { __MakeWin has not been called }
  Begin
    __DispWin := False;
    Exit;
  End;
  If MaxAvail < W^._Size Then                  { Not enough heap space free }
  Begin
    __DispWin := False;
    Exit;
  End;
  GetMem(W^._Back,W^._Size);
  I := Seg(W^._Back^);
  J := Ofs(W^._Back^);
  If J > $F Then
  Begin
    Inc(I,J Shr 4);
    J := J And $F;
  End;
  W^._Back   := Ptr(I,J);
  W^._Active := True;
  J := W^._X2 - W^._X1 + 1;
  M := MouseVisible;
  If M Then ToggleMouseVisibility;
  For I := 0 To W^._Y2 - W^._Y1 Do
  Begin
    Move(Mem[$A000:(I + W^._Y1) * 320 + W^._X1],
         Mem[Seg(W^._Back^):Ofs(W^._Back^) + I * J],J);
    FillChar(Mem[$A000:(I + W^._Y1) * 320 + W^._X1],
             J,W^._FillColor);
  End; { For I }
  If M Then ToggleMouseVisibility;
  If _WindowList = Nil Then
  Begin
    New(_WindowList);
    _WindowList^._Prev   := Nil;
    _WindowList^._Next   := Nil;
    _WindowList^._Window := Addr(W^);
  End
  Else
  Begin
    _ListWork := _WindowList;
    While _ListWork^._Next <> Nil Do _ListWork := _ListWork^._Next;
    New(_ListWork^._Next);
    _ListWork^._Next^._Prev := _ListWork;
    _ListWork               := _ListWork^._Next;
    _ListWork^._Next        := Nil;
    _ListWork^._Window      := Addr(W^);
  End;
  __DispWin := True;
End; { __DispWin }


Function __RemWin: Boolean;
Var
  I,J : Word;
  W   : _WindowPtr;
  M   : Boolean;

Begin
  If _WindowList = Nil Then
  Begin
    __RemWin := False;
    Exit;
  End;
  _ListWork := _WindowList;
  While _ListWork^._Next <> Nil Do _ListWork := _ListWork^._Next;
  W^ := _ListWork^._Window^;
  W^._Active := False;
  J := W^._X2 - W^._X1 + 1;
  M := MouseVisible;
  If M Then ToggleMouseVisibility;
  For I := 0 To W^._Y2 - W^._Y1 Do
  Begin
    Move(Mem[Seg(W^._Back^):Ofs(W^._Back^) + I * J],
         Mem[$A000:(I + W^._Y1) * 320 + W^._X1],J);
  End; { For I }
  If M Then ToggleMouseVisibility;
  FreeMem(W^._Back,W^._Size);
  If _ListWork <> _WindowList Then
  Begin
    _ListWork := _ListWork^._Prev;
    Dispose(_ListWork^._Next);
    _ListWork^._Next := Nil;
  End
  Else
  Begin
    Dispose(_ListWork);
    _WindowList := Nil;
  End;
  __RemWin := True;
End; { __RemWin }


Begin
  FontPtr := Ptr($F000,$FA6E);
End.