ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/TOTSRC.ZIP/TOTFAST.PAS

Pascal/Delphi Source File | 1991-02-10 | 56.1 KB | 2,116 lines

{               Copyright 1991 TechnoJock Software, Inc.               }
{                          All Rights Reserved                         }
{                         Restricted by License                        }

{                             Build # 1.00                             }

Unit totFAST;
{$I TOTFLAGS.INC}

{
 Development Notes:
 6) Add save of display attr (TextColor and TextBackground)
 7) Add save of display mode
}

INTERFACE

uses DOS, CRT, totSYS, totLOOK, totINPUT;

TYPE

StrScreen = string[255];   {alter as necessary}
StrVisible = string[80];   {alter as necessary}
tDirection = (Up, Down, Left, Right, Vert, Horiz);
tCoords = record
   X1,Y1,X2,Y2:shortint;
end;
tByteCoords = record
   X1,Y1,X2,Y2:byte;
end;
ShadowPosition = (UpLeft,UpRight,DownLeft,DownRight);

WritePtr = ^WriteOBJ;
pWriteOBJ = ^WriteOBJ;
WriteOBJ = object
   vWidth: byte;           {how wide is screen}
   vScreenPtr: pointer;    {memory location of screen data}
   vWindow: tByteCoords;   {active screen area}
   vWindowOn: boolean;     {is window area active}
   vWindowIgnore: boolean; {ignore window settings}
   {methods...}
   constructor Init;
   procedure   SetScreen(var P:Pointer; W:byte);
   function    WindowOff: boolean;
   procedure   SetWinIgnore(On:Boolean);
   procedure   WindowOn;
   procedure   WindowCoords(var Coords: tByteCoords);
   function    WindowActive: boolean;
   function    WinX: byte;
   function    WinY: byte;
   procedure   GetWinCoords(var X1,Y1,X2,Y2:byte);
   procedure   WriteAT(X,Y,attr:byte;Str:string);                     VIRTUAL;
   procedure   WritePlain(X,Y:byte;Str:string);                       VIRTUAL;
   procedure   Write(Str:string);                                     VIRTUAL;
   procedure   WriteLn(Str:string);                                   VIRTUAL;
   procedure   GotoXY(X,Y: word);                                     VIRTUAL;
   function    WhereX: word;                                          VIRTUAL;
   function    WhereY: word;                                          VIRTUAL;
   procedure   SetWindow(X1,Y1,X2,Y2: byte);                          VIRTUAL;
   procedure   ResetWindow;                                           VIRTUAL;
   procedure   ChangeAttr(X,Y,Att:byte;Len:word);                     VIRTUAL;
   procedure   MoveFromScreen(var Source,Dest;Len:Word);              VIRTUAL;
   procedure   MoveToScreen(var Source,Dest; Len:Word);               VIRTUAL;
   procedure   Clear(Att:byte;Ch:char);                               VIRTUAL;
   destructor  Done;                                                  VIRTUAL;
end; {WriteOBJ}

ScreenPtr = ^ScreenOBJ;
pScreenOBJ = ^ScreenOBJ;
ScreenOBJ = object
   vWidth: byte;           {how wide is screen}
   vDepth: byte;           {how many lines}
   vScreenPtr: pointer;    {memory location of screen data}
   vCursX: byte;           {cursor location}
   vCursY: byte;           {      -"-      }
   vCursTop: byte;         {cursor size}
   vCursBot: byte;         {    -"-    }
   oWritePtr: WritePtr;    {screen writing and moving object}
   vHiMarker: char;        {character to indicate attribute change}
   vVisible: boolean;      {is the screen mapped to visible display}
   vOnScreen:boolean;
   {methods...}
   constructor Init;
   procedure   DesqViewTest;
   procedure   SetHiMarker(M:char);
   function    HiMarker:char;
   procedure   AssignWriteOBJ(var Wri: WriteOBJ);
   procedure   SetWindow(X1,Y1,X2,Y2: byte);
   procedure   SetWinIgnore(On:Boolean);
   procedure   ResetWindow;
   function    WindowOff:boolean;
   procedure   WindowOn;
   procedure   WindowCoords(var Coords: tByteCoords);
   function    WindowActive: boolean;
   function    OnScreen:boolean;
   function    CharHeight: integer;
   procedure   CursReset;
   procedure   CursSave;
   procedure   GotoXY(X,Y: word);
   procedure   CursSize(T,B: byte);
   function    WhereX: word;
   function    WhereY: word;
   function    CursTop: byte;
   function    CursBot: byte;
   procedure   CursHalf;
   procedure   CursFull;
   procedure   CursOn;
   procedure   CursOff;
   procedure   Exists;
   procedure   MoveToScreen(var Source, Dest; Length:word);
   procedure   MoveFromScreen(var Source, Dest; Length:word);
   procedure   Save;
   procedure   Create(X,Y,Attr:byte);
   function    Width: byte;
   function    Depth: byte;
   function    ScreenPtr: pointer;
   procedure   Display;
   procedure   PartDisplay(X1,Y1,X2,Y2,X,Y:byte);
   procedure   PartSlideDisplay(X1,Y1,X2,Y2:byte;Way:tDirection);
   procedure   SlideDisplay(Way: tDirection);
   procedure   PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
   procedure   PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
   procedure   CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
   procedure   MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
   procedure   Scroll(Way:tDirection;X1,Y1,X2,Y2:byte);
   procedure   Write(Str:string);
   procedure   WriteLn(Str:string);
   procedure   WriteAT(X,Y,attr:byte;Str:string);
   procedure   WriteHi(X,Y,AttrHi,Attr:byte;Str:string);
   procedure   WritePlain(X,Y:byte;Str:string);
   procedure   WriteCap(X,Y,AttrCap,Attr:byte;Str:string);
   procedure   WriteClick(X,Y,attr:byte;Str:string);
   procedure   WriteCenter(Y,Attr:byte;Str:string);
   procedure   WriteBetween(X1,X2,Y,Attr:byte;Str:string);
   procedure   WriteRight(X,Y,Attr:byte;Str:string);
   procedure   WriteVert(X,Y,Attr:byte;Str:string);
   procedure   Attrib(X1,Y1,X2,Y2,Attr:byte);
   procedure   Clear(Att:byte;Ch:char);
   procedure   PartClear(X1,Y1,X2,Y2,Att:byte;Ch:char);
   procedure   ClearText(X1,Y1,X2,Y2:byte);
   procedure   ReadWord(X,Y:byte;var Attr:byte; var Ch : char);
   function    ReadChar(X,Y:byte):char;
   function    ReadAttr(X,Y:byte):byte;
   function    ReadStr(X1,X2,Y:byte):string;
   procedure   BoxEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr,Mattr,style:byte;
                         Filled:boolean;
                         Title:string);
   procedure   TitleEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr:byte;Str,Title:string);
   procedure   Box(X1,Y1,X2,Y2,attr,style:byte);
   procedure   FillBox(X1,Y1,X2,Y2,attr,style:byte);
   procedure   ShadFillBox(X1,Y1,X2,Y2,attr,style:byte);
   procedure   TitledBox(X1,Y1,X2,Y2,Battr,Tattr,Mattr,style:byte;Title:string);
   procedure   HorizLine(X1,X2,Y,Attr,Style : byte);
   procedure   VertLine(X,Y1,Y2,Attr,Style:byte);
   procedure   SmartVertLine(X,Y1,Y2,Attr,Style:byte);
   procedure   SmartHorizLine(X1,X2,Y,Attr,Style:byte);
   procedure   WriteHScrollBar(X1,X2,Y,Attr: byte; Current,Max: longint);
   procedure   WriteVScrollBar(X,Y1,Y2,Attr: byte; Current,Max: longint);
   destructor  Done;
end; {ScreenOBJ}

pScrollOBJ = ^ScrollOBJ;
ScrollOBJ = object
   vUpArrowChar: char;
   vDownArrowChar: char;
   vLeftArrowChar: char;
   vRightArrowChar: char;
   vElevatorChar: char;
   vBackgroundChar: char;
   {methods...}
   constructor Init;
   procedure   SetDefaults;
   procedure   SetScrollChars(U,D,L,R,E,B:char);
   function    UpChar: char;
   function    DownChar: char;
   function    LeftChar: char;
   function    RightChar: char;
   function    ElevatorChar: char;
   function    BackgroundChar: char;
   destructor  Done;
end; {ScrollOBJ}

pShadowOBJ = ^ShadowOBJ;
ShadowOBJ = object
   vShadPos: ShadowPosition;   {where is shadow}
   vShadAttr: byte;            {shadow attribute}
   vShadChar: char;            {shadow character - ' ' is see-through}
   vShadWidth: byte;           {shadow width in characters}
   vShadDepth: byte;           {shadow depth in characters}
   {methods...}
   constructor Init;
   procedure   SetDefaults;
   procedure   SetShadowStyle(ShadP:ShadowPosition; ShadA:byte; ShadC: char);
   procedure   SetShadowSize(ShadW,ShadD:byte);
   function    ShadWidth: byte;
   function    ShadDepth: byte;
   function    ShadAttr: byte;
   function    ShadChar: char;
   function    ShadPos: ShadowPosition;
   procedure   DrawShadow(Border:tCoords);
   procedure   DrawShadowXY(X1,Y1,X2,Y2:integer);
   procedure   OuterCoords(Border:tCoords;var Outer:tCoords);
   procedure   OuterXY(var X1,Y1,X2,Y2: integer);
   destructor  Done;
