(*----------------------------------------------------------------------*)
(*       PIBSCREN.PAS --- Screen Handling Routines for Turbo Pascal     *)
(*----------------------------------------------------------------------*)
(*                                                                      *)
(*  Author:  Philip R. Burns                                            *)
(*                                                                      *)
(*  Date:    Version 1.0: January, 1985 (Part of PibMenus)              *)
(*           Version 1.1: March, 1985   (Part of PibMenus)              *)
(*           Version 1.2: May, 1985     (Part of PibMenus)              *)
(*           Version 2.0: June, 1985    (Split from PibMenus)           *)
(*                                                                      *)
(*  Systems: For MS-DOS on IBM PCs and close compatibles only.          *)
(*           Note:  I have checked these on Zenith 151s under           *)
(*                  MSDOS 2.1 and IBM PCs under PCDOS 2.0.              *)
(*                                                                      *)
(*  History: These routines provide a simple windowing facility for     *)
(*           Turbo Pascal as well as routines for direct access to the  *)
(*           screen memory area.                                        *)
(*                                                                      *)
(*           The windowing facility provides windows similar to those   *)
(*           implemented in QMODEM by John Friel III.                   *)
(*                                                                      *)
(*           Version 1.0 of these routines formed part of the           *)
(*           PIBMENUS.PAS include file.  These routines were split off  *)
(*           into a separate PIBSCREN.PAS file at version 2.0.          *)
(*                                                                      *)
(*           Thanks to Mike Harrington for an elegant way of finding    *)
(*           the current upper left corner of a window without using    *)
(*           the kludge implemented in version 1.1.                     *)
(*                                                                      *)
(*           Suggestions for improvements or corrections are welcome.   *)
(*           Please leave messages on Gene Plantz's BBS (312) 882 4145  *)
(*           or Ron Fox's BBS (312) 940 6496.                           *)
(*                                                                      *)
(*           If you use this code in your own programs, please be nice  *)
(*           and give all of us credit.                                 *)
(*                                                                      *)
(*----------------------------------------------------------------------*)
(*                                                                      *)
(*  Needs:  These routines need the include files MINMAX.PAS,           *)
(*          GLOBTYPE.PAS, ASCII.PAS, and INT24.PAS. These files are not *)
(*          included here, since Turbo regrettably does not allow       *)
(*          nested includes.                                            *)
(*                                                                      *)
(*----------------------------------------------------------------------*)
(*                                                                      *)
(*    Note that code for stacked windows is available here.  You may    *)
(*    want to modify this to use compile-time window spaces, or remove  *)
(*    the current push-down stack structure.                            *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

(*----------------------------------------------------------------------*)
(*           Constants, Types, and Variables for Screen Access          *)
(*----------------------------------------------------------------------*)

CONST
   Color_Screen_Address   = $B800;   (* Address of color screen          *)
   Mono_Screen_Address    = $B000;   (* Address of mono screen           *)
   Screen_Length          = 4000;    (* 80 x 25 x 2 = screen area length *)
   Max_Saved_Screen       = 5;       (* Maximum no. of saved screens     *)

TYPE
                                     (* A screen image            *)

   Screen_Type       = ARRAY[ 1 .. Screen_Length ] OF BYTE;

   Screen_Ptr        = ^Screen_Image_Type;

   Screen_Image_Type = RECORD
                          Screen_Image: Screen_Type;
                       END;

                                              (* Screen stack entries      *)
   Saved_Screen_Ptr  = ^Saved_Screen_Type;

   Saved_Screen_Type = RECORD
                          Screen_Image  : Screen_Type;
                          Screen_Row    : INTEGER;
                          Screen_Column : INTEGER;
                          Screen_X1     : INTEGER;
                          Screen_Y1     : INTEGER;
                          Screen_X2     : INTEGER;
                          Screen_Y2     : INTEGER;
                       END;

VAR
                                              (* Memory-mapped screen area *)
   Actual_Screen        : Screen_Ptr;
                                              (* Saves screen behind menus *)

   Saved_Screen         : Saved_Screen_Ptr;

                                              (* Stack of saved screens    *)

   Saved_Screen_List    : ARRAY[ 1 .. Max_Saved_Screen ] OF Saved_Screen_Ptr;

(* STRUCTURED *) CONST
                                              (* Depth of saved screen stack *)
   Current_Saved_Screen : 0 .. Max_Saved_Screen = 0;

(*----------------------------------------------------------------------*)
(*    Color_Screen_Active --- Determine if color or mono screen         *)
(*----------------------------------------------------------------------*)

FUNCTION Color_Screen_Active : BOOLEAN;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Color_Screen_Active                                  *)
(*                                                                      *)
(*     Purpose:    Determines if color or mono screen active            *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Color_Active := Color_Screen_Active : BOOLEAN;                *)
(*                                                                      *)
(*           Color_Active --- set to TRUE if the color screen is        *)
(*                            active, FALSE if the mono screen is       *)
(*                            active.                                   *)
(*                                                                      *)
(*     Calls:   INTR                                                    *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Regs : RegPack;

BEGIN  (* Color_Screen_Active *)

   Regs.Ax := 15 SHL 8;

   INTR( $10 , Regs );

   Color_Screen_Active := ( Regs.Al <> 7 );

End    (* Color_Screen_Active *);

(*----------------------------------------------------------------------*)
(*     Current_Video_Mode --- Determine current video mode setting      *)
(*----------------------------------------------------------------------*)

FUNCTION Current_Video_Mode: INTEGER;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Current_Video_Mode                                   *)
(*                                                                      *)
(*     Purpose:    Gets current video mode setting from system          *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Current_Mode := Current_Video_Mode : INTEGER;                 *)
(*                                                                      *)
(*           Current_Mode --- set to integer representing current       *)
(*                            video mode inherited from system.         *)
(*                                                                      *)
(*     Calls:   INTR                                                    *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Regs : RegPack;

BEGIN  (* Current_Video_Mode *)

   Regs.Ax := 15 SHL 8;

   INTR( $10 , Regs );

   Current_Video_Mode := Regs.Al;

End    (* Current_Video_Mode *);

(*----------------------------------------------------------------------*)
(*        Get_Screen_Address --- Get address of current screen          *)
(*----------------------------------------------------------------------*)

PROCEDURE Get_Screen_Address( VAR Actual_Screen : Screen_Ptr );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Get_Screen_Address                                   *)
(*                                                                      *)
(*     Purpose:    Gets screen address for current type of display      *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Get_Screen_Address( Var Actual_Screen : Screen_Ptr );         *)
(*                                                                      *)
(*           Actual_Screen --- pointer whose value receives the         *)
(*                             current screen address.                  *)
(*                                                                      *)
(*     Calls:   Color_Screen_Active                                     *)
(*              PTR                                                     *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN  (* Get_Screen_Address *)

   IF Color_Screen_Active THEN
      Actual_Screen := PTR( Color_Screen_Address , 0 )
   ELSE
      Actual_Screen := PTR( Mono_Screen_Address , 0 );

END    (* Get_Screen_Address *);

(*----------------------------------------------------------------------*)
(*                Video Display Control Routines                        *)
(*----------------------------------------------------------------------*)
(*                                                                      *)
(*       RvsVideoOn  --- Turn On Reverse Video                          *)
(*       RvsVideoOff --- Turn Off Reverse Video                         *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

PROCEDURE RvsVideoOn( Foreground_Color, Background_Color : INTEGER );

BEGIN (* RvsVideoOn *)

   TextColor     ( Background_color );
   TextBackGround( Foreground_color );

END   (* RvsVideoOn *);

(*----------------------------------------------------------------------*)

PROCEDURE RvsVideoOff( Foreground_Color, Background_Color : INTEGER );

BEGIN (* RvsVideoOff *)

   TextColor     ( Foreground_color );
   TextBackGround( Background_color );

END   (* RvsVideoOff *);


(*----------------------------------------------------------------------*)
(*                TURBO Pascal Window Location Routines                 *)
(*----------------------------------------------------------------------*)
(*                                                                      *)
(*  These routines and constants give the four corners of the current   *)
(*  Turbo window:                                                       *)
(*                                                                      *)
(*    Lower right-hand corner: (Lower_Right_Column, Lower_Right_Row)    *)
(*    Upper left_hand corner:  Upper_Left( Column, Row )                *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

                                   (* Lower right corner of     *)
                                   (* current TURBO window      *)
VAR
   Lower_Right_Column  : Byte ABSOLUTE Cseg:$016A;
   Lower_Right_Row     : Byte ABSOLUTE Cseg:$016B;

(*----------------------------------------------------------------------*)
(*            Upper_Left ---  Upper Positions of current window         *)
(*----------------------------------------------------------------------*)

PROCEDURE Upper_Left( VAR X1, Y1 : INTEGER );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:   Upper_Left                                          *)
(*                                                                      *)
(*     Purpose:    Returns upper positions of current TURBO window      *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Upper_Left( VAR X1, Y1 : INTEGER );                           *)
(*                                                                      *)
(*           X1   --- returned upper left column                        *)
(*           Y1   --- returned upper left row                           *)
(*                                                                      *)
(*     Calls:   INTR                                                    *)
(*              WhereX                                                  *)
(*              WhereY                                                  *)
(*              GoToXY                                                  *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
    TempX  : INTEGER;
    TempY  : INTEGER;
    Reg    : RegPack;

BEGIN  (* Upper_Left *)

    TempX := WhereX;           (* Save Current Cursor Pos. *)
    TempY := WhereY;

    GoToXY( 1 , 1 );           (* Goto Upper Left corner of window *)

    Reg.Ax := $0300;           (* Set up reg's for INTR *)
    Reg.Bx := 0;

    INTR( $10 , Reg );         (* Call BIOS Read Cursor Position *)

    Y1 := Reg.Dh + 1;          (* get Row *)
    X1 := Reg.Dl + 1;          (* get Column *)

    GoToXY( TempX , TempY );   (* Return to orig. position *)

END    (* Upper_Left *);


(*----------------------------------------------------------------------*)
(*                Set/Reset Text Color Routines                         *)
(*----------------------------------------------------------------------*)
(*                                                                      *)
(*   These routines set and reset the global text foreground and        *)
(*   background colors.                                                 *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

                   (* Global Text Color Variables *)

VAR
   Global_ForeGround_Color : INTEGER;
   Global_BackGround_Color : INTEGER;

(*----------------------------------------------------------------------*)
(*    Set_Global_Colors --- Reset global foreground, background cols.   *)
(*----------------------------------------------------------------------*)

PROCEDURE Set_Global_Colors( ForeGround, BackGround : INTEGER );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Set_Global_Colors                                    *)
(*                                                                      *)
(*     Purpose:    Sets global text foreground, background colors.      *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Set_Global_Colors( ForeGround, BackGround : INTEGER );        *)
(*                                                                      *)
(*           ForeGround --- Default foreground color                    *)
(*           BackGround --- Default background color                    *)
(*                                                                      *)
(*     Calls:   TextColor                                               *)
(*              TextBackGround                                          *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN  (* Set_Global_Colors *)

   Global_ForeGround_Color := ForeGround;
   GLobal_BackGround_Color := BackGround;

   TextColor     ( Global_ForeGround_Color );
   TextBackground( Global_BackGround_Color );

END    (* Set_Global_Colors *);

(*----------------------------------------------------------------------*)
(*  Reset_Global_Colors --- Reset global foreground, background cols.   *)
(*----------------------------------------------------------------------*)

PROCEDURE Reset_Global_Colors;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Reset_Global_Colors                                  *)
(*                                                                      *)
(*     Purpose:    Resets text foreground, background colors to global  *)
(*                 defaults.                                            *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Reset_Global_Colors;                                          *)
(*                                                                      *)
(*     Calls:   TextColor                                               *)
(*              TextBackGround                                          *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN  (* Reset_Global_Colors *)

   TextColor     ( Global_ForeGround_Color );
   TextBackground( Global_BackGround_Color );

END    (* Reset_Global_Colors *);

(*----------------------------------------------------------------------*)
(*                 Screen Manipulation Routines                         *)
(*----------------------------------------------------------------------*)
(*                                                                      *)
(*   These routines save and restore screen images in support of the    *)
(*   windowing facility.  Also, the current screen image can be printed *)
(*   and text extracted from the screen memory.                         *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

(*----------------------------------------------------------------------*)
(*       Get_Screen_Text_Line --- Extract text from screen image        *)
(*----------------------------------------------------------------------*)

PROCEDURE Get_Screen_Text_Line( VAR Text_Line     : AnyStr;
                                    Screen_Line   : INTEGER;
                                    Screen_Column : INTEGER );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Get_Screen_Text_Line                                 *)
(*                                                                      *)
(*     Purpose:    Extracts text from current screen image              *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*       Get_Screen_Text_Line( Var  Text_Line     : AnyStr;             *)
(*                                  Screen_Line   : INTEGER;            *)
(*                                  Screen_Column : INTEGER );          *)
(*                                                                      *)
(*           Text_Line        --- receives text extracted from screen   *)
(*           Screen_Line      --- line on screen to extract             *)
(*           Screen_Column    --- starting column to extract            *)
(*                                                                      *)
(*     Calls:   None                                                    *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*        Only the text -- not attributes -- from the screen is         *)
(*        returned.                                                     *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   First_Pos  : INTEGER;
   Last_Pos   : INTEGER;
   I          : INTEGER;

BEGIN  (* Get_Screen_Text_Line *)

   Screen_Line   := Max( Min( Screen_Line   , 25 ) , 1 );
   Screen_Column := Max( Min( Screen_Column , 80 ) , 1 );

   Text_Line     := '';
   First_Pos     := ( ( Screen_Line - 1 ) * 80 + Screen_Column ) * 2 - 1;
   Last_Pos      := First_Pos + ( 80 - Screen_Column ) * 2 + 1;

   REPEAT
      Text_Line := Text_Line + CHR( Actual_Screen^.Screen_Image[ First_Pos ] );
      First_Pos := First_Pos + 2;
   UNTIL ( First_Pos > Last_Pos );

END    (* Get_Screen_Text_Line *);

(*----------------------------------------------------------------------*)
(*                Print_Screen --- Print current screen image           *)
(*----------------------------------------------------------------------*)

PROCEDURE Print_Screen;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Print_Screen                                         *)
(*                                                                      *)
(*     Purpose:    Prints current screen image (memory mapped area)     *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Print_Screen;                                                 *)
(*                                                                      *)
(*     Calls:   None                                                    *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*        Only the text from the screen is printed, not the attributes. *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   I         : INTEGER;
   Text_Line : STRING[80];

BEGIN  (* Print_Screen *)

   FOR I := 1 TO 25 DO
      BEGIN
         Get_Screen_Text_Line( Text_Line, I, 1 );
         WRITELN( Lst , Text_Line );
      END;

END    (* Print_Screen *);

(*----------------------------------------------------------------------*)
(*        Write_Screen --- Write current screen image to file           *)
(*----------------------------------------------------------------------*)

PROCEDURE Write_Screen( Fname : AnyStr );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Write_Screen                                         *)
(*                                                                      *)
(*     Purpose:    Write current screen image (memory mapped area) to   *)
(*                 a file.                                              *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Write_Screen( Fname : AnyStr );                               *)
(*                                                                      *)
(*           Fname --- Name of file to write screen to                  *)
(*                                                                      *)
(*     Calls:   None                                                    *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*        Only the text from the screen is written, not the attributes. *)
(*        If the file already exists, then the new screen is appended   *)
(*        to the end of the file.                                       *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   I         : INTEGER;
   Text_Line : STRING[80];
   F         : TEXT [512];

BEGIN  (* Write_Screen *)

      (*$I-*)
   ASSIGN( F , Fname );
   RESET ( F );

   IF Int24Result = 0 THEN
      BEGIN
         CLOSE( F );
         APPEND( F );
      END
   ELSE
      BEGIN
         CLOSE  ( F );
         REWRITE( F );
      END;

   FOR I := 1 TO 25 DO
      BEGIN
         Get_Screen_Text_Line( Text_Line, I, 1 );
         WRITELN( F , Text_Line );
      END;

   CLOSE( F );
     (*$I+*)

END    (* Write_Screen *);

(*----------------------------------------------------------------------*)
(*                WriteSLin --- Write text string to screen             *)
(*----------------------------------------------------------------------*)

PROCEDURE WriteSLin( S: AnyStr; Color: INTEGER );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  WriteSLin                                            *)
(*                                                                      *)
(*     Purpose:    Writes text string to current line in screen memory  *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        WriteSLin( S: AnyStr; Color: INTEGER );                       *)
(*                                                                      *)
(*           S      --- String to be written                            *)
(*           Color  --- Color in which to write string                  *)
(*                                                                      *)
(*     Calls:   None                                                    *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Length_S : INTEGER;
   S_Column : INTEGER;
   S_Row    : INTEGER;
   I        : INTEGER;

BEGIN (* WriteSLin *)

   Length_S := LENGTH( S );

   S_Column := 1;
   S_Row    := ( WhereY - 1 ) * 160;

   FOR I := 1 TO Length_S DO
      WITH Actual_Screen^ DO
         BEGIN
            Screen_Image[ S_Column + S_Row ]     := ORD( COPY( S, I, 1 ) );
            Screen_Image[ S_Column + S_Row + 1 ] := Color;
            S_Column := S_Column + 2;
         END;

   S_Row := S_Row + 160;

   IF S_Row > 3800 THEN
      InsLine;

END   (* WriteSLin *);

(*----------------------------------------------------------------------*)
(*          WriteSXY --- Write text string to specified row/column      *)
(*----------------------------------------------------------------------*)

PROCEDURE WriteSXY( S: AnyStr; X: INTEGER; Y: INTEGER; Color: INTEGER );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  WriteSXY                                             *)
(*                                                                      *)
(*     Purpose:    Writes text string at specified row and column       *)
(*                 position on screen.                                  *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        WriteSXY( S: AnyStr; X: INTEGER; Y: INTEGER; Color: INTEGER );*)
(*                                                                      *)
(*           S      --- String to be written                            *)
(*           X      --- Column position to write string                 *)
(*           Y      --- Column position to write string                 *)
(*           Color  --- Color in which to write string                  *)
(*                                                                      *)
(*     Calls:   None                                                    *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Length_S : INTEGER;
   S_Column : INTEGER;
   S_Row    : INTEGER;
   I        : INTEGER;
   S_Pos    : INTEGER;

BEGIN (* WriteSXY *)

   Length_S := LENGTH( S );
   S_Pos    := 0;

   FOR I := 1 TO Length_S DO
      WITH Actual_Screen^ DO
         IF S_Pos < 4001 THEN
            BEGIN
               S_Pos                     := ( ( Y - 1 ) * 80 + X ) * 2 - 1;
               Screen_Image[ S_Pos     ] := ORD( COPY( S, I, 1 ) );
               Screen_Image[ S_Pos + 1 ] := Color;
               X                         := X + 1;
            END;

END   (* WriteSXY *);

(*----------------------------------------------------------------------*)
(*   WriteCXY --- Write character to screen  at specified row/column    *)
(*----------------------------------------------------------------------*)

PROCEDURE WriteCXY( C: CHAR; X: INTEGER; Y: INTEGER; Color: INTEGER );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  WriteCXY                                             *)
(*                                                                      *)
(*     Purpose:    Writes a character at specified row and column       *)
(*                 position on screen.                                  *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        WriteCXY( C: CHAR; X: INTEGER; Y: INTEGER; Color: INTEGER );  *)
(*                                                                      *)
(*           C      --- Character to be written                         *)
(*           X      --- Column position to write string                 *)
(*           Y      --- Column position to write string                 *)
(*           Color  --- Color in which to write string                  *)
(*                                                                      *)
(*     Calls:   None                                                    *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   S_Pos : INTEGER;

BEGIN (* WriteCXY *)

   WITH Actual_Screen^ DO
      BEGIN
         S_Pos                     := ( ( Y - 1 ) * 80 + X ) * 2 - 1;
         Screen_Image[ S_Pos     ] := ORD( C );
         Screen_Image[ S_Pos + 1 ] := Color;
      END;

END   (* WriteCXY *);

(*----------------------------------------------------------------------*)
(*                Save_Screen --- Save current screen image             *)
(*----------------------------------------------------------------------*)

PROCEDURE Save_Screen( VAR Saved_Screen_Pointer : Saved_Screen_Ptr );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Save_Screen                                          *)
(*                                                                      *)
(*     Purpose:    Saves current screen image (memory mapped area)      *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Save_Screen( Var Saved_Screen_Pointer : Saved_Screen_Ptr );   *)
(*                                                                      *)
(*           Saved_Screen_Pointer  --- pointer to record receiving      *)
(*                                     screen image, window location,   *)
(*                                     and current cursor location.     *)
(*                                                                      *)
(*     Calls:   Move                                                    *)
(*              Upper_Left                                              *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*        This version checks for stack overflow.                       *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN  (* Save_Screen *)
                                   (* Overwrite last screen if no room *)

   IF Current_Saved_Screen >= Max_Saved_Screen THEN
      Saved_Screen_Pointer := Saved_Screen_List[ Max_Saved_Screen ]
   ELSE
      BEGIN
         Current_Saved_Screen := Current_Saved_Screen + 1;
         NEW( Saved_Screen_Pointer );
         Saved_Screen_List[ Current_Saved_Screen ] := Saved_Screen_Pointer;
      END;

   WITH Saved_Screen_Pointer^ DO
      BEGIN

         Upper_Left( Screen_X1, Screen_Y1 );

         Screen_X2     := Lower_Right_Column;
         Screen_Y2     := Lower_Right_Row;

         Screen_Row    := WhereY;
         Screen_Column := WhereX;

         MOVE( Actual_Screen^.Screen_Image, Screen_Image, Screen_Length );

      END;

END   (* Save_Screen *);

(*----------------------------------------------------------------------*)
(*              Restore_Screen --- Restore saved screen image           *)
(*----------------------------------------------------------------------*)

PROCEDURE Restore_Screen( VAR Saved_Screen_Pointer : Saved_Screen_Ptr );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Restore_Screen                                       *)
(*                                                                      *)
(*     Purpose:    Restores previously saved screen image.              *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Restore_Screen( Var Saved_Screen_Pointer: Saved_Screen_Ptr ); *)
(*                                                                      *)
(*           Saved_Screen_Pointer  --- pointer to record with saved     *)
(*                                     screen image, window location,   *)
(*                                     and cursor location.             *)
(*                                                                      *)
(*     Calls:   Window                                                  *)
(*              Move                                                    *)
(*              GoToXY                                                  *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*        All saved screen pointers from the last saved down to the     *)
(*        argument pointer are popped from the saved screen list.       *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN  (* Restore_Screen *)

   WITH Saved_Screen_Pointer^ DO
      BEGIN

         Window( Screen_X1, Screen_Y1, Screen_X2, Screen_Y2 );

         MOVE( Screen_Image, Actual_Screen^.Screen_Image, Screen_Length );

         GoToXY( Screen_Column, Screen_Row );

      END;

   WHILE( Saved_Screen_List[ Current_Saved_Screen ] <> Saved_Screen_Pointer ) DO
      BEGIN
         DISPOSE( Saved_Screen_List[ Current_Saved_Screen ] );
         Current_Saved_Screen := Current_Saved_Screen - 1;
      END;

   IF Current_Saved_Screen > 0 THEN
      Current_Saved_Screen := Current_Saved_Screen - 1;

   DISPOSE( Saved_Screen_Pointer );

   Saved_Screen_Pointer := NIL;

END    (* Restore_Screen *);