UNIT IOSTUFF;
INTERFACE
USES CRT,DOS;
  TYPE
  AnyStr   = String[80];
  ShortStr = String[20];
  LongStr  = String[160];
  Map      = Record
             ScrCh : Char;
             ScrAt : Byte;
             End;
  Screen = Array[1..25,1..80] of Map;
  AdapterTypes = (CGA,MDA,EGAColor,EGAMono);
  VAR
  Video : ^Screen;
  ScreenHold : Array[0..3] of Screen;
  AdapterType : AdapterTypes;
  PROCEDURE MoveToScreen(Var Source,Dest; Len: Integer);
  PROCEDURE MoveFromScreen(Var Source,Dest; Len: Integer);
  PROCEDURE SaveScreen(NS:Integer);
  PROCEDURE RestoreScreen(NS:Integer);
  PROCEDURE SavePartScreen(X1,Y1,X2,Y2:Integer);
  PROCEDURE RestorePartScreen(X1,Y1,X2,Y2:Integer);
  PROCEDURE SetColor(F,B:integer);
  PROCEDURE WriteSt(St:AnyStr;X,Y:Integer);
  PROCEDURE WriteCh(Ch:Char;X,Y:Integer);
  PROCEDURE WriteManyCh(Ch:Char;X,Y,Num:Integer);
  PROCEDURE FillScr(Ch:Char);
  FUNCTION  ReadFromScr(X,Y,Len:Integer):AnyStr;
  FUNCTION  GetCh(X,Y:Integer):Char;
  FUNCTION  GetAt(X,Y:Integer):Byte;
  PROCEDURE Border(X1,Y1,X2,Y2: Integer; Header:AnyStr);
  PROCEDURE SBorder(X1,Y1,X2,Y2: Integer; Header:AnyStr);
  PROCEDURE Beep;
  PROCEDURE Display(Msg : AnyStr;XD,YD:Integer);
  PROCEDURE Wait;
  FUNCTION  Yes(Prompt:AnyStr):Boolean;
  PROCEDURE Linecursor;
  PROCEDURE BigCursor;
  PROCEDURE HideCursor;
  PROCEDURE ShowCursor;
IMPLEMENTATION
VAR
    PartHold   : Screen;
    R          : Registers;
    NS         : Integer;
    SAttr      : Byte;
{======================================================================}
FUNCTION IsEGA : Boolean;
BEGIN
  R.AH := $12;       { Select Alternate Function Service }
  R.BX := $10;       { Return EGA info }
  Intr($10,R);       { Do it }
  If R.BX = $10 then IsEGA := False    { If BX unchanged then EGA not there }
                else IsEGA := True;
END;

{======================================================================}
PROCEDURE CheckAdapter;

{ Checks for the type of display adapter installed. }
{ Sets AdapterType to one of the following : }
{    CGA      = Color Graphics Adapter }
{    MDA      = Monochrome Display Adapter }
{    EGAColor = EGA  With a Color Monitor }
{    EGAMono  = EGA with a Monochrome Monitor }

VAR
  AType : Byte;

BEGIN
  If IsEGA then
    Begin
      R.AH := $12;
      R.BL := $10;
      Intr($10,R);
      If (R.BH = 0) then AdapterType := EGAColor   { EGA Color adapter }
                    else AdapterType := EGAMono; { EGA Mono adapter }
    End
  Else
    Begin
      Intr($11,R);
      AType := (R.AL and $30) Shr 4;
      Case AType of
        1,2 : AdapterType := CGA;   { CGA }
        3   : AdapterType := MDA;   { Mono }
      Else AdapterType := CGA;      { CGA }
      End; { Case }
    End;

  If AdapterType = MDA then
       Video := Ptr($B000,0000)
  Else Video := Ptr($B800,0000);

END;


{======================================================================}
PROCEDURE MoveToScreen(Var Source,Dest; Len: Integer);

{ Similar to Turbo Move but assumes the destination is in video  }
{ memory and thus writes only during retrace to avoid snow.      }
{ These are used only in Save and Restore Screen routines below. }
{ These routines are very fast and can be used as the basic      }
{ building blocks for other direct screen IO.  I have used Turbo }
{ Pascals regular Write routines whereever possible because they }
{ are sufficiently fast and much more understandable and stable. }