end; {ShadowOBJ}

VAR
  Screen: ScreenOBJ;
  ScrollTOT: ^ScrollOBJ;
  ShadowTOT: ^ShadowOBJ;
  SnowProne : byte;

function  CAttr(F,B:byte):byte;
function  FAttr(A:byte): byte;
function  BAttr(A:byte): byte;
function  Replicate(N : byte; Character:char): string;
procedure fastINIT;

IMPLEMENTATION
Const
    TitPos:string[6] = '<+>^|_';  {characters signifying box title position}
    WinCursX: byte = 1;
    WinCursY: byte = 1;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                               }
{     U N I T   P R O C E D U R E S   &   F U N C T I O N S     }
{                                                               }
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}

procedure Error(Err:byte);
{temp routine to display error - replace with object}
const
   Header = 'totFAST error: ';
var
   Msg : string;
begin
   Case Err of
   1: Msg := 'Not enough memory to initialize screen';
   2: Msg := 'Cannot write to inactive screen';
   3: Msg := 'Not enough memory for screen move/copy';
   else  Msg := 'Unknown Error';
   end; {case}
   Writeln(Header,Msg);
   halt;
end; {Error}

function CAttr(F,B:byte):byte;
{converts foreground(F) and background(B) colors to combined Attribute byte}
begin
   CAttr := (B Shl 4) or F;
end;  {CAttr}

function FAttr(A:byte): byte;
{returns the foreground color from an attribute Byte}
begin
   FAttr := A and 15;
end; {FAttr}

function BAttr(A:byte): byte;
{returns the background color from an attribute Byte}
begin
   BAttr := (A and 112) shr 4;
end; {FAttr}

function Replicate(N : byte; Character:char): string;
{returns a string with Character repeated N times}
var tempstr: string;
begin
    If N = 0 then
       TempStr := ''
    else
    begin
       Fillchar(tempstr,N+1,Character);
       Tempstr[0] := chr(N);
    end;
    Replicate := Tempstr;
end; {replicate}

{$L totFAST}
{$F+}
  procedure AsmWrite(var scrptr; Wid,Col,Row,Attr:byte; St:String); external;
  procedure AsmPWrite(var scrptr; Wid,Col,Row:byte; St:String); external;
  procedure AsmAttr(var scrptr; Wid,Col,Row,Attr,Len:byte); external;
  Procedure AsmMoveFromScreen(var Source,Dest;Length:Word); external;
  Procedure AsmMoveToScreen(var Source,Dest; Length:Word); external;
{$IFNDEF OVERLAY}
   {$F-}
{$ENDIF}

{|||||||||||||||||||||||||||||||||||||||||}
{                                         }
{     W r i t e O B J   M E T H O D S     }
{                                         }
{|||||||||||||||||||||||||||||||||||||||||}
constructor WriteOBJ.Init;
{}
begin
   vWindowOn := false;
   vWindowIgnore := false;
end; {WriteOBJ.Init}

procedure WriteOBJ.SetScreen(var P:Pointer; W:byte);
{}
begin
   vScreenPtr := P;
   vWidth := W;
end; {WriteOBJ.SetScreen}

procedure WriteOBJ.SetWindow(X1,Y1,X2,Y2: byte);
{}
begin
   CRT.Window(X1,Y1,X2,Y2);
   vWindow.X1 :=  X1;
   vWindow.Y1 :=  Y1;
   vWindow.X2 :=  X2;
   vWindow.Y2 :=  Y2;
   vWindowOn := true;
end; {WriteOBJ.SetWindow}

procedure WriteOBJ.GetWinCoords(var X1,Y1,X2,Y2:byte);
{}
begin
   X1 :=  vWindow.X1;
   Y1 :=  vWindow.Y1;
   X2 :=  vWindow.X2;
   Y2 :=  vWindow.Y2;
end; {WriteOBJ.GetWinCoords}

procedure WriteOBJ.ResetWindow;
{}
var H,W: byte;
begin
   W := Monitor^.Width;
   H := Monitor^.Depth;
   CRT.Window(1,1,W,H);
   vWindow.X1 := 1;
   vWindow.Y1 := 1;
   vWindow.X2 := W;
   vWindow.Y2 := H;
   vWindowOn := false;
end; {WriteOBJ.ResetWindow}

function WriteOBJ.WindowOff:boolean;
{}
begin
   if vWindowOn then
   begin
      vWindowOn := false;
      WinCursX := WhereX;
      WinCursY := WhereY;
      CRT.window(1,1,Monitor^.Width,Monitor^.Depth);
      WindowOff := true;
   end
   else
      WindowOff := false;
end; {WriteOBJ.WindowOff}

procedure WriteOBJ.WindowOn;
{}
begin
   vWindowOn := true;
   window(vWindow.X1,vWindow.Y1,vWindow.X2,vWindow.Y2);
   GotoXY(WinCursX,WinCursY);
end; {WriteOBJ.WindowOn}

procedure WriteOBJ.WindowCoords(var Coords: tByteCoords);
{}
begin
   Coords := vWindow;
end; {WriteOBJ.WindowCoords}

function WriteOBJ.WindowActive: boolean;
{}
begin
   WindowActive := vWindowOn;
end; {WriteOBJ.WindowActive}

procedure WriteOBJ.SetWinIgnore(On:Boolean);
{}
begin
   vWindowIgnore := On;
end; {WriteOBJ.SetWinIgnore}

function WriteOBJ.WinX: byte;
{}
begin
   if vWindowOn and not vWindowIgnore then
      WinX := vWindow.X1
   else
      WinX := 1;
end; {WriteOBJ.WinX}

function WriteOBJ.WinY: byte;
{}
begin
   if vWindowOn and not vWindowIgnore then
      WinY := vWindow.Y1
   else
      WinY := 1;
end; {WriteOBJ.WinY}

procedure WriteOBJ.WriteAT(X,Y,attr:byte;Str:string);
{}
begin
   if not vWindowOn or vWindowIgnore then
      ASMWrite(vScreenPtr^,vWidth,X,Y,attr,Str)
   else
   begin
      Str := copy(Str,1,vWindow.X2 - pred(X) - pred(vWindow.X1));
      if Y + pred(vWindow.Y1) <= vWindow.Y2 then
         ASMWrite(vScreenPtr^,vWidth,pred(vWindow.X1)+X,
                                        pred(vWindow.Y1)+Y,
                                        attr,Str);
   end;
end; {WriteOBJ.WriteAT}

procedure WriteOBJ.WritePlain(X,Y:byte;Str:string);
{}
begin
   if not vWindowOn or vWindowIgnore then
      ASMPWrite(vScreenPtr^,vWidth,X,Y,Str)
   else
   begin
      Str := copy(Str,1,vWindow.X2 - pred(X) - pred(vWindow.X1));
      if Y + pred(vWindow.Y1) <= vWindow.Y2 then
         ASMPWrite(vScreenPtr^,vWidth,pred(vWindow.X1)+X,
                                        pred(vWindow.Y1)+Y,
                                        Str);
   end;
end; {WriteOBJ.WritePlain}

procedure WriteOBJ.Write(Str:string);
{}
begin
   System.Write(Str)
end; {WriteOBJ.Write}

procedure WriteOBJ.WriteLn(Str:string);
{}
begin
   System.WriteLn(Str);
end; {WriteOBJ.WriteLn}

procedure WriteOBJ.GotoXY(X,Y: word);
{}
begin
   CRT.GotoXY(X,Y);
end; {WriteOBJ.GotoXY}

function  WriteOBJ.WhereX: word;
{}
begin
   WhereX := CRT.WhereX;
end; {WriteOBJ.WhereX}

function  WriteOBJ.WhereY: word;
{}
begin
   WhereY := CRT.WhereY;
end; {WriteOBJ.WhereY}

procedure WriteOBJ.ChangeAttr(X,Y,Att:byte;Len:word);
{}
begin
   if not vWindowOn or vWindowIgnore then
      ASMAttr(vScreenPtr^,vWidth,X,Y,Att,Len)
   else
   begin
      inc(X,pred(vWindow.X1));
      inc(Y,pred(vWindow.Y1));
      if (X <= vWindow.X2) and (Y <= vWindow.Y2) then
      begin
         if X + Len > vWindow.X2 then
            Len := vWindow.X2 - pred(X);
         ASMAttr(vScreenPtr^,vWidth,X,Y,Att,Len)
      end;
   end;
end; {WriteOBJ.ChangeAttr}

procedure WriteOBJ.MoveFromScreen(var Source,Dest;Len:Word);
{}
begin
   ASMMoveFromScreen(Source,Dest,Len);
