Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/NUTUG11.ZIP/VIDEO.PAS

Pascal/Delphi Source File | 1987-11-22 | 43.9 KB | 1,311 lines

Unit Video;

            {NORTHWESTERN UNIVERSITY TURBO USERS GROUP UTILITIES}

                      (** NUtility VIDEO ROUTINES **)

                         {(C) J. E. Hilliard 1986}

         {This is a set of routines for manipulating the video text
         displays on either a monochrome or a color/graphics monitor.
         The routines that involve transfers between of the video
         will have to be modified for graphic displays. Note, how-
         ever the availabilty of the TURBO built-in routines: PutPic
         and GetPic which will be faster than similar routines writ-
         ten in source language. Modifications may also be required
         for video cards other than the standard Monochrome or Color/
         graphics.                                                   }

         {/Some of the routines provide examples of the use of pointer
         variables, memory block moves and BIOS video services. A good
         treatment of video basics is to be found in Chapter 4 of the
         book by Norton.                                            /}

INTERFACE

Uses     Dos,
         Crt;


PROCEDURE LVid;
         {Replaces TURBO LowVideo.                                          }

PROCEDURE NVid;
         {Replaces TURBO NormVideo.                                         }

PROCEDURE RVid;
         {Reverse Video - Black on a bright background.                     }

PROCEDURE NoVid;
         {At first sight, there would appear to be little need for an
         invisible video mode. However, it is occasionally useful for
         erasing part of a line by overwriting in this mode.        }

PROCEDURE UVid;
         {Underlines the current video mode on a monochrome monitor
         and yields a non-underlined blue foreground on a color
         monitor. (NOTE: There is no underline RVid mode.)        }

PROCEDURE BlinkVid;
         {Sets the current video mode blinking for subsequent input
         until the next video command is given.                      }

PROCEDURE PrintScreen;
         {This is equivalent to a PrtSc from the keyboard. NOTE: This
         routine may not function properly if the user has not loaded
         a PSC file.                                                 }

PROCEDURE SwapPage (P1, P2 : integer);
         {This procdedure exchanges the contents of text pages P1 and
         P2 (0 <= P1, P2 <= 3). It also sets the cursors to the correct
         locations in both pages.                                    }

PROCEDURE CopyPage (P1, P2 : integer);
         {Copies Page P1 to Page P2. Contents of Page P1 are retained.}

PROCEDURE CopyBufferToPage (VAR Buffer; P : integer);
         {Copies contents of Buffer to Page P.                       }

PROCEDURE DisplayPage (P : integer);
         {Uses a call to interrupt $10 to transfer display to Page P}

PROCEDURE ClearPage (P : integer);
         {Loads addresses in Page P with 0's thus clearing the page.
         It is equivalent to: LowVideo; ClrScr; on the display page.
         NOTE: ClrScr clears the page presently been displayed and
         not Page 0 as one might expect.                             }

PROCEDURE Cursor (ONorOFF : Boolean);
         {Turns screen cursor ON or OFF.                                    }

PROCEDURE DisplayVideoModes;
         {This displays the 128 possible non-blinking video modes
          available on the IBM PC and compatables.                }

PROCEDURE Frame (TX, TY, BX, BY : integer; Form : byte);
          {The input parameters are the coordinates for the top-left
          and bottom-right corners of the frame and are with reference
          to the inside corners. (This is for convenience when using
          the TURBO Window procedure.)  If TY = BY then a single hori-
          zontal line is drawn and if TX = BX a single vertical line.
          Form = 1 uses the -- graph symbol and Form = 2 the === symbol.
          The video modes on entry determine the attributes of the
          boarder.                                                    }

FUNCTION  ModeCG : Boolean;
         {If color/graphics card is installed changes display to this
         card. Returns false if card not found.                      }

FUNCTION ModeMono : Boolean;
         {If Monochrome card is installed changes display to this card.
         Returns false if card not found.                             }

FUNCTION ScreenToFile (FileName : String) : Boolean;
         {Stores screen display  on disk as the  file 'FileName'.  Re-
         turns 'False' if there is an I/O error.                     }

FUNCTION FileToScreen (FileName : String) : Boolean;

         {Loads and displays screen stored in 'FileName'. Returns false
         if there is an I/O error.                                   }

FUNCTION HeapOK (BytesReqd : LongInt) : Boolean;
          {Returns true if there is 'BytesReqd' contiguous bytes avail-
          able on the heap.                                           }

FUNCTION LPushPopScr (ONorOFF : Boolean) : Boolean;
         {The purpose of this function is to store or retrieve text
         displays on or from the heap in a first-in last-out sequence.
         The function acts in two modes depending on the value of:

         ONorOFF = ON
         ------------
              The display on the current monitor (monochrome or color)
         is stored on the heap and the function returns 'TRUE' if there
         is sufficient memory available to store another screen.

         ONorOFF = OFF
         -------------
              The last stored stored screen is transferred from the
         heap to the current monitor and the heap space is recovered.
         The function returns 'FALSE' if the heap is empty.

         This function can be used in conjunction with 'Frame' and
         'Window' to display pull-down menus. (See: PROCEDURE Screen-
         StackDemo.)                                                        }