BEGIN
    If AdapterType = CGA then Begin
      Len:=Len Shr 1;
      Inline($1E/$55/$BA/$DA/$03/$C5/$B6/ Source /$C4/$BE/ Dest /$8B/$8E/
             Len /$FC/$AD/$89/$C5/$B4/$09/$EC/$D0/$D8/$72/$FB/$FA/$EC/
             $20/$E0/$74/$FB/$89/$E8/$AB/$FB/$E2/$EA/$5D/$1F);
    End
    Else Move(Source,Dest,Len);
END;

{======================================================================}
PROCEDURE MoveFromScreen(Var Source,Dest; Len: Integer);

{ Similar to Turbo Move but assumes the source is in video  }
{ memory and thus writes only during retrace to avoid snow. }

BEGIN
    If AdapterType = CGA then Begin
      Len:=Len Shr 1;
      Inline($1E/$55/$BA/$DA/$03/$C5/$B6/ Source /$C4/$BE/ Dest /$8B/$8E/
             Len /$FC/$EC/$D0/$D8/$72/$FB/$FA/$EC/$D0/$D8/$73/$FB/$AD/
             $FB/$AB/$E2/$F0/$5D/$1F);
    End
  Else Move (Source,Dest,Len);
END;

{======================================================================}
PROCEDURE SaveScreen(NS:Integer);
BEGIN
  MoveFromScreen(Video^,ScreenHold[NS],4000);
END;

{======================================================================}
PROCEDURE RestoreScreen(NS:Integer);
BEGIN
  MoveToScreen(ScreenHold[NS],Video^,4000);
END;

{======================================================================}
PROCEDURE SavePartScreen(X1,Y1,X2,Y2:Integer);
VAR
  II,XLen : Integer;
BEGIN
  XLen := (X2-X1+1)*2;
  For II := Y1 to Y2 do begin
    MoveFromScreen(Video^[II,X1],ScreenHold[0,II,X1],XLen); { avoid snow }
  End;
END;

{======================================================================}
PROCEDURE RestorePartScreen(X1,Y1,X2,Y2:Integer);
VAR
  II,XLen : Integer;
BEGIN
  XLen := (X2-X1+1)*2;
  For II := Y1 to Y2 do begin
    MoveToScreen(ScreenHold[0,II,X1],Video^[II,X1],XLen); { avoid snow }
  End;
END;

{======================================================================}
PROCEDURE SetColor(F,B:integer);

{ This sets variable TextAttr in Unit CRT to the colors F and B }
{ The approach is equivalent to TextColor(F); TextBackground(B);}
{ except blink is handled directly (any B > 7)}

BEGIN
 TextAttr := F + B * 16;
END;

{======================================================================}
PROCEDURE WriteSt(St:AnyStr;X,Y:Integer);

{ Much output is strings.  This routine saves all the GOTOXYs}

BEGIN
  GoToXY(X,Y);
  Write(St);
END;

{======================================================================}
PROCEDURE WriteCh(Ch:Char;X,Y:Integer);