end; {WriteOBJ.MoveFromScreen}

procedure WriteOBJ.MoveToScreen(var Source,Dest; Len:Word);
{}
begin
   ASMMoveToScreen(Source,Dest,Len);
end; {WriteOBJ.MoveToScreen}

procedure WriteOBJ.Clear(Att:byte;Ch:char);
{}
var
   I : integer;
   S : string;
begin
   with vWindow do
   begin
       S := Replicate(Succ(X2-X1),Ch);
       for I := 1 to succ(Y2-Y1) do
       begin
          ChangeAttr(X1,Y1,Att,succ(X2-X1));
          WritePlain(1,I,S);
       end;
   end;
end; {WriteOBJ.Clear}

destructor WriteOBJ.Done;
{}
begin
end; {WriteOBJ.Done}
{|||||||||||||||||||||||||||||||||||||||||||}
{                                           }
{     S c r e e n O B J   M E T H O D S     }
{                                           }
{|||||||||||||||||||||||||||||||||||||||||||}
constructor ScreenOBJ.Init;
{}
begin
   vScreenPtr := nil;
   vHiMarker := '~';
   vVisible := false;
   vOnScreen := false;
   New(oWritePtr,Init);
   oWritePtr^.SetScreen(vScreenPtr,vWidth);
   ResetWindow;
end; {ScreenOBJ.Init}

procedure ScreenOBJ.SetHiMarker(M:char);
{}
begin
   vHiMarker := M;
end; {ScreenOBJ.SetHiMarker}

function ScreenOBJ.HiMarker:char;
{}
begin
   Himarker := vHiMarker;
end; {ScreenOBJ.Himarker}

procedure ScreenOBJ.AssignWriteOBJ(var Wri: WriteOBJ);
{}
begin
   Dispose(oWritePtr,Done);
   oWritePtr := @Wri;
   oWritePtr^.SetScreen(vScreenPtr,vWidth);
end; {ScreenOBJ.AssignWriteOBJ}

procedure ScreenOBJ.SetWindow(X1,Y1,X2,Y2: byte);
{}
begin
   oWritePtr^.SetWindow(X1,Y1,X2,Y2);
end; {ScreenOBJ.SetWindow}

procedure ScreenOBJ.SetWinIgnore(On:Boolean);
{}
begin
   oWritePtr^.SetWinIgnore(On);
end; {ScreenOBJ.SetWinIgnore}

procedure ScreenOBJ.ResetWindow;
{}
begin
   oWritePtr^.ResetWindow;
end; {ScreenOBJ.ResetWindow}

function ScreenOBJ.WindowOff:boolean;
{}
begin
   WindowOff := oWritePtr^.WindowOff;
end; {ScreenOBJ.WindowOff}

procedure ScreenOBJ.WindowOn;
{}
begin
   oWritePtr^.WindowOn;
end; {ScreenOBJ.WindowOn}

procedure ScreenOBJ.WindowCoords(var Coords: tByteCoords);
{}
begin
   oWritePtr^.WindowCoords(Coords);
end; {ScreenOBJ.WindowCoords}

function ScreenOBJ.WindowActive: boolean;
{}
begin
   WindowActive := oWritePtr^.WindowActive;
end; {ScreenOBJ.WindowActive}
{|||||||||||||||||||||||||||||||||}
{     C U R S O R   S T U F F     }
{|||||||||||||||||||||||||||||||||}
function ScreenOBJ.OnScreen: boolean;
{is this instance the visible screen}
begin
   OnScreen := vOnScreen;
end; {ScreenOBJ.OnScreen}

function ScreenOBJ.CharHeight: integer;
{get height of text mode characters for cursor manipulation}
var
   Regs: Registers;
begin
   if OnScreen then
   begin
      case Monitor^.DisplayType of
      Mono: CharHeight := 14;
      EGACol,
      CGA : CharHeight := 8;
      else
         with Regs do
         begin
            Ah := $11;
            Al := $30;
            BX := $0;
            Intr($10,Regs);
            CharHeight := CX;
         end; {with}
      end;  {case}
   end
   else        {virtual screen assume normal mode}
   begin
      if Monitor^.DisplayType = Mono then
         CharHeight := 14
      else
         CharHeight := 8;
   end;
end; {ScreenOBJ.CharHeight}

procedure ScreenOBJ.CursReset;
{}
begin
   GotoXY(1,1);
   CursOn;
end; {ScreenOBJ.CursReset}

procedure ScreenOBJ.CursSave;
{updates instance with visible Cursor details}
var Reg : registers;
begin
   with Reg do
   begin
      Ax := $0F00; {get page in Bx}
      intr($10,reg);
      Ax := $0300;
      intr($10,reg);
      vCursX := lo(Dx) + 1;
      vCursY := hi(Dx) + 1;
      vCursTop := Hi(Cx) and $0F;
      vCursBot := Lo(Cx) and $0F;
   end;
end; {ScreenOBJ.CursSave}

procedure ScreenOBJ.CursSize(T,B : byte);
{}
var Reg: registers;
begin
   if OnScreen then {writing to a visible screen}
   begin
      with reg do
      begin
         AX := $0100;
         if (T=0) and (B=0) then
            CX := $2000
         else
         begin
         (*
         If you have an odd video bios and cursor changes
         are strange, enable this next line.
            mem[$40:$87] := mem[$40:$87] or $01; {get cursor ownership from BIOS}
         *)
            Ch := T;
            Cl := B;
         end;
         intr($10,Reg);
      end;
   end;
   vCursTop := T;
   vCursBot := B;
end; {ScreenOBJ.CursSize}

function ScreenOBJ.WhereX: word;
{}
begin
   if OnScreen then {writing to a visible screen}
      WhereX := oWritePtr^.WhereX
   else
      WhereX := vCursX;
end; {ScreenOBJ.WhereX}

function ScreenOBJ.WhereY: word;
{}
begin
   if OnScreen then {writing to a visible screen}
      WhereY := oWritePtr^.WhereY
   else
      WhereY := vCursY;
end; {ScreenOBJ.WhereY}

procedure ScreenOBJ.GotoXY(X,Y:word);
{}
begin
   if OnScreen then {writing to a visible screen}
      oWritePtr^.GotoXY(X,Y)
   else
   begin
      vCursX := X;
      vCursY := Y;
   end;
end; {ScreenOBJ.CursGotoXY}

function ScreenOBJ.CursTop: byte;
{}
begin
   CursTop := vCursTop;
end; {ScreenOBJ.CursTOP}

function ScreenOBJ.CursBot: byte;
{}
begin
   CursBot := vCursBot;
end; {ScreenOBJ.CursBot}

procedure ScreenOBJ.CursHalf;
{}
var Charsize: byte;
begin
   CharSize := CharHeight;
   CursSize(CharSize div 2, pred(CharSize));
end; {ScreenOBJ.CursHalf}

procedure ScreenOBJ.CursFull;
{}
var Charsize: byte;
begin
   CharSize := CharHeight;
   CursSize(0,CharSize);
end; {ScreenOBJ.CursFull}

procedure ScreenOBJ.CursOn;
{}
var Charsize: byte;
begin
   CharSize := CharHeight;
   CursSize(CharSize-3, CharSize-2);
end; {ScreenOBJ.CursOn}

procedure ScreenOBJ.CursOff;
{}
begin
   CursSize(0,0);