FUNCTION TPushPopScr (ONorOFF : Boolean) : Boolean;
          {This function is operationally similar to LPushPopScr.     }

implementation

CONST

  ON         = true;
  OFF        = false;
    {/In some applications ON/OFF is more descriptive than true/false./}
  MonoSeg    = $B000;                  {Segment address of Mono Ram.        }
  CGSeg      = $B800;                  {   "        "    " C/G Ram.         }
  ScrMemSize = $FA0;                   {Text: 2 * 80 * 25. For graphics     }
                                       {change to $4000 (16K).              }

         (** The following define the attribute bytes used by the vid-
         eo commands. They are defined as typed constants (rather than
         global variables) so that they will be stored in the code
         area and can therefore be saved after modification by the
         user of a COM file.                                       **)

  Attr     : byte = $6;                {This holds the attribute of the     }
  LowAttr  : byte = $6;                {current video setting.              }
  NormAttr : byte = $1E;
  RevAttr  : byte = $70;

TYPE

          {/TURBO uses a record type variable to pass information to
          and from the 8088 registers that are used for function calls.
          The X registers (A - D) are each two bytes long, but very fre-
          quently they are split into a low order and high order byte
          designated by an L and H respectively. For example, AX is an
          integer register and AL and AH are the byte components. A
          neat way of allowing for the addressing of either type of
          register without having to do bitwise manipulations is to
          define a variant record.

          In a variant record (which is a Pascal speciality) one can set
          up overlapping fields. In the case of RegType declared above,
          variant 2 occupies the same memory locations as variant 1.
          Thus AL is the low order byte of the integer AX.

          Another application of variant records is to be found in the
          REALFAST routines.

          A good treatment of DOS interrupts is given in Chapter 16 of
          Norton's book.                                             /}


  ScrRAMType = array [1..ScrMemSize] of byte;
  ScrPtrType = ^ScrRAMType;
  MaxLine    = string;

                         (**  VIDEO MODE COMMANDS  **)

         {The following set of procedures supplement the LowVideo and
         NormVido commands provided by TURBO. The latter provide un-
         satisfactory displays on some monitors. DisplayVideoModes
         can be used to select suitable values for insertion in the
         table of attribute constants. The routines use the standard
         TURBO color commands.                                       }

         {/In text mode, each of the possible 2000 (80 x 25) charac-
         ters on the screen is stored in a buffer as a pair of bytes.
         One is the ASCII value of the character and the other deter-
         mines the 'attribute' of the character display (ie. the color
         and intensity). [It would have made some coding simpler and
         faster in execution if the bytes had been stored in separate
         arrays, but IBM decided otherwise.] The mapping of the attri-
         bute byte can be found in Norton (p. 80). The TURBO command
         TextColor () can be used to set bits 0 to 3 and the command
         TextBackground () bits 4 to 6. (Illogically, bit 7 is set by
         adding 16 to the argument of TextColor.)                   /}


PROCEDURE LVid;

         {Replaces TURBO LowVideo.                                          }

Begin

  Attr := LowAttr;
  TextColor (Attr and $0F);
  TextBackground (Attr shr 4);

End; {LVid}


PROCEDURE NVid;

         {Replaces TURBO NormVideo.                                         }

Begin

  Attr := NormAttr;
  TextColor (Attr and $0F);
  TextBackground (Attr shr 4);

End; {NVid}


PROCEDURE RVid;

         {Reverse Video - Black on a bright background.                     }

Begin

  Attr := RevAttr;
  TextColor (Attr and $0F);
  TextBackground (Attr shr 4);

End; {RVid}


PROCEDURE NoVid;

         {At first sight, there would appear to be little need for an
         invisible video mode. However, it is occasionally useful for
         erasing part of a line by overwriting in this mode.        }

Begin

  TextColor (0);
  TextBackground (0);
  Attr := 0;

End;

PROCEDURE UVid;

         {Underlines the current video mode on a monochrome monitor
         and yields a non-underlined blue foreground on a color
         monitor. (NOTE: There is no underline RVid mode.)        }

Begin

  Attr := Attr and $8 or $01;
  TextColor (Attr);

End; {UVid}


PROCEDURE BlinkVid;

         {Sets the current video mode blinking for subsequent input
         until the next video command is given.                      }

         {/The blink mode is obtained by setting bit 7 of the attribute
         byte. However, the TURBO command (Manual p. 161) is not a
         logical one, since it requires adding 16 to the text color./}

Begin

  TextColor (Attr and $0F + $10);

End; {BlinkVid}


    (***** CHANGING THE VIDEO ATTRIBUTES USED BY THE TURBO EDITOR *****)

         {   For some users (particularly those with color monitors)
         the choice made by Borland for the text editor video modes
         is not a happy one. The following information will enable
         you to change the modes if you so desire. The procedure
         DisplayVideoModes can be run to provide a guide in the select-
         ion of replacement attribute bytes.

             For PC DOS Turbo Pascal V3.10 (including the 8087 and BCD
         versions) the character attributes used by the editor are
         stored in eight bytes starting at location CS:016F. The first
         four bytes are used for display on the Monochrome monitor and
         the second four for a monitor attached to the color/graphics
         card. The following is the disposition of the bytes (numbers
         are in Hex):
                       ------------------------------------
                       Mono    C/G        Use         Value
                       ------------------------------------
                       016F    0173    Text             0F
                       0170    0174    Menus            07
                       0171    0175    Block marking    07
                       0172    0176    Error Messages   70
                       ------------------------------------

              Note, these attribute bytes are used only by the editor
         and have no effect on the video commands in a Pascal program.

              When the TURBO.COM is loaded, it first checks which type
         of monitor is being used and then copies the appropriate four
         bytes into higher memory. For the non 8087/BCD version the
         starting location is 9C00. By addressing these locations from
         within Turbo one could change the editor attributes after the
         program is loaded. However, it is much better to patch the loc-
         ations listed above using the DOS utility DEBUG.

         {/If your are unfamiliar with DEBUG ask someone to show you how
         to make the patch. (Its easier than trying to understand the
         manual.) Also, make the patch on a COPY of your working file
         and test the patched copy thoroughly before deleting the orig-
         inal.                                                        /}

    (*******************************************************************)

                         (** DISPLAY MODE HANDLING **)

          {/In a non-enhanced PC (ie. one not containing a special
          graphics card) there are two possible video modes. One uti-
          lizes a Color/Graphics card and the other, which can only be
          used for text, a Monochrome card. (The term 'Monochrome' is
          somewhat confusing since the Color/Graphics card may be con-
          nected to a black and white monitor and, in that sense, is
          also monochrome.)

          For routines that directly access the video memory it is
          necessary to know which monitor is being used. Obviously, it
          would be tacky to query the user (who is probably not to be
          relied on anyway). Two routines are therefore provided for
          eliciting the information from the system.

          If both types of monitor are connected routines are provided
          for switching between the two monitors.                   /}


FUNCTION DisplayMode : byte;

          {/Service $F of interrupt $10 returns information about the
          current video mode. One important application is determining
          whether a color/graphics or monochrome is the display device.
          This function returns the contents of the AL register. A value
          of 7 denotes a monochrome monitor.  [See Norton, p. 184.] /}

VAR

  Reg    : Registers;

begin

  Reg.AH := $0F;
  intr ($10, Reg);
  DisplayMode := Reg.AL;

End; {DisplayMode : byte}


FUNCTION DisplayP : ScrPtrType;

          {This function returns a pointer to the address of the cur-
          rent display memory. It is very useful when doing direct mem-
          ory transfers to the screen since it avoids having to dupli-
          cate the code for the two different types of display. NOTE:
          The compiler will not allow the use of DisplayP^ in a com-
          mand. This is easily circumvented by declaring a holding var-
          iable (say HoldP), and setting HoldP := DisplayP.  HoldP^ can
          then be used in the command.                                }

          {/This routine provides an example of the use of pointers for
          purposes other than managing heap variables.                /}

VAR

  Reg    : Registers;

begin

  Reg.AH := $0F;                       {The function DisplayMode is dupli-  }
  intr ($10, Reg);                     {cated to save execution time.       }
  if  Reg.AL = 7                       {Display mode is returned in AL. For }
    then                               {a monochrome monitor, AL = 7.       }
      DisplayP := Ptr (MonoSeg, $0)
    else
      DisplayP := Ptr (CGSeg, $0);

End; {DisplayP : ScrPtrType}


FUNCTION  ModeCG : Boolean;

         {If color/graphics card is installed changes display to this
         card. Returns false if card not found.                      }

         (*** CAUTION: Some RAM resident utilities (Sidekick V 1.0 is
         one) get confused if displays are switched after they have
         they have been loaded.                                   ***)

VAR

  CGT : integer absolute $B800:$FF0;   {Address within CG buffer.           }
  B   : byte absolute $0:$410;         {Location equipment-list word. See   }
                                       {Norton p. 53.                       }
Begin

  ModeCG := false;
  CGT    := 1234;
  if CGT <> 1234 then
    Exit;                              {No color/graphics board.            }
  B := $2F;
  ModeCG := true;

End; {ModeCG : Boolean}


FUNCTION ModeMono : Boolean;

         {If Monochrome card is installed changes display to this card.
         Returns false if card not found.                             }


VAR

  MT  : integer absolute $B000:$FF0;   {Address within mono buffer.         }
  B   : byte absolute $0:$410;

Begin

  ModeMono := false;
  MT := 1234;
  if MT <> 1234 then                   {No monochrome card.                 }
    Exit;
  B := $3F;
  ModeMono := true;
  TextMode(Lo(LastMode));                            {Necessary for proper functioning of }
                                       {the command, but not clear why.     }
End; {ModeMono : Boolean}

                     (** SCREEN BUFFER TRANSFERS **)

PROCEDURE PrintScreen;

         {This is equivalent to a PrtSc from the keyboard. NOTE: This
         routine may not function properly if the user has not loaded
         a PSC file.                                                 }

         {/This routine provides a good opportunity for demonstrating
         INLINE coding, since it is the most economical way of gener-
         ating a DOS interrupt that does not involve any input or out-
         put.                                                       /}

Begin

  Inline ($CD/$05);                    {INT 05                              }

End; {PrintScreen}


FUNCTION ScreenToFile (FileName : MaxLine) : Boolean;

         {Stores screen display  on disk as the  file 'FileName'.  Re-
         turns 'False' if there is an I/O error.                     }

         {/In TURBO V2 the record length for a Block Read or Write was
         fixed at 128 bytes. In V3 an optional argument was added to
         the ReSet and ReWrite commands allowing for the specification
         of the record size. This feature is not documented in the man-
         ual but is described in the 'ReadMe' file.                 /}

VAR

  HoldP   : ScrPtrType;
  OutFile : File;

Begin

  ScreenToFile := false;
  HoldP := DisplayP;
  Assign (OutFile, FileName);
  {$I-} Rewrite (OutFile, ScrMemSize);
  BlockWrite (OutFile, HoldP^, 1); {$I+}
  if IOresult <> 0 then
    Exit;
  Close (OutFile);
  ScreenToFile := true;

End; {ScreenToFile (FileName : MaxLine) : Boolean}


FUNCTION FileToScreen (FileName : MaxLine) : Boolean;

         {Loads and displays screen stored in 'FileName'. Returns false
         if there is an I/O error.                                   }


VAR

  HoldP   : ScrPtrType;
  InFile  : File;

Begin

  FileToScreen := false;
  HoldP := DisplayP;
  Assign (InFile, FileName);
  {$I-} ReSet (InFile, ScrMemSize);
  BlockRead (InFile, HoldP^, 1); {$I+}
  if IOresult <> 0 then
    Exit;
  Close (InFile);
  FileToScreen := true;

End; {FileToScreen (FileName : MaxLine) : Boolean}


             (** MANIPULATION OF TEXT PAGES ON C/G BOARD **)

         {/The Color/Graphics card contains 16K of memory which is
         fully used when in the graph mode. However, in the text mode
         only 4K is required for the display of one screen of text.
         Hence the memory is divided into 4 'pages' each of which can
         store one screen of text. In Basic there is a built-in com-
         mand 'SCREEN' for manipulating the pages. The following
         series of procedures enable similar operations to be perform-
         ed in TURBO.

         Switching the page being displayed provides a method of in-
         stantaneously (at least as it appears to the eye) rewriting
         the screen. It also has one important advantage over the
         procedures given above that write directly to the display
         memory. With some C/G boards (in particular those supplied by
         IBM) any re-writing of the memory being displayed produces an
         unpleasant 'snow' effect. There are methods of eliminating
         the effect by writing to the memory only during the vertical
         and horizontal retraces when the screen is blanked. However,
         this requires a fairly complex buffering technique and also
         slows down the re-writing. Page switching does not produce
         any snow. (It is somewhat irritating to know that the snow
         problem only exists because of shortcuts in the design. Some
         boards - for example those supplied by Zenith - do not
         exhibit this problem.)

         (* It may be clear that Prof. Hilliard owned a Zenith 151    *)

         As far as I know, it is only possible using the built-in
         commands of TURBO to write to Page 0. I do have procedures
         for writing to any part of RAM, but they need cleaning up.
         But in any case, we need something in reserve for NUTILITY
         V2.

         Obviously these procedures can only be used if C/G board is
         installed. The standard Monochrome board contains only 4K of
         memory and therefore does not allow for paging.            /}


PROCEDURE SwapPage (P1, P2 : integer);

         {This procdedure exchanges the contents of text pages P1 and
         P2 (0 <= P1, P2 <= 3). It also sets the cursors to the correct
         locations in both pages.                                    }

TYPE

  ScreenClass = array[$1..$1000] of byte;

VAR

  CGScrs : array [0..3] of ScreenClass absolute $B800:$0;
  ScrHLD : ScreenClass;
  CurPos : array [0..3] of integer absolute $0000:$0450;
  CurHLD : integer;

Begin

  if (not P1 in [0..3]) or (not P2 in [0..3]) then
    Exit;                              {Input error.                        }

  CurHLD     := CurPos[P1];            {Exchange cursor positions.          }
  CurPos[P1] := CurPos[P2];
  CurPos[P2] := CurHLD;

  Move (CGScrs[P1], ScrHLD,     SizeOf (ScrHLD));
  Move (CGScrs[P2], CGScrs[P1], SizeOf (ScrHLD));
  Move (ScrHLD,     CGScrs[P2], SizeOf (ScrHLD));

End; {SwapPage (P1, P2 : integer)}


PROCEDURE CopyPage (P1, P2 : integer);

         {Copies Page P1 to Page P2. Contents of Page P1 are retained.}

TYPE

  ScreenClass = array[$1..$1000] of byte;

VAR

  CGScrs : array [0..3] of ScreenClass absolute $B800:$0;
  CurPos : array [0..3] of integer     absolute $0000:$0450;

Begin

  if (not P1 in [0..3]) or (not P2 in [0..3]) then
    Exit;

  CurPos[P2] := CurPos[P1];
  Move (CGScrs[P1], CGScrs[P2], SizeOf (CGScrs[P1]));

End; {CopyPage (P1, P2 : integer)}


PROCEDURE CopyBufferToPage (VAR Buffer; P : integer);

         {Copies contents of Buffer to Page P.                       }

TYPE

  ScreenClass = array[$1..$1000] of byte;

VAR

  CGScrs : array [0..3] of ScreenClass absolute $B800:$0;
  Start  : ScreenClass absolute Buffer;

Begin

  Move (Start, CGScrs[P], SizeOf (Start));

End; {CopyBufferToPage (VAR Buffer; P : integer)}


PROCEDURE DisplayPage (P : integer);

         {Uses a call to interrupt $10 to transfer display to Page P}

VAR

  Reg : Registers;

Begin

  if not (P in [0..3]) then
    Exit;
  Reg.AX := $0500 + P;
  Intr ($10, Reg);

End; {DisplayPage (P : integer)}


PROCEDURE ClearPage (P : integer);

         {Loads addresses in Page P with 0's thus clearing the page.
         It is equivalent to: LowVideo; ClrScr; on the display page.
         NOTE: ClrScr clears the page presently been displayed and
         not Page 0 as one might expect.                             }

TYPE

  ScreenClass = array[$1..$1000] of byte;

VAR

  CGScrs : array [0..3] of ScreenClass absolute $B800:$0;
  CurPos : array [0..3] of integer     absolute $0000:$0450;

Begin

  if not P in [0..3] then
    Exit;

  CurPos [P] := 0;
  FillChar (CGScrs[P], SizeOf (CGScrs[P]), 0);

End; {ClearPage (P : integer)}


PROCEDURE PageDemonstration;

         {This provides a demonstration of the use of some of the
         page manipulating routines.                                 }

VAR

  J,  K    : integer;
  ch       : char;

Procedure Message;

begin

  GoToXY (5, 24);
  write ('Enter 0 - 3 to display page or ''Q'' to quit.');

end; {Message}

Begin

  TextMode(Lo(LastMode));
  DisplayPage (1);
  GoToXY (33, 10); write ('Please Stand By');
  CopyPage (0, 3);
  DisplayPage (3);
  for J := 1 to 2 do
    begin
      ClearPage (0);
      for K := 1 to 1600 do
        write (J);
      Message;
      CopyPage (0, J);
    end;
  DisplayPage (1);
  ClearPage (0);
  for K := 1 to 1600 do
    write ('3');
  Message;
  CopyPage (0, 3);
  ClearPage (0);
  for K := 1 to 1600 do
    write ('0');
  Message;

  repeat
    ch := ReadKey;
    J := ord (ch) - 48;
    DisplayPage (J);
  until UpCase (ch) = 'Q';
  TextMode(lo(LastMode));

End; {PageDemonstration}


FUNCTION HeapOK (BytesReqd : LongInt) : Boolean;

          {Returns true if there is 'BytesReqd' contiguous bytes avail-
          able on the heap.                                           }

          {/Before storing a pointer variable on the heap, it is advis-
          able to check that there is sufficient room because, if there
          isn't, the program will crash. TURBO has two functions that
          allow you to determine the space available: MemAvail and
          MaxAvail. The former returns the total free memory including
          that in holes left by the disposal of previous heap variables
          and the latter returns the largest contiguous block avail-
          able. This is the one that is usually relevant unless you are
          certain that the variable will fit in one of the holes. For
          both functions the values are in units of paragraphs (16
          bytes).                                                    /}

(*        Version 4.0 gives the results in bytes, not paragraphs and
          the result is type longint                                 *)

          {/One must always be on guard against integer overflow, and
          this is particularly the case when dealing with memory
          functions and also the BlockRead and BlockWrite commands. (If
          I were to be granted only one wish for TURBO V4 it would be
          for the addition of a four-byte integer or, at least, an
          unsigned integer.)                                         /}
(*        We're sorry that Professor Hilliard was not able to see his
          wish come true                                             *)

VAR

  R1  : LongInt;

Begin

  R1 := MaxAvail;                {If there is more than 512 K of      }
  HeapOK := (BytesReqd + 400 < R1);    {400 safety factor in case stack will}
                                       {added to.                           }

End; {HeapOK (BytesReqd : LongInt) : Boolean}



          (***    Two Examples of the Use of Pointer Variables     ***)
          (***    --------------------------------------------     ***)

          {/There are two different ways of using pointers for storing
          variables on the heap. One is to set up an array of pointers.
          This array is stored in the Data Segment and its size must
          therefore be declared at the time the program is compiled.

          The second is to use what is known as a 'linked list'. Each
          item in the list contains one or more pointers to another
          item. With this arrangement, it is not necessary to prede-
          clare the maximum number of items (although it is still, of
          course, limited by the amount of memory available). Linked
          lists are commonly used in the construction of data bases.

          If your only requirement is to gain additional memory for the
          storage of data, I strongly recommend the first method since
          it requires less coding and is easier to understand. (And, as
          a consequence, less error prone.)

          The following Functions for storing and retrieving screen
          images provide examples of the two methods. TPushPopScr uses
          a table of pointers and LPushPopScr a linked list.         /}


FUNCTION LPushPopScr (ONorOFF : Boolean) : Boolean;

         {The purpose of this function is to store or retrieve text
         displays on or from the heap in a first-in last-out sequence.
         The function acts in two modes depending on the value of:

         ONorOFF = ON
         ------------
              The display on the current monitor (monochrome or color)
         is stored on the heap and the function returns 'TRUE' if there
         is sufficient memory available to store another screen.

         ONorOFF = OFF
         -------------
              The last stored stored screen is transferred from the
         heap to the current monitor and the heap space is recovered.
         The function returns 'FALSE' if the heap is empty.

         This function can be used in conjunction with 'Frame' and
         'Window' to display pull-down menus. (See: PROCEDURE Screen-
         StackDemo.)                                                        }


              {****************** WARNING ******************}

         {It is essential that the two pointers FirstP and LastP which
         are stored in the code segment be intitialized to Nil before
         the function is entered for the first time. This can be done
         either by:

         (A) Recocompiling the source before re-running or saving to
         a COM file, or

         (B) Executing the following routine before exiting the program:

                ***   while LPushPopScr (OFF) do; (*Null*)  ***              }


TYPE

  ScreenRecPtr = ^ScreenRec;

  ScreenRec    = Record
                   Screen : ScrRAMType;
                   PrevP  : ScreenRecPtr;
                 end;

CONST

         {It is necessary to store the pointers FirstP and LastP
         as typed constants so that there values are retained on
         re-entry to the function. The following is a subterfuge
         required because variables of the pointer type cannot be
         formally declared as typed constants.}

  LocFirstP : array [1..2] of integer = (0, 0);  {In effect this initial-   }
  LocLastP  : array [1..2] of integer = (0, 0);  {izes the pointers to Nil. }

VAR

  FirstP : ScreenRecPtr absolute LocFirstP;  {These two pointers will now be  }
  LastP  : ScreenRecPtr absolute LocLastP;   {stored in the code area.        }
  HoldP  : ScreenRecPtr;                     {Temporary so can be local.      }
  P      : ScrPtrType;

Procedure Push;

         {Adds the current screen to the heap.                       }

begin

  if not HeapOK (SizeOf (ScreenRec)) then
    Exit;
  if FirstP = Nil                      {This is the first screen to be      }
    then                               {stored. Special attention needed.   }
      begin
        New (FirstP);
        FirstP^.PrevP := Nil;
        LastP := FirstP;
      end
    else
      begin
        HoldP := LastP;
        New (LastP);
        LastP^.PrevP := HoldP;
      end;

  P := DisplayP;
  LastP^.Screen := P^;
  LPushPopScr := HeapOK (SizeOf (ScreenRec));

end; {Push}

Procedure Pop;

         {Gets first string on the queue and moves up remaining lines.}

begin

  if FirstP = Nil then
    Exit;                              {Nothing to Pop.                     }

  P := DisplayP;
  P^ := LastP^.Screen;
  if LastP^.PrevP = Nil then          {This was the last screen on the heap.}
    begin
      Dispose (FirstP);
      LastP  := Nil;
      FirstP := Nil;
      Exit;
    end;

  HoldP := LastP^.PrevP;
  Dispose (LastP);
  LastP := HoldP;
  LPushPopScr := true;

end; {Pop}


Begin

  LPushPopScr := false;                 {Default return.                     }
  if ONorOFF = ON
    then
      Push
    else
      Pop;

End; {LPushPopScr (ONorOFF : Boolean) : Boolean;}


FUNCTION TPushPopScr (ONorOFF : Boolean) : Boolean;

          {This function is operationally similar to LPushPopScr.     }

          {It is necessary to store the table of pointers either as a
          global variable or as a typed constant so that the table is
          retained on re-entry to the function. We are avoiding the
          use of global variables in these utilities so as to minimize
          the possibility of side efforts. The second method will there-
          fore be used even though it is somewhat clumsy.

          One of the problems is that variables of the pointer type
          cannot be formally declared as typed constants. It is there-
          fore necessay to reserve the space with a 'stand-in' array
          of integers. Setting the integers in this array to zero is
          equivalent to initializing the pointers to nil.            }


CONST

  MaxScrs         = 20;                {Maximum No. of screens to store.    }
  DoubleMaxScrs   = 40;                {Change if MaxScrs is changed.       }
  ScrNumber       : integer = 0;       {Must be retained on re-entry.       }

  HeapScrPStandIn : array [1..DoubleMaxScrs] of integer =

        (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);

VAR

  HeapScrP : array [1..MaxScrs] of ScrPtrType absolute HeapScrPStandIn;
  HoldP    : ScrPtrType;               {Temporary, so can be local.         }

Begin

  TPushPopScr := false;                {Default return.                     }

  if ONorOFF = ON then
    begin
      if (not HeapOK (ScrMemSize)) or (ScrNumber >= MaxScrs) then
        Exit;
      ScrNumber := succ (ScrNumber);
      New (HeapScrP [ScrNumber]);      {Allocate a new heap space.          }
        HoldP := DisplayP;

         {/The following Move procedure is faster than the more obvious:
                        HeapScrP [ScrNumber]^ := HoldP^.                   /}

      Move (HoldP^, HeapScrP [ScrNumber]^, ScrMemSize);
      TPushPopScr := (HeapOK (ScrMemSize) and (ScrNumber < MaxScrs));
    end; {if ONorOFF = ON}

  if ONorOFF = OFF then
    begin
      if ScrNumber = 0 then
        Exit;                                            {Heap is empty.    }
      HoldP := DisplayP;
      Move (HeapScrP [ScrNumber]^, HoldP^, ScrMemSize);
      Dispose (HeapScrP [ScrNumber]);                    {Reclaim space.    }
      ScrNumber := pred (ScrNumber);
      TPushPopScr := (ScrNumber > 0);
    end; {if ONorOFF = OFF}

End; {TPushPopScr (ONorOFF : Boolean) : Boolean}


                   (** MISCELLANEOUS SCREEN ROUTINES **)

PROCEDURE Cursor (ONorOFF : Boolean);

         {Turns screen cursor ON or OFF.                                    }

         {/For a description of the commands to control the cursor size
          see Norton (p. 174).                                        /}

                            (***** CAUTION *****)

         {** Be sure that the cursor is restored before an exit
              from the program as otherwise the user will have
                          to reboot to restore it. **}

VAR

  Reg        : Registers;
  CursorSize : integer;

Begin

  if ONorOFF = OFF
    then
      CursorSize := $2000              {This blanks the cursor on either    }
    else                               {monitor.                            }
      if DisplayMode = 7
        then
          CursorSize := $B0C           {Monochrome monitor.                 }
        else
          CursorSize := $607;          {Color/Graphics monitor.             }

  with Reg do
    begin
      AH := $1;
      CX := CursorSize;
    end;

  intr ($10, Reg);

End; {Cursor (ONorOFF : Boolean)}


PROCEDURE DisplayVideoModes;

         {This displays the 128 possible non-blinking video modes
          available on the IBM PC and compatables.                }

         {/Note the use of the mod and div operators for formatting
         the display.                                            /}

VAR

  X, Y, J   : byte;
  ch        : Char;

Begin

  LowVideo; ClrScr;
  GoToXY (31, 2); NormVideo;
  write (' VIDEO ATTRIBUTES ');
  for J := 0 to 127 do
    begin
      TextColor (J and $F);
      TextBackground (J shr 4);
      X := 2 + 5 * (J mod 16);
      Y := 4 + 2 * (J div 16);
      GoToXY (X, Y); write (J:3, ' ');
    end;
    Ch := ReadKey;


End; {DisplayVideoModes}


PROCEDURE Frame (TX, TY, BX, BY : integer; Form : byte);

          {The input parameters are the coordinates for the top-left
          and bottom-right corners of the frame and are with reference
          to the inside corners. (This is for convenience when using
          the TURBO Window procedure.)  If TY = BY then a single hori-
          zontal line is drawn and if TX = BX a single vertical line.
          Form = 1 uses the -- graph symbol and Form = 2 the === symbol.
          The video modes on entry determine the attributes of the
          boarder.                                                    }

VAR

  J     : integer;
  Line  : string[80];
  LineB : string[80];
  K     : byte;
  HDash, VDash, TLC, TRC, BLC, BRC, TT, BT : char;
  CHold : Boolean;

Begin

{  CHold  := CBreak;                    {Save $C compiler option.            }
{  CBreak := false;                     {For faster display.                 }


  if Form = 1
    then
      begin
        HDash := #196; VDash := #179;
        TLC := #218; TRC := #191; BLC := #192; BRC := #217;
        TT  := #194; BT  := #193;
      end;

  if Form = 2
    then
      begin
        HDash := #205; VDash := #186;
        TLC := #201; TRC := #187; BLC := #200; BRC := #188;
        TT  := #203; BT  := #202;
      end;

  if TX = BX
    then                               {Only single vertical line required. }
      begin
        GoToXY (TX, TY);
        write (TT);
        for J := succ (TY) to pred (BY) do
          begin
            GoToXY (TX, J);
            write (VDash);
          end;
        GoToXY (TX, BY);
        write (BT);
{        CBreak := CHold;               {Restore $C compiler option.         }
        Exit;
      end;

  if (TY <> BY) then                   {Frame required.                     }
    begin
      TX := TX - 1; TY := TY - 1;      {Enlarge frame by one space for      }
      BX := BX + 1; BY := BY + 1;      {compatability with TURBO Window.    }
    end;

  K := BX - TX - 1;
  FillChar (Line[1], K, HDash);        {Fill line with = graph symbol.      }
  Line[0] := chr (K);                  {Set length of line.                 }

  if TY = BY
    then                               {Only single horizontal line required}
      begin
        GoToXY (TX, TY);
        write (HDash + Line + Hdash);
{        CBreak := CHold;               {Restore $C compiler option.         }
        Exit;
      end;

  GoToXY (TX, TY);                      {Top of frame.                       }
  write (TLC + Line + TRC);
  GoToXY (TX, BY);                      {Bottom of frame.                    }
  write (BLC + Line + BRC);
  for J := succ (TY) to pred (BY) do    {Sides of frame.                     }
    begin
      GoToXY (TX, J);
      write (VDash);
      GoToXY (BX, J);
      write (VDash);
    end;

{  CBreak := CHold;                      {Restore $C compiler option.         }

End; {Frame (TX, TY, BX, BY : integer; Form : byte)}


PROCEDURE WindowDemo;

          {The technique for creating windows or pull-down menus is a
          very simple one. The current screen is first saved to another
          part of memory and the screen is then overwritten with the
          window. This can be repeated so as to overlay one window on
          top of another. The only limitation is the amount of memory
          available.                                                  }

          {/For simplicity in this demonstration the whole screen is
          saved. Memory could be conserved by only saving that part of
          the screen which will be overlayed by the window. However,
          this complicates the coding and the assignment of heap space./}

VAR

  ch        : char;
  WNumber   : integer;
  CBHold    : Boolean;
  ONreturn  : Boolean;
  OFFreturn : Boolean;
  TX, TY, BX, BY, Form : byte;

Procedure GetFrameCoordinates;

         {This generates specifications for a random window satisfying
         certain limitations on size and placement.                  }

begin

  TX := 2 + Random (50);
  BX := TX + 10 + Random (68 - TX);
  TY := 2 + Random (17);
  BY := TY + 5 + Random (19 - TY);
  Form := 1 + Random (2);

end; {GetFrameCoordinates}

Begin

{  CBHold := CBreak;                    {Save $C compiler option.            }
{  CBreak := false;                     {For faster display.                 }
  LVid;
  ClrScr;
  Randomize;                           {Initialize random number generator. }
  NVid;
  Frame (10, 8, 70, 18, 1);
  Window (10, 8, 70, 18);
  ClrScr;
  write (' Window #1');
  UVid;
  GoToXY (16, 2);
  Write ('NUtility WINDOW DEMONSTRATION');
  NVid;
  GoToXY (6, 4);
  Write ('Enter text and press ''+'' to store or ''-'' to recover');
  GoToXY (6, 6);
  writeln ('                 previous window.');
  writeln;
  ch := ' ';
  repeat
    write (ch);                        {A CR will not work - but not worth  }
    ch := ReadKey;                    {taking care of.                     }
  until ch = '+';
  WNumber := 1;
  repeat
    if ch = '+'
      then
        begin
          ONreturn := LPushPopScr (ON);
          if ONreturn then             {Space still available.              }
            WNumber  := Succ (WNumber);
          Window (1, 1, 80, 25);
          GetFrameCoordinates;
          Frame (TX, TY, BX, BY, Form);
          Window (TX, TY, BX, BY);
          TextColor (1 + Random (15));
          TextBackground (Random (8));
          ClrScr;
          writeln (' Window #', WNumber);
          if not ONreturn then         {Space not available.                }
            begin
              if not HeapOK (ScrMemSize)
                then
                  writeln ('Heap full.')
                else
                  writeln ('Reached limit');
              writeln ('Cannot save');
              writeln ('this window.');
            end;
          Cursor (ON);
          ch := ' ';
          repeat
            write (ch);
            ch := ReadKey;
          until ch in ['+', '-'];
        end
      else                             {ONorOFF = OFF.                      }
        begin
          Cursor (OFF);
          OFFreturn := LPushPopScr (OFF);
          WNumber := Pred (WNumber);
          repeat
            ch := ReadKey;
          until ch in ['+', '-'];
        end;
  until WNumber = 0;
  Window (1, 1, 80, 25);
{  CBreak := CBHold;                    {Restore $C option.                  }
  Cursor (ON);

End; {WindowDemo}

BEGIN (* Of Initialization of Unit Video *)

  WindowDemo;
  PageDemonstration;
  DisplayVideoModes;

END.