{ Service 9, Intr 10 is used because it will write the "unwriteable" }
{ low numbered ASCII characters like #07, which produces a beep if   }
{ written with a regular Write statement }

  BEGIN
      GoToXY(X,Y);             { Put cursor at location }
      R.AH := $09;             { Load A Hi with Service 9 }
      R.BL := TextAttr;        { Load B Lo with Attribute }
      R.BH := 0;               { Load B Hi with Screen 0 }
      R.AL := Ord(Ch);         { Load A Lo with Character to write }
      R.CX := 1;               { Load C with number of times to write (1) }
      Intr($10,R);             { Do Interrupt 10 }

  END;

{======================================================================}
PROCEDURE WriteManyCh(Ch:Char;X,Y,Num:Integer);

{ Like WriteCh above except repeats the character Num times. }

  BEGIN
      GoToXY(X,Y);
      R.AH := $09;
      R.BL := TextAttr;
      R.BH := 0;
      R.AL := Ord(Ch);
      R.CX := Num;
      Intr($10,R);

  END;

{======================================================================}
PROCEDURE FillScr(Ch:Char);

{ Fills the screen with the character passed }

  BEGIN
      GoToXY(1,1);
      R.AH := $09;
      R.BL := TextAttr;
      R.BH := 0;
      R.AL := Ord(Ch);
      R.CX := 2000;
      Intr($10,R);

  END;

{======================================================================}
FUNCTION ReadFromScr(X,Y,Len:Integer):AnyStr;

{ Uses service 8 of Intr 10 to read a string off the screen }
{ The cursor tends to flicker across the screen if this routine }
{ is used continuously so the cursor is turned off while it is }
{ working by flipping bit 5 of the top scan line to 1 }

VAR
   TempStr : AnyStr;
   II,L    : Integer;
   COff    : Boolean;
BEGIN
   COff := False;           { set true if cursor is already off }
                            { turn off the cursor }
   R.AX := $0300;           { Service 3 }
   Intr($10,R);             { Interrupt 10 to get cursor scan lines}
   If (R.CX and $2000) = $2000 then COff := true;
   R.CX := R.CX or $2000;   { Set bit 5 of top scan line to 1 }
   R.AX := $0100;           { Service 1 }
   Intr($10,R);             { Interrupt 10 to turn off }

   L := 0;
   For II := 1 to Len Do Begin
     GoToXY(X+II-1,Y);      { Locate cursor }

                            { Read a character from the screen }
     R.AX := $0800;         { Service 8 }
     R.BH := 0;             { Screen 0 }
     Intr($10,R);           { Interrupt 10 }
     TempStr[II] := Chr(R.AL);            { Char returned in AL }
     If TempStr[II] <> ' ' then L := II   { if non blank remember length }
   End;
   If not COff then Begin
                              { flip the cursor back on }
     R.AX := $0300;           { Service 3 again }
     Intr($10,R);             { Interrupt 10 to get scan lines }
     R.CX := R.CX and $DFFF;  { Flip bit 5 of top scan line to 0 }
     R.AX := $0100;           { Service 1 }
     Intr($10,R);             {Interrupt 10 to turn on cursor }
   End;

   TempStr[0] := Chr(L);    { Set the string length to last non blank char. }
   ReadFromScr := TempStr;  { Set function result to temporary string }
 END;
{======================================================================}
FUNCTION GetCh(X,Y:Integer):Char;

{ Reads a character from the screen using service 8, Intr 10 }

BEGIN

   GoToXY(X,Y);            { Locate the cursor }
   R.AX := $0800;          { Service 8 }
   R.BH := 0;              { Screen 0 }
   Intr($10,R);            { Interrupt 10 }
   GetCh := Chr(R.AL);     { Character returned in AL }

 END;

{======================================================================}
FUNCTION GetAt(X,Y:Integer):Byte;

{ Reads a color attrubute from the screen using service 8, Intr 10 }

BEGIN

   GoToXY(X,Y);            { Locate the cursor }

   R.AX := $0800;          { Service 8 }
   R.BH := 0;              { Screen 0 }
   Intr($10,R);            { Interrupt 10 }
   GetAt := R.AH;     { Character returned in AL }

 END;

{======================================================================}
PROCEDURE Border(X1,Y1,X2,Y2: Integer; Header:AnyStr);

{ Prints a double line box border on the screen with corners at }
{ X1,Y1 and X2,Y2.  The Header will be centered on the top.  }

VAR Indx : Integer;
BEGIN
   WriteCh('É',X1,Y1);                      { Upper left corner }
   WriteManyCh('Í',X1+1,Y1,X2-X1-1);        { Top }
   WriteCh('»',X2,Y1);                      { Upper right corner }
   For Indx := Y1+1 to Y2-1 do              { Both sides }
    Begin
     WriteCh('º',X1,Indx);
     WriteCh('º',X2,Indx);
    End;
   WriteCh('È',X1,Y2);                      { lower left corner }
   WriteManyCh('Í',X1+1,Y2,X2-X1-1);        { bottom }
   WriteCh('¼',X2,Y2);                      { lower right corner }
   If Header > '' then                      { Center header }
   WriteSt('µ'+Header+'Æ',X1+(X2-X1) div 2-((Length(Header)+1) div 2),Y1);
END;

{======================================================================}
PROCEDURE SBorder(X1,Y1,X2,Y2: Integer; Header:AnyStr);

{ Prints a single line box border on the screen with corners at }
{ X1,Y1 and X2,Y2.  The Header will be centered on the top.  }

VAR Indx : Integer;
BEGIN
   WriteCh('Ú',X1,Y1);                      { Upper left corner }
   WriteManyCh('Ä',X1+1,Y1,X2-X1-1);        { Top }
   WriteCh('¿',X2,Y1);                      { Upper right corner }
   For Indx := Y1+1 to Y2-1 do              { Both sides }
    Begin
     WriteCh('³',X1,Indx);
     WriteCh('³',X2,Indx);
    End;
   WriteCh('À',X1,Y2);                      { lower left corner }
   WriteManyCh('Ä',X1+1,Y2,X2-X1-1);        { bottom }
   WriteCh('Ù',X2,Y2);                      { lower right corner }
   If Header > '' then                      { Center header }
   WriteSt('´'+Header+'Ã',X1+(X2-X1) div 2-((Length(Header)+1) div 2),Y1);
END;

{======================================================================}
PROCEDURE Beep;
 BEGIN
 Sound(550); Delay(200); Nosound;
 END;

{======================================================================}
PROCEDURE Display(Msg : AnyStr;XD,YD:Integer);
BEGIN
   SAttr := TextAttr;
   SetColor(Green,Black);
   GoToXY(XD,YD); Clreol;
   WriteSt(Msg,XD,YD);
   TextAttr := SAttr;
END;

{======================================================================}
PROCEDURE Wait;
VAR
   WCh : Char;
BEGIN;
    Sattr := TextAttr;
    SetColor(Green,Black);
    Display('Hit any key to continue',1,25);
    WCh := Readkey;
    If WCh = #0 then WCh := Readkey;
    TextAttr := Sattr;
END;

{======================================================================}
FUNCTION Yes(Prompt:AnyStr):Boolean;
VAR
      InChar : Char;
 BEGIN
      SAttr := TextAttr;
      SetColor(Green,Black);
      GoToXY(1,25);
      ClrEol;
      Display(Prompt,1,25);
      Repeat
        Inchar := Readkey;
        If not (InChar in ['Y','y','N','n']) then Beep;
      until InChar in ['Y','y','N','n'];
      Yes := InChar in ['Y','y'];
      TextAttr := SAttr;
 END;

{======================================================================}
PROCEDURE Linecursor;

{ Sets the cursor to two lines.  Checks type of adapter because }
{ Monochrome has more scan lines than CGA/EGA }

  Begin
    R.AX := $0100;                   { Service 1 }
    If AdapterType = MDA
             then R.CX := $0C0D      { Mono Adapter }
             else R.CX := $0607;     { Color Adapters }
    Intr($10,R);                     { Interrupt 10 }
  End;

{======================================================================}
PROCEDURE Bigcursor;

{ Sets the cursor to a large block to signify insert.  As above }
{ checks adapter }
  Begin
    R.AX := $0100;                    { Service 1 }
    If AdapterType = MDA
             then R.CX := $010D       { Mono Adapter }
             else R.CX := $0107;      { Color Adapter }
    Intr($10,R);                      { Interrupt 10 }
  End;

{======================================================================}
PROCEDURE HideCursor;

{ Turns cursor off by flipping bit 5 of top scan line to 1.    }
{ This is a better cursor hiding technique than moving it off  }
{ the screen because you can still do GoToXY and the cursor is }
{ invisible. }

  BEGIN
       R.AX := $0300;               { Service 3 }
       Intr($10,R);                 { Intr 10. Get scan lines}
       R.CX := R.CX or $2000;       { Set bit 5 to 1}
       R.AX := $0100;               { Service 1 }
       Intr($10,R);                 { Intr 10 resets cursor}
  END;

{======================================================================}
PROCEDURE ShowCursor;
{ Turns cursor on by flipping bit 5 of Top Scan Line back to 0 }

  BEGIN
       R.AX := $0300;               { Service 3 }
       Intr($10,R);                 { Intr 10. Get scan lines}
       R.CX := R.CX and $DFFF;      { Set bit 5 to 0}
       R.AX := $0100;               { Service 1 }
       Intr($10,R);                 { Intr 10 resets cursor}
  END;

{======================================================================}

BEGIN {Initilization}
  CheckAdapter;
END. {OF UNIT}