end; {ScreenOBJ.CursOff}
{||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{     S C R E E N    S A V E    &    R E S T O R E     }
{||||||||||||||||||||||||||||||||||||||||||||||||||||||}
procedure ScreenOBJ.Exists;
{makes sure there is a screen on the heap}
begin
   if ScreenPtr = nil then
      Error(2);
end; {ScreenOBJ.Exists}

procedure ScreenOBJ.DesqViewTest;
{}
var Regs: Registers;
begin
   with Regs do
   begin
      AX := $2B01;
      CX := $4445;
      DX := $5351;
      intr($21,Regs);
      if Al <> $FF then {DesqView present}
      begin
         Ah := $FE;
         Intr($10,Regs);
         vScreenPtr := ptr(ES,DI);
      end;
   end;
end; {ScreenOBJ.DesqViewTest}

procedure ScreenOBJ.Create(X,Y,Attr:byte);
{}
var MemoryNeeded: longint;
begin
   MemoryNeeded := X*Y*2;
   If MaxAvail < MemoryNeeded then
      Error(1)
   else
   begin
      If (X = 0) and (Y = 0) then    {map to physical screen}
      begin
         vWidth := Monitor^.Width;
         (*
         vDepth := 50;              {set to max for extended line displays}
         *)
         vDepth := Monitor^.Depth;
         vVisible := true;
         vScreenPtr :=  ptr(Monitor^.vBaseOfScreen,0);
         oWritePtr^.SetScreen(vScreenPtr,vWidth);
         vOnScreen := true;
         DesqViewTest;
         CursSave;
         ResetWindow;
      end
      else
      begin
         vWidth := X;
         vDepth := Y;
         GetMem(vScreenPtr,MemoryNeeded);
         oWritePtr^.SetScreen(vScreenPtr,vWidth);
         SetWindow(1,1,X,Y);
         Clear(Attr,' ');
         CursReset;
      end;
   end;
end; {ScreenOBJ.Create}

procedure ScreenOBJ.MoveFromScreen(var Source, Dest; Length:word);
{}
begin
   oWritePtr^.MoveFromScreen(Source,Dest,Length);
end; {ScreenOBJ.MoveFromScreen}

procedure ScreenOBJ.MoveToScreen(var Source, Dest; Length:word);
{}
begin
   oWritePtr^.MoveToScreen(Source,Dest,Length);
end; {ScreenOBJ.MoveToScreen}

procedure ScreenOBJ.Save;
{saves current screen to instance}
var
  MemoryNeeded: longint;
  MVisible: boolean;
  WinCoords: tByteCoords;
begin
   If ScreenPtr <> nil then
      Freemem(vScreenPtr,Width*Depth*2);
   MemoryNeeded := Monitor^.Width*Monitor^.Depth*2;
   If MaxAvail < MemoryNeeded then
      Error(1)
   else
   begin
      vWidth := Monitor^.Width;
      vDepth := Monitor^.Depth;
      GetMem(vScreenPtr,MemoryNeeded);
      MVisible := Mouse.Visible;
      if MVisible then
         Mouse.Hide;
      MoveFromScreen(Monitor^.BaseOfScreen^,ScreenPtr^,vWidth*vDepth);
      CursSave;
      oWritePtr^.SetScreen(vScreenPtr,vWidth);
      Screen.WindowCoords(WinCoords);
      with WinCoords do
         SetWindow(X1,Y1,X2,Y2);
      if MVisible then
         Mouse.Show;
   end;
end; {ScreenOBJ.Save}

function ScreenOBJ.Width: byte;
{}
begin
   Width := vWidth;
end; {ScreenOBJ.Width}

function ScreenOBJ.Depth: byte;
{}
begin
   if vVisible then
   begin
      Depth := Monitor^.Depth
   end
   else
      Depth := vDepth;
end; {ScreenOBJ.Depth}

function ScreenOBJ.ScreenPtr: pointer;
{}
begin
   ScreenPtr := vScreenPtr;
end; {ScreenOBJ.ScrPtr}

procedure ScreenOBJ.Display;
{}
var
  Wid,Dep:byte;
  MVisible:boolean;
  WinCoords: tByteCoords;
begin
{$IFNDEF FINAL}
   Exists;
{$ENDIF}
   MVisible := Mouse.Visible;
   if MVisible then
      Mouse.Hide;
   if Width = Monitor^.Width then  {one big move}
      MoveToScreen(ScreenPtr^,Monitor^.BaseOfScreen^, width*Monitor^.Depth)
   else
   begin
      Wid := Monitor^.Width;
      if Wid > vWidth then
         Wid := vWidth;
      Dep := Monitor^.Depth;
      if Dep > vDepth then
         Dep := vDepth;
      PartDisplay(1,1,Wid,Dep,1,1);
   end;
   {now restore cursor details}
   Screen.GotoXY(WhereX,WhereY);
   Screen.CursSize(CursTop,CursBot);
   WindowCoords(WinCoords);
   with WinCoords do
      Screen.SetWindow(X1,Y1,X2,Y2);
   if MVisible then           (* Change to restore Mouse Details *)
      Mouse.Show;
end; {ScreenOBJ.Display}

procedure ScreenOBJ.PartDisplay(X1,Y1,X2,Y2,X,Y:byte);
{}
var
   MonitorWidth,
   ScreenWidth,
   SectionWidth   : byte;
   I              : integer;
   VisibleAdr,
   VirtualAdr     : word;
   VisiblePtr,
   VirtualPtr     : pointer;
   MVisible:boolean;
begin
   if X2 > vWidth then
      X2 := vWidth;
   if Y2 > vDepth then
      Y2 := vDepth;
   SectionWidth := succ(X2- X1);
   MonitorWidth := Monitor^.Width;
   ScreenWidth  := Width;
   VirtualPtr := ScreenPtr;
   VisiblePtr := Monitor^.BaseOfScreen;
   MVisible := Mouse.Visible;
   if MVisible then
      Mouse.Hide;
   For I :=  Y1 to Y2 do
   begin
       VisibleAdr := pred(Y+I-Y1)*MonitorWidth*2 + pred(X)*2;
       VirtualAdr := pred(I)*ScreenWidth*2 + Pred(X1)*2;
       MoveToScreen(Mem[Seg(VirtualPtr^):ofs(VirtualPtr^)+VirtualAdr],
                    Mem[Seg(VisiblePtr^):ofs(VisiblePtr^)+VisibleAdr],
                    Sectionwidth);
   end;
   if MVisible then
      Mouse.Show;
end; {ScreenOBJ.PartDisplay}

procedure ScreenOBJ.PartSlideDisplay(X1,Y1,X2,Y2:byte;Way:tDirection);
{}
var
   I : integer;
begin
   Case Way of
   Up    : begin
              for I := Y2 downto Y1 do
              begin
                  PartDisplay(X1,Y1,X2,Y1+Y2-I,X1,I);
                  Delay(50);
              end;
           end;
   Down  : begin
              for I := Y1 to Y2 do
              begin
                  PartDisplay(X1,Y1+Y2 -I,X2,Y2,X1,Y1);
                  Delay(50);  {savor the moment!}
              end;
           end;
   Left  : begin
              for I := X1 to X2 do
              begin
                  PartDisplay(X1,Y1,I,Y2,X1+X2-I,Y1);
              end;
           end;
   Right : begin
              for I := X2 downto X1 do
              begin
                  PartDisplay(I,Y1,X2,Y2,X1,Y1);
              end;
           end;
   Vert:   for I := Y1 to Y1 + (Y2 - Y1) div 2 do
           begin
              PartDisplay(X1,I,X2,I,X1,I);
              PartDisplay(X1,Y2+Y1-I,X2,Y2+Y1-I,X1,Y2+Y1-I);
              Delay(50);
           end;
   Horiz:  for I := X1 to X1 + succ(X2 -X1) div 2 do
           begin
              PartDisplay(I,Y1,I,Y2,I,Y1);
              PartDisplay((X2)+X1-I,Y1,(X2)+X1-I,Y2,(X2)+X1-I,Y1);
              Delay(10);
           end;
   end; {case}
end; {ScreenOBJ.PartSlideDisplay}

procedure ScreenOBJ.SlideDisplay(Way: tDirection);
{}
var
  WinCoords: tByteCoords;
  X,Y,Top,Bot : byte;
begin
   X := Monitor^.Width;
   if X > vWidth then
      X := vWidth;
   Y := Monitor^.Depth;
   if Y > vDepth then
      Y := vDepth;
   PartSlideDisplay(1,1,X,Y,Way);
   {now restore cursor details}
   X := WhereX;
   Y := WhereY;
   Top := CursTop;
   Bot := CursBot;
   Screen.GotoXY(X,Y);
   Screen.CursSize(Top,Bot);
   WindowCoords(WinCoords);
   with WinCoords do
      Screen.SetWindow(X1,Y1,X2,Y2);
end; {ScreenOBJ.SlideDisplay}

procedure ScreenOBJ.PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
{transfers data from active virtual screen to Dest}
var
   I,wid : byte;
   ScreenAdr: integer;
   MVisible: boolean;
begin
   wid := succ(X2- X1);
   MVisible := Mouse.Visible;
   if MVisible then
      Mouse.Hide;
   For I :=  Y1 to Y2 do
   begin
      ScreenAdr := Pred(I)*160 + Pred(X1)*2;
      MoveFromScreen(Mem[seg(vScreenPtr^):ofs(vScreenPtr^)+ScreenAdr],
                     Mem[seg(Dest):ofs(dest)+(I-Y1)*wid*2],
                     wid);
   end;
   if MVisible then
      Mouse.Show;
end; {ScreenOBJ.PartSave}

procedure ScreenOBJ.PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
{restores data from Source and transfers to active virtual screen
 - used internally}
var
   I,wid : byte;
   ScreenAdr: integer;
   MVisible: boolean;
begin
   wid := succ(X2- X1);
   MVisible := Mouse.Visible;
   if MVisible then
      Mouse.Hide;
   For I :=  Y1 to Y2 do
   begin
    ScreenAdr := Pred(I)*160 + Pred(X1)*2;
    MoveToScreen(Mem[Seg(Source):ofs(Source)+(I-Y1)*wid*2],
                 Mem[seg(vScreenPtr^):ofs(vScreenPtr^)+ScreenAdr],
                 wid);
   end;
   if MVisible then
     Mouse.Show;
end; {ScreenOBJ.PartRestore}

procedure ScreenOBJ.CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
{copies text and attributes from one part of screen to another}
Var
   S : word;
   SPtr : pointer;
   MVisible: boolean;
begin
    S := succ(Y2-Y1)*succ(X2-X1)*2;
    If Maxavail < S then
       Error(3)
    else
    begin
       MVisible := Mouse.Visible;
       if MVisible then
          Mouse.Hide;
       GetMem(SPtr,S);
       PartSave(X1,Y1,X2,Y2,SPtr^);
       PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
       FreeMem(Sptr,S);
       if MVisible then
          Mouse.Show;
    end;
end; {ScreenOBJ.CopyScreenBlock}

procedure ScreenOBJ.MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
{Moves text and attributes from one part of screen to another,
 replacing with Replace_Char}
const
  Replace_Char = ' ';
Var
   S : word;
   SPtr : pointer;
   I : Integer;
   ST : string;
   MVisible: boolean;
begin
    S := succ(Y2-Y1)*succ(X2-X1)*2;
    If Maxavail < S then
       Error(3)
    else
    begin
       MVisible := Mouse.Visible;
       if MVisible then
          Mouse.Hide;
       GetMem(SPtr,S);
       PartSave(X1,Y1,X2,Y2,SPtr^);
       St := Replicate(succ(X2-X1),Replace_Char);
       For I := Y1 to Y2 do
           WritePlain(X1,I,St);
       PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
       FreeMem(Sptr,S);
       if MVisible then
          Mouse.Show;
    end;
end; {ScreenOBJ.MoveScreenBlock}

procedure ScreenOBJ.Scroll(Way:tDirection;X1,Y1,X2,Y2:byte);
{used for screen scrolling, uses Copy & Plainwrite for speed}
const
  Replace_Char = ' ';
var
  I : integer;
begin
    Case Way of
    Up   : begin
               CopyScreenBlock(X1,succ(Y1),X2,Y2,X1,Y1);
               WritePlain(X1,Y2,replicate(succ(X2-X1),Replace_Char));
           end;
    Down : begin
               CopyScreenBlock(X1,Y1,X2,pred(Y2),X1,succ(Y1));
               WritePlain(X1,Y1,replicate(succ(X2-X1),Replace_Char));
           end;
    Left : begin
               CopyScreenBlock(succ(X1),Y1,X2,Y2,X1,Y1);
               For I := Y1 to Y2 do
                   WritePlain(X2,I,Replace_Char);
           end;
    Right: begin
               CopyScreenBlock(X1,Y1,pred(X2),Y2,succ(X1),Y1);
               For I := Y1 to Y2 do
                   WritePlain(X1,I,Replace_Char);
           end;
    end; {case}
end; {ScreenOBJ.Scroll}
{||||||||||||||||||||||||||||||||||||}
{     S C R E E N    W R I T E S     }
{||||||||||||||||||||||||||||||||||||}
procedure ScreenOBJ.Write(Str:string);
{write at the cursor position using the default attributes, and
 moves cursor to end of string}
var
   X,Y:byte;
   MVisible: boolean;
begin
{$IFNDEF FINAL}
   Exists;
{$ENDIF}
   MVisible := Mouse.Visible;
   X := WhereX + pred(oWritePtr^.WinX);
   Y := WhereY + pred(oWritePtr^.WinY);
   if MVisible and Mouse.InZone(X,Y,X+length(Str),Y) then
   begin
      Mouse.Hide;
      oWritePtr^.Write(Str);
      Mouse.Show;
   end
   else
      oWritePtr^.Write(Str);
end; {ScreenOBJ.Write}

procedure ScreenOBJ.WriteLn(Str:string);
{write at the cursor position using the default attributes, and
 moves cursor to next line}
var
   X,Y:byte;
   MVisible: boolean;
begin
{$IFNDEF FINAL}
   Exists;
{$ENDIF}
   MVisible := Mouse.Visible;
   X := WhereX+ pred(oWritePtr^.WinX);
   Y := WhereY+ pred(oWritePtr^.WinY);
   if MVisible and Mouse.InZone(X,Y,X+length(Str),Y) then
   begin
      Mouse.Hide;
      oWritePtr^.WriteLn(Str);
      Mouse.Show;
   end
   else
      oWritePtr^.WriteLn(Str);
end; {ScreenOBJ.WriteLn}

procedure ScreenOBJ.WriteAT(X,Y,attr:byte;Str:string);
{}
var
   MVisible: boolean;
   GlobalX,GlobalY: byte;
begin
{$IFNDEF FINAL}
   Exists;
{$ENDIF}
   if Attr = 0 then
      WritePlain(X,Y,Str)
   else
   begin
      MVisible := Mouse.Visible;
      GlobalX := X + pred(oWritePtr^.WinX);
      GlobalY := Y + pred(oWritePtr^.WinY);
      if MVisible and Mouse.InZone(GlobalX,GlobalY,GlobalX+length(Str),GlobalY) then
      begin
         Mouse.Hide;
         oWritePtr^.WriteAT(X,Y,attr,Str);
         Mouse.Show;
      end
      else
         oWritePtr^.WriteAT(X,Y,attr,Str);
   end;
end; {ScreenOBJ.WriteAT}

procedure ScreenOBJ.WriteHi(X,Y,AttrHi,Attr:byte;Str:string);
{}
var
  P:byte;
  Hi : Boolean;

     procedure WriteBit(Str:string);
     begin
        if Hi then
           WriteAt(X,Y,AttrHi,Str)
        else
           WriteAt(X,Y,Attr,Str);
     end;

begin
   Hi := False;
   P := Pos(vHiMarker,Str);
   While P <> 0 do
   begin
       if P > 1 then
          WriteBit(copy(Str,1,pred(P)));
       Delete(Str,1,P);
       inc(X,pred(P));
       P := Pos(vHiMarker,Str);
       Hi := not Hi;
   end;
   WriteBit(Str);
end; {ScreenOBJ.WriteHi}

procedure ScreenOBJ.WritePlain(X,Y:byte;Str:string);
{}
var
   MVisible: boolean;
   GlobalX,GlobalY: byte;
begin
{$IFNDEF FINAL}
   Exists;
{$ENDIF}
   MVisible := Mouse.Visible;
   GlobalX := X + pred(oWritePtr^.WinX);
   GlobalY := Y + pred(oWritePtr^.WinY);
   if MVisible and Mouse.InZone(GlobalX,GlobalY,GlobalX+length(Str),GlobalY) then
   begin
      Mouse.Hide;
      oWritePtr^.WritePlain(X,Y,Str);
      Mouse.Show;
   end
   else
      oWritePtr^.WritePlain(X,Y,Str);
end; {ScreenOBJ.WritePlain}

procedure ScreenOBJ.WriteCap(X,Y,AttrCap,Attr:byte;Str:string);
{Writes a string with the first capital letter in a different color}
var
  CapPos : byte;
begin
   If Str <> '' then
   begin
      WriteAt(X,Y,Attr,Str);   {write whole string in default cols}
      CapPos := 1;
      While (CapPos <= length(Str))
      and   ((Str[CapPos] in [#65..#90]) = false) do
         inc(CapPos);
      If CapPos <= length(Str) then
         WriteAt(X + pred(CapPos),Y,AttrCap,Str[CapPos]);
   end;
end; {ScreenOBJ.WriteCap}

procedure ScreenOBJ.WriteClick(X,Y,attr:byte;Str:string);
{writes text to the screen with a click!}
var
  I : Integer;
  L : byte;
begin
   L := length(Str);
   If OnScreen then
      for I := L downto 1 do
      begin
         WriteAt(X,Y,Attr,copy(Str,I,succ(L-I)));
         sound(500);delay(20);nosound;delay(30);
      end
   else
      WriteAt(X,Y,attr,Str); {don't click if not visible}
end; {ScreenOBJ.WriteClick}

procedure ScreenOBJ.WriteCenter(Y,Attr:byte;Str:string);
{}
var
  X1,Y1,X2,Y2: byte;
  X : integer;
begin
   if oWritePtr^.WindowActive then
   begin
      oWritePtr^.GetWinCoords(X1,Y1,X2,Y2);
      X := (succ(X2-X1) - length(Str)) div 2;
   end
   else
      X :=  (Width - length(Str)) div 2;
   if X < 1 then
      X := 1;
   WriteAt(X,Y,attr,Str);
end; {ScreenOBJ.WriteCenter}

procedure ScreenOBJ.WriteBetween(X1,X2,Y,Attr:byte;Str:string);
{}
var X : integer;
begin
   if length(Str) >= X2 - X1 + 1 then
      WriteAt(X1,Y,attr,Str)
   else
   begin
       X := X1 + (X2 - X1 + 1 - length(Str)) div 2 ;
       WriteAt(X,Y,attr,Str);
   end;
end; {ScreenOBJ.WriteBetween}

procedure ScreenOBJ.WriteRight(X,Y,Attr:byte;Str:string);
{writes a right-justified string to the screen}
var X1 : integer;
begin
   X1 := succ(X-length(Str));
   if X1 < 1 then
      X1 := 1;
   WriteAT(X1,Y,attr,Str);
end; {ScreenOBJ.WriteRight}

procedure ScreenOBJ.WriteVert(X,Y,Attr:byte;Str:string);
{}
var
   L: byte;
   I: integer;
begin
   L := length(Str);
   If L > succ(Monitor^.Depth) - Y then
      L := succ(Monitor^.Depth) - Y;
   for I := 1 to L do
      WriteAt(X,Y-1+I,attr,Str[I]);
end; {ScreenOBJ.WriteVert}

procedure ScreenOBJ.Attrib(X1,Y1,X2,Y2,Attr:byte);
{changes color attrib at specified coords}
var
   I: integer;
   X: byte;
   MVisible: boolean;
begin
{$IFNDEF FINAL}
   Exists;
{$ENDIF}
   MVisible := Mouse.Visible;
   if MVisible then
      Mouse.Hide;
   X := Succ(X2-X1);
   for I := Y1 to Y2 do
      oWritePtr^.ChangeAttr(X1,I,Attr,X);
   if MVisible then
      Mouse.Show;
end; {ScreenOBJ.Attrib}

procedure ScreenOBJ.Clear(Att:byte;Ch:char);
{}
begin
    PartClear(1,1,Width,Depth,Att,Ch);
end; {ScreenOBJ.Clear}

procedure ScreenOBJ.PartClear(X1,Y1,X2,Y2,Att:byte;Ch:char);
{}
var
   I : integer;
   S : string;
begin
   Attrib(X1,Y1,X2,Y2,Att);
   S := Replicate(Succ(X2-X1),Ch);
   for I := Y1 to Y2 do
      WritePlain(X1,I,S);
end; {ScreenOBJ.PartClear}

procedure ScreenOBJ.ClearText(X1,Y1,X2,Y2:byte);
{}
var
   I : integer;
   S : string;
begin
   S := Replicate(Succ(X2-X1),' ');
   for I := Y1 to Y2 do
       WritePlain(X1,I,S);
end; {ScreenOBJ.ClearText}

procedure ScreenOBJ.ReadWord(X,Y:byte;var Attr:byte; var Ch : char);
{updates vars Attr and Ch with attribute and character bytes in screen
 location (X,Y) of the active screen}
Type
  ScreenWordRec = record
     Ch   : char;
     Attr : byte;
  end;
var
   VisiblePtr: pointer;
   VisibleAdr : word;
   SW : ScreenWordRec;
begin
    X := X + pred(oWritePtr^.WinX);
    Y := Y + pred(oWritePtr^.WinY);
    VisiblePtr := Monitor^.BaseOfScreen;
    VisibleAdr := pred(Y)*Monitor^.Width*2 + pred(X)*2;
    MoveFromScreen(mem[Seg(VisiblePtr^):ofs(VisiblePtr^)+VisibleAdr],
                      mem[seg(SW):ofs(SW)],1);
    Attr := SW.Attr;
    Ch   := SW.Ch;
end; {ScreenOBJ.ReadWord}

function ScreenOBJ.ReadChar(X,Y:byte):char;
var
   A : byte;
   C : char;
begin
    ReadWord(X,Y,A,C);
    ReadChar := C;
end; {ScreenOBJ.ReadChar}

function ScreenOBJ.ReadAttr(X,Y:byte):byte;
var
   A : byte;
   C : char;
begin
   ReadWord(X,Y,A,C);
   ReadAttr := A;
end; {ScreenOBJ.ReadAttr}

function ScreenOBJ.ReadStr(X1,X2,Y:byte):string;
var
   I : integer;
   Str: string;
begin
    Str := '';
    for I := X1 to X2 do
        Str := Str + ReadChar(I,Y);
    ReadStr := Str;
end; {ScreenOBJ.ReadStr}

procedure ScreenOBJ.TitleEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr:byte;
                                Str, Title: string);
{}
var
   TitVert: byte; {0-top, 1-dropbox, 2-bottom}
   TitHoriz:byte; {0-left, 1-center, 2-right}
   MaxWidth:integer;
   X,Y : byte;
begin
   if (Title[2] in [TitPos[1],TitPos[2],TitPos[3]])
   and (Title[1] in [TitPos[4],TitPos[5],TitPos[6]]) then {swap 'em}
   begin
      insert(Title[2],Title,1);
      delete(Title,3,1);
   end;
   if Title[1] = TitPos[1] then
      TitHoriz := 0
   else if Title[1] = TitPos[3] then
      TitHoriz := 2
   else
      TitHoriz := 1;
   if Title[1] in [TitPos[1],TitPos[2],TitPos[3]] then
      delete(Title,1,1);
   if Title = '' then exit;
   if (Title[1] = TitPos[5]) and (Y2-Y1 > 1) then
      TitVert := 1
   else if Title[1] = TitPos[6] then
      TitVert := 2
   else
      TitVert := 0;
   if Title[1] in [TitPos[4],TitPos[5],TitPos[6]] then
      delete(Title,1,1);
   if Title = '' then exit;
   {check title is narrow enough to fit}
   if TitVert = 1 then
      MaxWidth :=  pred(X2-X1)
   else
      MaxWidth := X2-X1-3;
   if TitVert = 0 then
      dec(MaxWidth,LeftPad+RightPad);
   if MaxWidth <= 0 then
      Title := ''
   else
      delete(Title,succ(MaxWidth),255);  {truncate title}
   Case Titvert of
      0: begin
         Case TitHoriz of
            0 : WriteAt(succ(X1)+LeftPad,Y1,Tattr,Title);
            1 : WriteBetween(succ(X1)+LeftPad,pred(X2)-RightPad,y1,Tattr,Title);
            else WriteRight(pred(X2)-RightPad,Y1,Tattr,Title);
         end; {case}
      end;
      1: begin
         WriteAt(X1,Y1+2,Battr,str[8]+
                            replicate(pred(X2-X1),str[2])+
                            Str[5]);
         Case TitHoriz of
            0 : WriteAt(succ(X1),succ(Y1),Tattr,Title);
            1 : WriteBetween(X1,X2,succ(y1),Tattr,Title);
            else WriteRight(pred(X2),succ(Y1),Tattr,Title);
         end; {case}
      end;
      2: begin
         Case TitHoriz of
            0 : WriteAt(succ(X1),Y2,Tattr,Title);
            1 : WriteBetween(X1,X2,Y2,Tattr,Title);
            else WriteRight(pred(X2),Y2,Tattr,Title);
         end; {case}
      end;
   end; {case}
end; {ScreenOBJ.TitleEngine}

procedure ScreenOBJ.BoxEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr,MAttr,style:byte;
                              Filled: boolean;
                              Title: string);
{Used internally by Box and FBox}
const
   Style1:string[10] = '┌─┐│┤┘└├│─';
   Style2:string[10] = '╔═╗║╣╝╚╠║═';
   Style3:string[10] = '╓─╖║╢╜╙╟║─';
   Style4:string[10] = '╒═╕│╡╛╘╞│═';
   Style5:string[10] = '┌─╖│╡╝╘╞║═';
var
   Line,
   FLine,
   Str: string;
   I: integer;
begin
   if Style = 6 then
   begin
      PartClear(X1,Y1,X2,Y2,Mattr,' ');
      WriteAT(X1,Y1,BAttr,replicate(X2-pred(X1),char(223)));
      WriteAT(X1,Y1+2,BAttr,replicate(X2-pred(X1),'_'));
      WriteBetween(X1,X2,succ(Y1),Tattr,Title);
   end
   else
   begin
      case Style of
      0 : Str := '          ';
      1 : Str := Style1;
      2 : Str := Style2;
      3 : Str := Style3;
      4 : Str := Style4;
      5 : Str := Style5;
      else Str := Replicate(10,chr(style));
      end;
      WriteAt(X1,Y1,Battr,Str[1]);
      Line := replicate(pred(X2-X1),Str[2]);
      WriteAt(X1+1,Y1,Battr,Line);
      WriteAt(X2,Y1,Battr,Str[3]);
      for I := Y1+1 to Y2-1 do
      begin
         WriteAt(X1,I,Battr,Str[4]);
         WriteAt(X2,I,Battr,Str[9]);
      end;
      if Filled then
         PartClear(succ(X1),succ(Y1),pred(X2),pred(Y2),MAttr,' ');
      WriteAt(X1,Y2,Battr,Str[7]);
      Line := replicate(pred(X2-X1),Str[10]);
      WriteAt(X1+1,Y2,Battr,Line);
      WriteAt(X2,Y2,Battr,Str[6]);
      {now the title: extract the first two character positions, and draw it}
      if Title <> '' then
         TitleEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr,Str,Title);
   end;
end; {BoxEngine}

procedure ScreenOBJ.Box(X1,Y1,X2,Y2,attr,style:byte);
{draws box and leaves internal area as is}
begin
    BoxEngine(X1,Y1,X2,Y2,0,0,attr,attr,attr,Style,false,'');
end; {ScreenOBJ.Box}

procedure ScreenOBJ.FillBox(X1,Y1,X2,Y2,attr,style:byte);
{draws box and erases internal area}
begin
   BoxEngine(X1,Y1,X2,Y2,0,0,attr,attr,attr,Style,true,'');
end; {ScreenOBJ.FillBox}

procedure ScreenOBJ.ShadFillBox(X1,Y1,X2,Y2,attr,style:byte);
{draws box and erases internal area}
begin
   BoxEngine(X1,Y1,X2,Y2,0,0,attr,attr,attr,Style,true,'');
   ShadowTOT^.DrawShadowXY(X1,Y1,X2,Y2);
end; {ScreenOBJ.ShadFillBox}

procedure ScreenOBJ.TitledBox(X1,Y1,X2,Y2,Battr,Tattr,MAttr,style:byte;Title:string);
{}
begin
   BoxEngine(X1,Y1,X2,Y2,0,0,Battr,Tattr,MAttr,Style,true,title);
end; {ScreenOBJ.TitledFillBox}

procedure ScreenOBJ.HorizLine(X1,X2,Y,Attr,Style : byte);
var
  I : integer;
  LineChar : char;
begin
   case Style of
   0   : LineChar := ' ';
   2,4 : LineChar := '═';
   1,3 : LineChar := '─';
   else LineChar := Chr(Style);
   end; {case}
   WriteAt(X1,Y,Attr,replicate(X2-X1+1,LineChar))
end;   {ScreenOBJ.HorizLine}

procedure ScreenOBJ.VertLine(X,Y1,Y2,Attr,Style:byte);
{}
var
    I : integer;
    LineChar : char;
begin
   case Style of
   0   : LineChar := ' ';
   2,4 : LineChar := '║';
   1,3 : LineChar := '│';
   else LineChar := Chr(Style);
   end; {case}
   for I := Y1 to Y2 do
      WriteAt(X,I,Attr,LineChar)
end; {ScreenOBJ.VertLine}

procedure ScreenOBJ.SmartVertLine(X,Y1,Y2,Attr,Style:byte);
{draws box character and adjust any lines it overlays}
var
    I : integer;
    LineStr : string[19];
    TestCh,
    Ch : char;
    StringOffset : byte;

    function AdjacentChar(X,Y:byte): char;
    {}
    begin
       if (X < 1) or (X > width) then
          AdjacentChar := ' '
       else
          AdjacentChar := ReadChar(X,Y);
    end; {AdjacentChar}

    function LineCh(X,Y:byte): char;
    {}
    const
       LeftSingle: string[13] = '─┬┐┼┤┴┘╥╖╫╢╨╜';
       LeftDouble: string[13] = '═╦╗╬╣╩╝╤╕╪╡╧╛';
       RightSingle:string[13] = '┌─┬├┼└┴╓╥╟╫╙╨';
       RightDouble:string[13] = '╔═╦╠╬╚╩╒╤╞╪╘╧';
    var
      LineStyle : char;
    begin
       LineStyle := AdjacentChar(pred(X),Y);
       if pos(LineStyle,RightSingle) > 0 then
          LineStyle := '─'
       else if pos(LineStyle,RightDouble) > 0 then
          LineStyle := '═'
       else
          LineStyle := ' ';
       case LineStyle of
       '─': if pos(AdjacentChar(succ(X),Y),leftSingle) > 0 then
               Ch := LineStr[2+StringOffset]
            else
               Ch := LineStr[3+StringOffset];
       '═': if pos(AdjacentChar(succ(X),Y),LeftDouble) > 0 then
               Ch := LineStr[4+StringOffset]
            else
               Ch := LineStr[5+StringOffset];
       else  TestCh := AdjacentChar(succ(X),Y);
             If pos(TestCh,LeftSingle) > 0 then
                Ch := LineStr[6+StringOffset]
             else if pos(TestCh,LeftDouble) > 0  then
                Ch := LineStr[7+StringOffset]
             else
                Ch := LineStr[1];
       end; {case}
       LineCh := Ch;
    end; {LineCh}

begin
   if Style in [2,4] then
      LineStr := '║╥╖╦╗╓╔╫╢╬╣╟╠╨╜╩╝╙╚'
   else
      LineStr := '│┬┐╤╕┌╒┼┤╪╡├╞┴┘╧╛└╘';
   {draw first character}
   StringOffSet := 0;
   WriteAt(X,Y1,attr,LineCh(X,Y1));
   StringOffSet := 6;
   for I := succ(Y1) to pred(Y2) do
      WriteAt(X,I,attr,LineCh(X,I));
   StringOffSet := 12;
   WriteAt(X,Y2,attr,LineCh(X,Y2));
end; {ScreenOBJ.SmartVertLine}

procedure ScreenOBJ.SmartHorizLine(X1,X2,Y,Attr,Style:byte);
{draws box character and adjust any lines it overlays}
var
    I : integer;
    LineStr : string[19];
    TestCh,
    Ch : char;
    StringOffset : byte;

    function AdjacentChar(X,Y:byte): char;
    {}
    begin
       if (Y < 1) or (Y > depth) then
          AdjacentChar := ' '
       else
          AdjacentChar := ReadChar(X,Y);
    end; {AdjacentChar}

    function LineCh(X,Y:byte): char;
    {}
    const
        DownSingle: string[13] = '┌┬┐│├┼┤╒╤╕╞╪╡';

        DownDouble: string[13] = '╔╦╗║╠╬╣╓╥╖╟╫╢';

        UpSingle:   string[13] = '│├┼┤└┴┘╞╪╡╘╧╛';

        UpDouble:   string[13] = '║╠╬╣╚╩╝╟╫╢╙╨║';
    var
      LineStyle : char;
    begin
       LineStyle := AdjacentChar(X,pred(Y));
       If pos(LineStyle,DownSingle) > 0 then
          LineStyle := '│'
       else if pos(LineStyle,DownDouble) > 0 then
          LineStyle := '║'
       else
          LineStyle := ' ';
       case LineStyle of
       '│': if pos(AdjacentChar(X,succ(Y)),UpSingle) > 0 then
               Ch := LineStr[2+StringOffset]
            else
               Ch := LineStr[3+StringOffset];
       '║': if pos(AdjacentChar(X,succ(Y)),UpDouble) > 0 then
               Ch := LineStr[4+StringOffset]
            else
               Ch := LineStr[5+StringOffset];
       else  TestCh := AdjacentChar(X,succ(Y));
             If pos(TestCh,UpSingle) > 0 then
                Ch := LineStr[6+StringOffset]
             else if pos(TestCh,UpDouble) > 0 then
                Ch := LineStr[7+StringOffset]
             else
                Ch := LineStr[1];
       end; {case}
       LineCh := Ch;
    end; {LineCh}

begin
   if Style in [2,4] then
      LineStr := '═╞╘╠╚╒╔╪╧╬╩╤╦╡╛╣╝╕╗ '
   else
      LineStr := '─├└╟╙┌╓┼┴╫╨┬╥┤┘╢╜┐╖';
   {draw first character}
   StringOffSet := 0;
   WriteAt(X1,Y,attr,LineCh(X1,Y));
   StringOffSet := 6;
   for I := succ(X1) to pred(X2) do
      WriteAt(I,Y,attr,LineCh(I,Y));
   StringOffSet := 12;
   WriteAt(X2,Y,attr,LineCh(X2,Y));
end; {ScreenOBJ.SmartHorizLine}

procedure ScreenOBJ.WriteHScrollBar(X1,X2,Y,Attr: byte; Current,Max: longint);
{}
var
  X,LineLength : integer;
begin
   WriteAT(X1,Y,Attr,ScrollTOT^.LeftChar);
   WriteAT(X2,Y,Attr,ScrollTOT^.RightChar);
   WriteAT(succ(X1),Y,Attr,replicate(pred(X2-X1),ScrollTOT^.BackgroundChar));
   if (Current > 0) and (Max >= Current) then
   begin
     LineLength := X2 - succ(X1);
     if LineLength > 0 then
     begin
        X := (Current * LineLength) div Max;
        if Current >= Max then
           X := pred(LineLength);
        if (X < 0) or (Current = 1) then
           X := 0;
        WriteAT(succ(X1) + X,Y,Attr,ScrollTOT^.ElevatorChar);
     end;
   end;
end; {ScreenOBJ.WriteHScrollBar}

procedure ScreenOBJ.WriteVScrollBar(X,Y1,Y2,Attr: byte; Current,Max: longint);
{}
var
  BC : char;
  I,Y,LineLength : integer;
begin
   WriteAT(X,Y1,Attr,ScrollTOT^.UpChar);
   WriteAT(X,Y2,Attr,ScrollTOT^.DownChar);
   BC := ScrollTOT^.BackgroundChar;
   for I := succ(Y1) to pred(Y2) do
       WriteAT(X,I,Attr,BC);
   if (Current > 0) and (Max >= Current) then
   begin
     LineLength := Y2 - succ(Y1);
     if LineLength > 0 then
     begin
        Y := (Current * LineLength) div Max;
        if Current >= Max then
           Y := pred(LineLength);
        if (Y < 0) or (Current = 1) then
           Y := 0;
        WriteAT(X,succ(Y1)+Y,Attr,ScrollTOT^.ElevatorChar);
     end;
   end;
end; {ScreenOBJ.WriteVScrollBar}

destructor ScreenOBJ.Done;
{}
var MemoryUsed: longint;
begin
   If not OnScreen then
   begin
      MemoryUsed := Width*Depth*2;
      freemem(vScreenPtr,MemoryUsed);
      dispose(oWritePtr,Done);
   end;
end;  {ScreenOBJ.Done}
{|||||||||||||||||||||||||||||||||||||||||||}
{                                           }
{     S c r o l l O B J   M E T H O D S     }
{                                           }
{|||||||||||||||||||||||||||||||||||||||||||}
constructor ScrollOBJ.Init;
{}
begin
   SetDefaults;
end; {ScrollOBJ.Init}

procedure ScrollOBJ.SetDefaults;
{}
begin
   SetScrollChars('','',char(27),char(26),'','░');
end;  {of ScrollOBJ.SetDefaults}

procedure ScrollOBJ.SetScrollChars(U,D,L,R,E,B:char);
{}

begin
   vUpArrowChar := U;
   vDownArrowChar := D;
   vLeftArrowChar := L;
   vRightArrowChar := R;
   vElevatorChar := E;
   vBackgroundChar := B;
end;  {of ScrollOBJ.SetScrollChars}

function ScrollOBJ.UpChar:char;
{}
begin
   UpChar := vUpArrowChar;
end; {ScrollOBJ.UpChar}

function ScrollOBJ.DownChar:char;
{}
begin
   DownChar := vDownArrowChar;
end; {ScrollOBJ.DownChar}

function ScrollOBJ.LeftChar:char;
{}
begin
   LeftChar := vLeftArrowChar;
end; {ScrollOBJ.LeftChar}

function ScrollOBJ.RightChar:char;
{}
begin
   RightChar := vRightArrowChar;
end; {ScrollOBJ.RightChar}

function ScrollOBJ.ElevatorChar:char;
{}
begin
   ElevatorChar := vElevatorChar;
end; {ScrollOBJ.ElevatorChar}

function ScrollOBJ.BackgroundChar:char;
{}
begin
   BackgroundChar := vBackgroundChar;
end; {ScrollOBJ.BackgroundChar}

destructor ScrollOBJ.Done;
begin end;
{|||||||||||||||||||||||||||||||||||||||||||}
{                                           }
{     S h a d o w O B J   M E T H O D S     }
{                                           }
{|||||||||||||||||||||||||||||||||||||||||||}
constructor ShadowOBJ.Init;
{}
begin
   SetDefaults;
end; {ShadowOBJ.Init}

procedure ShadowOBJ.SetDefaults;
{}
begin
   vShadWidth := 2;
   vShadDepth := 1;
   vShadPos := DownRight;
   vShadAttr := 7;
   vShadChar := ' ';
end; {ShadowOBJ.SetDefaults}

procedure ShadowOBJ.DrawShadow(Border:tCoords);
{}
var
  Outer: tCoords;

  procedure DrawPartofShadow(X1,Y1,X2,Y2:byte);
  begin
     if (X1 > X2) or (Y1 > Y2) then exit;
     if vShadChar = ' ' then {attribute change}
        Screen.Attrib(X1,Y1,X2,Y2,vShadAttr)
     else
        Screen.PartClear(X1,Y1,X2,Y2,vShadAttr,vShadChar);
  end; {of sub proc DrawPartofShadow}

begin
   OuterCoords(Border,Outer);
   case vShadPos of
   UpLeft:   begin
                DrawPartofShadow(Outer.X1,Outer.Y1,pred(Border.X1),Border.Y2-vShadDepth);
                DrawPartofShadow(Border.X1,Outer.Y1,Border.X2-vShadWidth,pred(Border.Y1));
             end;
   UpRight:  begin
                DrawPartofShadow(Border.X1+vShadWidth,Outer.Y1,Outer.X2,pred(Border.Y1));
                DrawPartofShadow(succ(Border.X2),Border.Y1,Outer.X2,Border.Y2-vShadDepth);
             end;
   DownLeft: begin
                DrawPartofShadow(Outer.X1,Border.Y1+vShadDepth,pred(Border.X1),Outer.Y2);
                DrawPartofShadow(Border.X1,succ(Border.Y2),Border.X2-vShadWidth,Outer.Y2);
             end;
   DownRight:begin
                DrawPartofShadow(Border.X1+vShadWidth,succ(Border.Y2),Outer.X2,Outer.Y2);
                DrawPartofShadow(succ(Border.X2),Border.Y1+vShadDepth,Outer.X2,Border.Y2);
             end;
   end; {case}
end; {ShadowOBJ.DrawShadow}

procedure ShadowOBJ.DrawShadowXY(X1,Y1,X2,Y2:integer);
{}
var
  Border: tCoords;
begin
   Border.X1 := X1;
   Border.Y1 := Y1;
   Border.X2 := X2;
   Border.Y2 := Y2;
   DrawShadow(Border);
end; {ShadowOBJ.DrawShadowXY}

procedure ShadowOBJ.SetShadowStyle(ShadP:ShadowPosition; ShadA:byte; ShadC:char);
{}
begin
   vShadPos  :=  ShadP;
   vShadAttr :=  ShadA;
   vShadChar :=  ShadC;
end; {ShadowOBJ.SetShadowStyle}

procedure ShadowOBJ.SetShadowSize(ShadW,ShadD:byte);
{}
begin
   vShadWidth := ShadW;
   vShadDepth := ShadD;
end; {ShadowOBJ.SetShadowSize}

function ShadowOBJ.ShadWidth: byte;
{}
begin
   ShadWidth := vShadWidth;
end; {ShadowOBJ.ShadWidth}

function ShadowOBJ.ShadDepth: byte;
{}
begin
   ShadDepth := vShadDepth;
end; {ShadowOBJ.ShadDepth}

function ShadowOBJ.ShadAttr: byte;
{}
begin
   ShadAttr := vShadAttr;
end; {ShadowOBJ.ShadAttr}

function ShadowOBJ.ShadChar: char;
{}
begin
   ShadChar := vShadChar;
end; {ShadowOBJ.ShadChar}

function ShadowOBJ.ShadPos: ShadowPosition;
{}
begin
   ShadPos := vShadPos;
end; {ShadowOBJ.ShadPos}

procedure ShadowOBJ.OuterCoords(Border:tCoords;var Outer:tCoords);
{}
begin
   Case vShadPos of
   UpLeft:   begin
                Outer.X1 := Border.X1-vShadWidth;
                Outer.Y1 := Border.Y1-vShadDepth;
                Outer.X2 := Border.X2;
                Outer.Y2 := Border.Y2;
             end;
   UpRight:  begin
                Outer.X1 := Border.X1;
                Outer.Y1 := Border.Y1-vShadDepth;
                Outer.X2 := Border.X2+vShadWidth;
                Outer.Y2 := Border.Y2;
             end;
   DownLeft: begin
                Outer.X1 := Border.X1-vShadWidth;
                Outer.Y1 := Border.Y1;
                Outer.X2 := Border.X2;
                Outer.Y2 := Border.Y2+vShadDepth;
             end;
   DownRight:begin
                Outer.X1 := Border.X1;
                Outer.Y1 := Border.Y1;
                Outer.X2 := Border.X2+vShadWidth;
                Outer.Y2 := Border.Y2+vShadDepth;
             end;
   end; {case}
   if Outer.X1 < 1 then Outer.X1 := 1;
   if Outer.Y1 < 1 then Outer.Y1 := 1;
   if Outer.X2 > Screen.Width then Outer.X2 := Screen.Width;
   if Outer.Y2 > Screen.Depth then Outer.Y2 := Screen.Depth;
end; {ShadowOBJ.OuterCoords}

procedure ShadowOBJ.OuterXY(var X1,Y1,X2,Y2: integer);
{}
var Temp1,Temp2:tCoords;
begin
   Temp1.X1 := X1;
   Temp1.Y1 := Y1;
   Temp1.X2 := X2;
   Temp1.Y2 := Y2;
   OuterCoords(Temp1,Temp2);
   X1 := Temp2.X1;
   Y1 := Temp2.Y1;
   X2 := Temp2.X2;
   Y2 := Temp2.Y2;
end; {ShadowOBJ.OuterXY}

destructor ShadowOBJ.Done;
begin end;

{|||||||||||||||||||||||||||||||||||||||||||||||}
{                                               }
{     U N I T   I N I T I A L I Z A T I O N     }
{                                               }
{|||||||||||||||||||||||||||||||||||||||||||||||}

procedure FastInit;
{initilizes objects and global variables}
begin
    Screen.Init;
    Screen.Create(0,0,0);
    new(ScrollTOT,Init);
    new(ShadowTOT,Init);
end; {FastInit}

{end of unit - add intialization routines below}
{$IFNDEF OVERLAY}
begin
   FastInit;
{$ENDIF}
end.