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

Pascal/Delphi Source File | 1992-06-23 | 40.7 KB | 982 lines

{$C-}
{-----------------------------------------------------------------------------}
{                                                                             }
{                                                                             }
{                                                                             }
{         "  S o r r y ,  D a v e,   I   C a n ' t   D o   T h a t .  "       }
{                                                                             }
{                                                                             }
{                                                          Arthur C. Clark    }
{                                                           " 2 0 0 1 "       }
{-----------------------------------------------------------------------------}

{  A  Turbo  "stay-resident" program clobbers the Dos register stack.  It
  jumps over the Turbo run-time initialization code that would set up the
  program registers  and environment.   Secondly,  a  stay-resident  program
  could not ordinarily issue file I/O since that would clobber Dos interrupt
  registers.  Therefore,  the following code proposes an inline solution,
  providing a Turbo entry  stack  for  "stay-resident"  programs  and allowing
  those programs to issue Dos I/O and other interrupts.

   This Turbo stay-resident demo has been put together to perform both Dos I/O
   and Bios interrupts. It has also been tested for re-entrancy and
   recursiveness on an IBM PC with PCDos .

    Separate the include files, compile to a COM file and execute with the
    Alt-F10 key. It will also free its memory and return to Dos with the
    Ctrl-Home key at the "Press a key" prompt. (Illustrated in the Stayxit
    file). Maximum free dynamic memory should be between A40-B00 since this
    demo uses a recursive stack.

                                                 The Hunters Helper

                                                  L.Ferris
                                                  4268 26th St
                                                  San Francisco,Ca. 94131
                                                  [ 70357,2716 ]      }
{-----------------------------------------------------------------------------}
{     This code has been tested/used on an IBM PC using PC-DOS 2.10           }
{-----------------------------------------------------------------------------}


{ Authors: Lane H. Ferris (Stay Resident Code)
           Neil J. Rubenking (Directory code and ideas)
           Jim Everingham (The Window Manager/Editor)
           Other Public Gurus on whose shoulders we stand.

{ PURPOSE:  This code will serve as a template to create other "Stay  Resident"
            programs  in  Turbo  Pascal(tm).   This  code  intercepts  Int  16,
            displacing original Interrupt  16  Vector  to  User  Interrupt  68.
            During  execution  of  other  programs,  it  can  be invoked by the
            special key combination  specified  by  "Our_Char"  (in  this  case
            <Alt>-F10.)
}

Program Stay_Resident;

  { * * * * * * * CONSTANTS * * * * * * * * * * * * * * * * * * * * * * }
  const
    Our_Char        =  113; {this is the scan code for AltF10}
    Ctrl_Home       = #119; {Control Home Scan Code          }
    Quit_Key        = #119;
    Ctrl_End        = #117; {Control End Scan Code           }
    User_Int        = $68; {place to put new interrupt}
    Kybrd_Int       = $16; {BIOS keyboard interrupt}

  { - - - - - - - T Y P E    D E C L A R A T I O N S - - - - - - - - - - - -  }
  Type
    Regtype     = record Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Flags:integer  end;
    HalfRegtype = record Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh:byte              end;
    filename_type = string[64];

  { - - - - - - - T Y P E D   C O N S T A N T S - - - - - - - - - - - - - - -}
  Const
    {regs is defined as a typed constant in order to get it in the code segment}
    Regs   : regtype = (Ax:0;Bx:0;Cx:0;Dx:0;Bp:0;Si:0;Di:0;Ds:0;Es:0;Flags:0);

      OurDseg: integer = 0;            {Our Data Segment Value             }
      OurSseg: integer = 0;            {Our Stack Segment Value            }
      DosSseg: integer = 0;            {Dos Stack Segment Value            }
      Inuse  : Boolean = false;        {Recursion flag                     }

 { - - - - - - - V A R I A B L E S - - - - - - - - - - - - - - - - - - - - - -}
    Var
      SaveRegs                      : regtype;
      HalfRegs                      : halfregtype absolute regs;
      Terminate_flag                : boolean ;
      Keychr                        : char ;
      Old_Xpos,Old_Ypos             : integer ;
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
{  Check Terminate Keys
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
Procedure Chk_Term_Key;
{$I StayXit.Inc}                   {Check for Exit to Dos                     }
{-----------------------------------------------------------------------------}
{            G  E  T  F  I  L  E                                              }
{-----------------------------------------------------------------------------}

procedure get_file;
{$I staysubs.inc}
var
  attribyte,
  OldAttribute : byte;
  Xcursor      : integer ;
  Ycursor      : integer ;
{----------------------------------------------------------------------------}
begin

      filename := '*.*' ;
      attribyte := 255 ;
      OldAttribute := attribyte;

              Xcursor := 2 ;
              Ycursor := 1 ;
              GotoXy(Xcursor,Ycursor) ;

          Find_First(attribyte,filename,Retcode);
              If Retcode = 0 then
                 begin
                 write(Filename);
                 Ycursor := Ycursor +1 ;
                 end;
          {Now we repeat Find_Next until an error occurs }

              repeat
                Find_Next(attribyte,filename,Retcode);
                if Retcode = 0 then
                 begin
                        GotoXY(Xcursor,Ycursor);
                        Write(filename) ;
                        Ycursor := Ycursor + 1 ;

                        if WhereY >= 14 then
                        begin
                        Xcursor := Xcursor + 16 ;
                        Ycursor := 1 ;
                        end;

                        if (Xcursor >= 50) and (Ycursor = 13 ) then
                        begin
                        Ycursor := Ycursor + 1;
                        GotoXY(Xcursor,Ycursor);
                        Write ('More...');
                        read ;
                        clrscr ;
                        Xcursor := 2 ;
                        Ycursor := 1 ;
                        end;
                 end;
               until Retcode <> 0;

               GotoXY(Xcursor,Ycursor); Write('Press a key . . .');
               repeat until keypressed ;
               Chk_Term_Key ;          { See if Return to Dos }
end;

{-----------------------------------------------------------------------------}
{        D   E  M  O                                                          }
{-----------------------------------------------------------------------------}
Procedure Demo ;                   { Give Demonstration of Code               }

{$I WINDMNGR.INC}

begin

     Add_Window(5,5,75,20,11,0,2);

     Get_file;

     Remove(1);

end; { Demo }


{----------------------------------------------------------------------------}
{              P R O C E S S   I N T E R R U P T                             }
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
Procedure Process_Intr;

{  PURPOSE:  This  procedure  replaces  the  standard  keyboard  interrupt.  If
            anything but <Alt>-F10 is pressed,  the key is  passed  on  to  the
            standard  keyboard  interrupt.  B*U*T  when  <Alt>- F10 is pressed,
            this program takes over.  The variable InUse  is  set  to  TRUE  to
            ensure that this code doesn't try to run "on top of itself " AND to
            indicate  to the Inline code to save/restore the original interrupt
            regs.
}

Begin
          { K e y b o a r d    Interrupt   o c c u r s   here }
{----------------------------------------------------------------------}
{$I Staysave.inc}
{----------------------------------------------------------------------}
{ Check the Int 16 request function in Ah reg:
                   0 = read character from Keyboard
                   1 = check character available
                   2 = check shift key values
}
if HalfRegs.Ah <> 0 then  {if this is not character request...}
   Begin
   Intr(User_Int,Regs)    { just pass it on to standard interrupt }
   End

Else      { HalfRegs.Ah = 0 then    { This is a Character Request }
  Begin   {Get Keyboard Char }

  Intr (User_Int, Regs);             { Use the standard interrupt}

  if (Halfregs.Ah = Our_Char)        { Separate the test so code }
                                     { performs efficiently      }
     then if  (not InUse) then

     begin { Demo }
     InUse := true;                  { "dont clobber saved stack"}
{            .
             .
             .  Your
             .      Program
             .             Goes
             .                 Here
             .
}                                    { Get current Cursor Position    }
     Old_Xpos := WhereX; Old_Ypos := WhereY;
     Demo ;
     GotoXY(Old_Xpos,Old_Ypos);       { Put Cursor Back                }
     Regs.Ax := Ord(KeyChr) shl 8 ;        {Give back Last entered char     }
     InUse := false;                  { ok to restore interrupted stack }
     end  { Demo }

  end; {Get Keyboard Char }

{$I Stayrstr.inc}                      { Return to Caller }
end ;
{-----------------------------------------------------------------------}

{The main program installs the new interrupt routine and makes it permanently
 resident as the keyboard interrupt.  The old keyboard interrupt is addressed
 through #68H, so it can still be used.

The following dos calls are used:

 Function 25 - Install interrupt address
               input al = int number,
               ds:dx = address to install

 Function 35 - get interrupt address
               input al = int number
               output es:bx = address in interrupt

 Function 31 - terminate and stay resident
               input dx = size of resident program obtained from the memory
               allocation block at [Cs:0 - $10 + 3]

 Function 49 - Free Allocated Memory
               input Es = Block Segment to free

 Interrupt 20 - Return to invoking process
}

{-----------M A I N    B L O C K---------------------------------------------}
Begin                                  {**main**}

  InUse  := false;
  OurDseg:= Dseg;       { Save the Data Segment Address for Interrupts }
  OurSseg:= Sseg;       { Save our Stack Segment for Interrupts        }

  Terminate_Flag := false ;

  {now install the interrupt routine}

  SaveRegs.Ax := $35 shl 8 + User_Int;
  Intr($21,SaveRegs);                 {Check to make sure int not already used}

  if SaveRegs.Es <> $00 then
    WriteLn ('Interrupt in use -- can''t install Resident Turbo Code')
  else
    begin

      { Initialize Your Progam Here since you wont get control again
        until "Our_Char" is entered from the Keyboard.               }

      SaveRegs.Ax := $35 shl 8 + Kybrd_Int;
      Intr($21,SaveRegs);        {get the address of keyboard interrupt }

      SaveRegs.Ax := $25 shl 8 + User_Int;
      SaveRegs.Ds := SaveRegs.Es;
      SaveRegs.Dx := SaveRegs.Bx;
      Intr($21,SaveRegs);         { set the user-interrupt address to point
                                { to the keyboard interrupt address }

      SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
      SaveRegs.Ds := Cseg;
      SaveRegs.Dx := Ofs(Process_Intr);
      Intr ($21,SaveRegs);        { set the keyboard interrupt to point to
                                  "Process-Intr" above}

      Writeln('  Turbo Stay-Resident Demo: Press Alt-F10');

      {now terminate and stay resident}
                                              { Pass return code of zero    }
      SaveRegs.Ax := $31 shl 8 + 0 ;          { Terminate and Stay Resident }
      SaveRegs.Dx := MemW [Cseg-1:0003] ;     { Prog_Size from Allocation Blk}
      Intr ($21,SaveRegs);

    end;
       { END OF RESIDENCY CODE }
end.
{****************************************************************************}
{                 S  T  A  Y  S  A  V  E  .  I  N  C                         }
{                                                                            }
{           This is the Staysave.Inc file included above                     }
{                                                                            }
{      Separate the code out into a file or replace the $I Staysave.Inc      }
{                statement above with this code.                             }
{****************************************************************************}

{This Inline routine will save the regs and Stack for Stay resident programs.
 It restores Ds and Ss from the previously saved integer constants "OurDseg"
  and "OurSSeg". This is important since Dos is not re-entrant and any attempt
  to use Interrupt I/O services will clobber the very stack on which the
  Resident Turbo program just saved its regs. Thus, on the final return, you
  and Toto will end up somewhere other than Kansas and without your Ruby Reds.
   }

{ Arthor:      L.H. Ferris

       Distributed to the Public Domain for use without profit.
                    Original Version 5.15.85
}
                                   { On entry the Stack will already contain: }
                                   {  1) Sp for Dos                           }
                                   {  2) Bp for Dos                           }
                                   {  3) Ip for Dos                           }
                                   {  4) Cs for Dos                           }
  Inline (                         {  5) Flags for Dos                        }



    $FA /                              {  Cli       Stop all interrupts       }

                                       { Bp and Sp aready saved at Begin Stmt }
    $55/                               {Push   Bp  Save again for Regpak      }
    $BD/Regs/                          {Mov    Bp,offset REGS}
    $2E/$89/$46/$00/                   {CS:Mov [Bp+0],AX}
    $2E/$89/$5E/$02/                   {Cs:Mov [Bp+2],Bx}
    $2E/$89/$4E/$04/                   {CS:Mov [Bp+4],CX}
    $2E/$89/$56/$06/                   {CS:Mov [Bp+6],DX}
    $2E/$8F/$46/$08/                   {Pop    Cs:[Bp+8] Fetch Bp from stack  }
    $2E/$89/$76/$0A/                   {CS:Mov [Bp+A],SI}
    $2E/$89/$7E/$0C/                   {CS:Mov [Bp+C],DI}
    $2E/$8C/$5E/$0E/                   {CS:Mov [Bp+E],DS}
    $2E/$8C/$46/$10/                   {CS:Mov [Bp+10],ES}
    $9C/                               {PUSHF  put Flags on stack to retrieve }
    $2E/$8F/$46/$12/                   {POP Cs:[Bp+12]}

    { If Current SS := [OurSseg] or Inuse = True, then dont save the stack. }
    { This program is being recursive.                                      }

     $2E/$80/$3E/Inuse/$01/   {Cmp  Cs:[Inuse],1                          }
     $74/$4D/                 {Je   ReCurin ------J-U-M-P---------------  }

    { Now save 5 Words from the Dos Stack before performing any         }
    { I/O or re-using the Dos stack                                     }

     $2E/$8C/$16/DosSSeg/     {Mov  Cs:DosSSeg,SS Save Dos Stack Segment    }
     $8C/$D6/                 {Mov  Si,SS         If this is our Stack Seg  }
     $8E/$C6/                 {Mov  Es,Si         Get Dos StackSeg          }
     $2E/$8E/$16/OurSSeg/     {Mov  SS,Cs:OurSSeg Get our Stack segment     }
     $2E/$8E/$1E/OurDseg/     {Mov  Ds,Cs:Our_Ds  Setup our Data Segment    }


     $2E/$3B/$36/OurSSeg/     {Cmp  Si,Cs:OurSSeg ..use current Stack ptr   }
     $89/$E6/                 {Mov  Si,Sp         ..value..else reset stack }
     $74/$05/                 {Je   $+5           ..to original Turbo stack }
     $3E/$8B/$36/$74/$01/     {Mov  Si,Ds:[174]   ..(cf. code at B2B 3.0x)  }

     $87/$F4/                 {Xchg Sp,Si         Set new  Stack Pointer    }

     $2E/$FF/$76/$00/         {Push [Bp+0]  Save Dos/User regs for Exit     }
     $2E/$FF/$76/$02/         {Push [Bp+2]  Save Bx                         }
     $2E/$FF/$76/$04/         {Push [Bp+4]  Save Cx                         }
     $2E/$FF/$76/$06/         {Push [Bp+6]  Save Dx                         }
                              {Push [Bp+8]  Save Bp                         }
     $2E/$FF/$76/$0A/         {Push [Bp+A]  Save Si                         }
     $2E/$FF/$76/$0C/         {Push [Bp+C]  Save Di                         }
     $2E/$FF/$76/$0E/         {Push [Bp+E]  Save Ds                         }
     $2E/$FF/$76/$10/         {Push [Bp+10] Save Es                         }


     $2E/$8E/$16/OurSSeg/     {Mov  SS,Cs:OurSSeg Set up our Stack          }
     $56/                     {Push Si            Save bottom of Dos Stack  }
     $2E/$8C/$5E/$0E/         {Mov  Cs:[Bp+E],Ds  Set New Data Segmt in regs}
{Recurin                                            Jump here if Recursion  }
     $FB                      {Sti Enable Interrupts                        }

       ) ;
{****************************************************************************}
{                  S  T  A  Y  R  S  T  R  .  I  N  C                        }
{                                                                            }
{           This is the StayRstr.Inc file included above                     }
{       Separate the code out into a file or replace the $I StayRstr.Inc     }
{                  statement above with this code.                           }
{****************************************************************************}

{ Inline Code to restore the stack and regs moved to the Turbo Resident
  Program Stack to allow re-entrancy into the Dos Code for I/O and
  recursion from built-in Turbo functions.

; Arthor:      L.H. Ferris

; Distributed to the Public Domain for use without profit.
; Original Version 5.15.85

;----------------------------------------------------------------------;
;        Restore the Dos Regs and Stack
;----------------------------------------------------------------------;

; On entry the Stack will already contain:
;
;        1) Bottom of Dos Stack Ptr
;        2) Dos Flags
;        3) Dos Code Segment
;        4) Dos Instruction Ptr
;        5) Dos Base Pointer
;        6) Dos Original Stack Ptr
}
    inline(

    $BD/Regs/                          {Mov    Bp,offset REGS}
    $2E/$8B/$46/$00/                   {CS:Mov Ax,[Bp+0]}
    $2E/$8B/$5E/$02/                   {Cs:Mov Bx,[Bp+2]}
    $2E/$8B/$4E/$04/                   {CS:Mov Cx,[Bp+4]}
    $2E/$8B/$56/$06/                   {CS:Mov Dx,[Bp+6]}

    $2E/$8B/$76/$0A/                   {CS:Mov Si,[Bp+A]}
    $2E/$8B/$7E/$0C/                   {CS:Mov Di,[Bp+C]}
    $2E/$8E/$5E/$0E/                   {CS:Mov DS,[Bp+E]}
    $2E/$8E/$46/$10/                   {CS:Mov ES,[Bp+10]}
    $2E/$FF/$76/$12/                   {Push Cs:[Bp+12]}
    $9D/                               {Popf}

    { If [Cs:InUse]:= True,  then dont restore the stack. This program is   }
    { being recursive. Else restore  Dos Stack and Program Entry registers  }

     $2E/$80/$3E/Inuse/$01/   {Cmp  byte ptr Cs:[Inuse],1                   }
     $74/$12/                 {Je   ReCurOut                                }

      $FA /                   { Cli      ; Stop all interrupts    }


    $5D/                     {Pop Bp           Save Dos Sp across pops   }

    $07/                     {Pop  Es                                     }
    $1F/                     {Pop  Ds                                     }
    $5F/                     {Pop  Di                                     }
    $5E/                     {Pop  Si                                     }
    $5A/                     {Pop  Dx                                     }
    $59/                     {Pop  Cx                                     }
    $5B/                     {Pop  Bx                                     }
    $44/$44/                 {Inc sp/Inc sp Thow old Ax value away        }

    $89/$EC/                  {Mov  Sp,Bp         Setup Dos Stack Ptr      }
    $2E/$8E/$16/DosSSeg/      {Mov  SS,Cs:DosSSeg Give back Dos Stack      }

{RecurOut                              Clean up the Stack              }

    $5D/                               {Pop Bp  Throw away old dos Sp  }

    $BD/Regs/                          {Mov    Bp,offset REGS}
    $2E/$FF/$76/$12/                   {Push Cs:[Bp+12]}
    $9D/                               {Popf}
    $5D/                               {Pop Bp  Retrieve old BP        }

    $FB/                               {Sti     Enable interrupts      }
    $CA/$02/$00                        {Ret Far 002                    }
        );

{****************************************************************************}
{                         S T A Y S U B S  .  I N C                          }
{                                                                            }
{   Separate this file into "Staysubs.Inc" to provide Directory routines     }
{       for the Stay-Resident Demo.                                          }
{                                                                            }
{****************************************************************************}


{----------------------------------------------------------------------------}
{                  F I L E         S U B R O U T I N E S                     }
{----------------------------------------------------------------------------}
  type
    Dir_Entry   = record
                      Reserved : array[1..21] of byte;
                      Attribute: byte;
                      Time, Date, FileSizeLo, FileSizeHi : integer;
                      Name : string[13];
                    end;
  var
    RetCode     : byte;
    Filename  : filename_type;
    Buffer    : Dir_Entry;
    Attribute : byte;
{----------------------------------------------------------------------------}
{                S  E  T       Disk  Transfer  Address                       }
{----------------------------------------------------------------------------}
Procedure Disk_Trns_Addr(var Disk_Buf);
var
  Registers : regtype;
Begin
  with Registers do
    begin
      Ax := $1A shl 8;                 { Set disk transfer address to  }
      Ds := seg(Disk_Buf);             { our disk buffer               }
      Dx := ofs(Disk_Buf);
      msdos(Registers);
    end;
end;
{----------------------------------------------------------------------------}
{                  F I N D   N E X T   F I L E   E N T R Y                   }
{----------------------------------------------------------------------------}
Procedure Find_Next(var Att:byte; var Filename : Filename_type;
                                      var Next_RetCode : byte);
var
  Registers  : regtype;
  Carry_flag : integer;
  N          : byte;

Begin  {Find_Next}
  Buffer.Name := '             ';     { Clear result buffer }
  with Registers do
      begin
      Ax := $4F shl 8;                 { Dos Find next function }
      MsDos(Registers);
      Att := Buffer.Attribute;         { Set file attribute     }
      Carry_flag := 1 and Flags;       { Isolate the Error flag }
      Filename := '             ';
      if Carry_flag = 1 then
        Next_RetCode := Ax and $00FF
      else
        begin                          { Move file name         }
        Next_RetCode := 0;
        for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
        end;
    end;  {with}
end;
{----------------------------------------------------------------------------}
{              F I N D   F I R S T   F I L E   F U N C T I O N               }
{----------------------------------------------------------------------------}
Procedure Find_First (var Att: byte;
                      var Filename: Filename_type;
                      var RetCode_code : byte);

  var
      Registers        :regtype;
      Carry_flag       :integer;
      Mask, N          :byte;

  begin
    Disk_Trns_Addr(buffer);
    Filename[length(Filename) + 1] := chr(0);
    Buffer.Name := '             ';
    with Registers do
      begin
      Ax := $4E shl 8;                  { Dos Find First Function }
      Cx := Att;                        { Attribute of file to fine }
      Ds := seg(Filename);              { Ds:Dx Asciiz string to find }
      Dx := ofs(Filename) + 1;
      MsDos(Registers);
      Att := Buffer.Attribute;          { set the file attribute byte  }

        { If error occured set, Return code. }

        Carry_flag := 1 and Flags;      { If Carry flag, error occured }
                                        { and Ax will contain Return code }
        if Carry_flag = 1 then
          begin
          RetCode_code := Ax and $00FF;
          end

        else
          begin
          RetCode_code := 0;
          Filename := '             ';
          for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
          end;

      end;  {with}
end;
{****************************************************************************}
{                       S T A Y X I T   .   I N C                            }
{                                                                            }
{     Separate this file into "StayXIT.Inc" to provide a "Go-non-Resident"   }
{                   routine or the Stay-Resident Demo.                       }
{                                                                            }
{****************************************************************************}

{-----------------------------------------------------------------------------}
{  Stay_Xit Check Terminate Keys                                              }
{                                                                             }
{  Check for Ctrl_Home key. Free the Environment , the program segment        }
{  memory and return to Dos. Programs using this routine ,must be the         }
{  last program in memory, else ,a hole will be left causing Dos              }
{  to go GooGoo .                                                             }
{-----------------------------------------------------------------------------}

   Begin { Block }
      if Keypressed then
         Begin { Keypressed }
         While Keypressed do read (Kbd,Keychr);
         If Keychr = Quit_Key then
            Begin { Terminate }
            Writeln ('Stay-Resident program Terminating') ;
            SaveRegs.Ax := $35 shl 8 + User_Int;
            MsDos(SaveRegs);           {get the original Int 16 Addr   }

            SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
            SaveRegs.Ds := SaveRegs.Es;
            SaveRegs.Dx := SaveRegs.Bx; { set the user-interrupt address to }
            MsDos(SaveRegs);            { the keyboard interrupt address    }

            MemW[$00:User_Int * 4] := 0 ; { Clear User Interrupt vector     }
            MemW[$00:User_Int * 4 + 2] :=0;

            Saveregs.Ax := $49 shl 8 + 0 ;    { Free Allocated Block function}
            Saveregs.Es := MemW[Cseg:$2C] ; { Free environment block       }
            MsDos( Saveregs ) ;

            Saveregs.Ax := $49 shl 8 + 0 ;    { Free Allocated Block function}
            Saveregs.Es := Cseg ;             { Free Program                 }
            MsDos( Saveregs ) ;

            Intr($20,Regs) ;           { Return to Dos }

            End   { Terminate } ;
         End  { Keypressed };
   End  { Block };
{****************************************************************************}
{                       W I N D M N G R    .   I N C                         }
{                                                                            }
{     Separate this file into "WindMngr.Inc" to provide a Window for         }
{                    the Stay-Resident Demo.                                 }
{                                                                            }
{****************************************************************************}
            { Window Manager/Editor System Include file .. }
{ Author:

           Jim Everingham (The Window Manager/Editor)                        }


Const
      MaxScreens = 8;     { Number of Windows Allowed, do not Change }
      Screen_seg = $B800; { Change to #B000 for MonoChrome, Change
                            then # sign to a Dollar sign Though. }
      Data_Addr = $0000;
      Fc        : Array[1..4, 1..7] of Integer
                = ((218, 196, 191, 179, 192, 196, 217),
                   (201, 205, 187, 186, 200, 205, 188),
                   (213, 205, 184, 179, 212, 205, 190),
                   (219, 219, 219, 219, 219, 219, 219));

type maxstr     = string[80];
     window_rec = record
                        x1,x2,y1,y2,c1,b1,w1,w2: Integer;
                        Screen: Array[1..4000] of byte;
                  end;

var  Stack_Top,Last_Window_Num,
     line_pos,F1         : Integer;
     screen              : Array[1..4000] of byte;
     real_screen         : Array[1..4000] of byte absolute Screen_Seg:Data_Addr;
     Page_1              : Array[1..4000] of byte absolute Screen_Seg:$1000;
     Imig                : Array [1..MaxScreens] of Window_rec;
     Original            : Array[1..4000] of byte;
     Coords              : Array[1..8,1..MaxScreens] of Integer;


{----------------------------------------------------------------------------}
{                              S E T _ P A G E                               }
{----------------------------------------------------------------------------}
procedure set_page(page: byte);

type
  Result =
    record
      AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: byte;
    end;
var rec:result;

begin
  Rec.AX := page;
  Rec.BX := $05;
  Intr($10,Rec);
end;

{----------------------------------------------------------------------------}
{                        S  C  R  N  _  O  F  F                              }
{----------------------------------------------------------------------------}
Procedure Scrn_off;
begin
     inline($52/$50/$ba/$d8/$03/$b0/$21/$ee/$58/$5a)
end;
{----------------------------------------------------------------------------}
{                        S  C  R  N  _  O  N                                 }
{----------------------------------------------------------------------------}
Procedure Scrn_on;
begin
     inline($52/$50/$ba/$d8/$03/$b0/$29/$ee/$58/$5a)
end;
{----------------------------------------------------------------------------}
{                        A  C  T  I  V  E                                    }
{----------------------------------------------------------------------------}
Function active: integer;
begin
     active:=stack_top
end;
{----------------------------------------------------------------------------}
{                              P  U  S  H                                    }
{----------------------------------------------------------------------------}
Procedure Push(Ulx, Uly, Lrx, Lry, Foreground, Background: integer);

{ This procedure Saves screens in memory. When a new window is put
  on the Screen, the preceding window is stored away for later reference.}

begin
     { If last Window up, move the Original Screen into Screen Memory}
     if stack_top = 0 then
           begin
              Scrn_off;
              move(real_screen, Original, 4000);
              Scrn_on
           end;
     {Save all Data concerning the windows}
     if (Stack_top < MaxScreens) and (Stack_Top >= 0) then
            begin
                 Stack_top:=Stack_top+1;
                 Imig[Stack_top].x1:=Ulx;
                 Imig[Stack_top].y1:=Uly;
                 Imig[Stack_top].x2:=Lrx;
                 Imig[Stack_top].y2:=Lry;
                 Imig[stack_top].c1:=Foreground;
                 Imig[Stack_top].b1:=Background
            end;

     { Push Screen on Stack ... Sort of... }
     Scrn_off;
     Move(real_screen,Imig[Stack_top].Screen,4000);
     Scrn_on
end;
{----------------------------------------------------------------------------}
{                              P  O  P                                       }
{----------------------------------------------------------------------------}
Procedure Pop;

{ This Procedure takes the screen that procedes the current window and
  Copies back to screen memory, restores all data concerning the previous
  window and activates it.. Neat huh? }

begin

     { If no windows are active, save the current screen }
     if stack_top =0 then
           begin
                normvideo;
                window(1,1,80,25);
                Scrn_off;
                move(Original, real_screen, 4000);
                Scrn_on;
           end;

     { Get Preceding screen and copy it to screen memory }
     Scrn_off;
     Move(Imig[Stack_top].Screen,Real_Screen,4000);
     Scrn_on;
     Stack_top:=Stack_top-1
end;
{----------------------------------------------------------------------------}
{                           W  R  I  T  E  X  Y                              }
{----------------------------------------------------------------------------}
Procedure Writexy(long_string:maxstr; xcoord,ycoord:integer; var color: integer);

{ This procedure Draws whatever you want, wherever you want, by changing the
  value of Screen in the variable declaration, it can draw a "Picture" any-
  were in memory. This allows for the Speed of the window making process..}

var str_len, real_pos, scr_pos: integer;

begin
{$I-}
     str_len:=length(long_string); { So I know how much to write }
     Scr_pos:=0;

     { The next 8 lines write the string in every "even" location in memory
       and ever odd location gets the attribute with determines how the
       string is displayed on the screen}
     for real_pos:=1 to str_len do
                 if scr_pos < 4001 then
                       begin
                            scr_pos:=((xcoord*2)-1)+(ycoord*160);
                            screen[scr_pos]:=ord(copy(long_string,real_pos,1));
                            screen[scr_pos+1]:=color;
                            xcoord:=xcoord+1;
                       end
{$I+}
end;

{----------------------------------------------------------------------------}
{                              F  R  A  M  E                                 }
{----------------------------------------------------------------------------}
Procedure Frame(WindowType, UpperLeftX, UpperLeftY, LowerRightX, LowerRightY, color: Integer);

{ This procedure draws the window frame in another part of memory. }
var i: integer;
begin
     WriteXY(chr(Fc[WindowType,1]),UpperLeftX, UpperLeftY,color);
     for i:=UpperLeftX+1 to LowerRightX-1 do WriteXY(chr(Fc[WindowType,2]),i,UpperleftY,color);
     WriteXY(chr(Fc[WindowType,3]),i+1,UpperleftY,color);
     for i:=UpperLeftY+1 to LowerRightY-1 do
         begin
              WriteXY(chr(Fc[WindowType,4]),UpperLeftX , i,color);
              WriteXY(chr(Fc[WindowType,4]),LowerRightX, i,color);
         end;
     WriteXY(chr(Fc[WindowType,5]),UpperLeftX, LowerRightY, color);
     for i:=UpperLeftX+1 to LowerRightX-1 do WriteXY(chr(Fc[WindowType,6]),i,LowerrightY,color);
     WriteXY(chr(Fc[WindowType,7]),i+1,LowerRightY,color);
end  { Frame };
{----------------------------------------------------------------------------}
{                         I  N  I  T  I  A  L  I  Z  E                       }
{----------------------------------------------------------------------------}
Procedure initialize;

{ Set up memory and the stack }

var i:integer;

begin
     Stack_top:=0;
     move(real_screen,screen,4000);
     with imig[1] do for i:=1 to 4000 do screen[i]:=$00;
     for i:=2 to 9 do move(Imig[i-1].screen,imig[i].screen,4000);
     move(imig[1].screen,screen,4000);
     move(imig[1].screen,original,4000)
end;
{----------------------------------------------------------------------------}
{                    A  D  D  _  W  I  N  D  O  W                            }
{----------------------------------------------------------------------------}
Procedure Add_window(UpperLeftX,UpperLeftY,LowerRightX,LowerRightY,Foreground,
                 BackGround, WindowType: Integer);

{ This procedure does all the laborous work for you.. The variables make it
  Fairly easy to understand. }

Var i,j,k,Color: Integer;

begin
     Imig[Stack_top].w1:=whereX;
     Imig[Stack_top].w2:=WhereY;
     UpperLeftX:=UpperLeftX+1;
     LowerRightX:=LowerRightX-1;
     LowerRightY:=LowerRightY-2;
     f1:=WindowType;color:=0;
     Scrn_off;
     move(real_screen,screen,4000);
     Scrn_on;

     { Set color attribute for direct writeng to memory }
     if background < 17 then Color:=foreground+(background*16);

     { Check for invalid window frame types }
     if (WindowType > 5) or (WindowType < 0) then
              begin
                   Clrscr;
                   Writeln('Invalid Frame Type!')
              end
    else

     { If the window is valid then Procede }
              begin

     { Fill color Attribute of window directly into memory }
                   k:=1;
                   for j:=UpperLeftY to LowerRightY do
                           for i:=UpperLeftX to LowerRightX do
                                    begin
                                         k:=(j*160)+(i*2);
                                         Screen[k]:=Color;
                                         Screen[k-1]:=$20
                                    end;

    { Frame Window }
                   Case Windowtype of
                             1:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
                                      LowerRightX+1,LowerRightY+1,
                                      color);
                             2:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
                                      LowerRightX+1,LowerRightY+1,
                                      color);
                             3:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
                                           LowerRightX+1,LowerRightY+1,
                                           color);
                             4:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
                                      LowerRightX+1,LowerRightY+1,
                                      color);
                             end { Case }
              end;

    { Activate newly formed window }
    Window(1,1,80,25);
    Window(UpperLeftX,UpperLeftY+1,LowerRightX,LowerRightY+1);
    push(UpperLeftx,UpperLeftY+1,LowerRightX,LowerRightY+1,Foreground, Background);
    Scrn_off;
    Move(screen,real_screen,4000);gotoxy(1,1);
    Scrn_on;
    Textcolor(Foreground);TextBackground(backGround);ClrScr;
end;
{----------------------------------------------------------------------------}
{                    C  O  L  O  R  _  W  I  N  D  O  W                      }
{----------------------------------------------------------------------------}
Procedure Color_window(Foreground, Background: integer);

{ This procedure allows you to change the foreground and background color
  of the active window. }

var i,j,Color: Integer;

begin

     { Set Attribute value }
     if background < 8 then Color:=foreground+(background*16);

     { Write new attribute direclty to screen memory }
     for j:=(Imig[Stack_top].y1-2) to Imig[Stack_top].y2 do
            for i:=(Imig[Stack_top].x1-1) to (Imig[Stack_top].x2+1) do
                    begin
                         Real_Screen[(j*160)+(i*2)]:=Color
                    end
end;
{----------------------------------------------------------------------------}
{                        R  E  M  O  V  E                                    }
{----------------------------------------------------------------------------}
Procedure Remove(Num_to_Remove: Integer);

{ This Procedure removes 1 or a specified number of windows from the
  screen and reactivates the underlying window }

var i: integer;
begin
     if (Num_to_Remove > 0) and (Num_to_Remove < MaxScreens) then
          for i:=1 to Num_to_remove do Pop
     else
         Pop;
     Window(1,1,80,25);
     Window(Imig[Stack_top].x1+1,Imig[Stack_top].y1,Imig[Stack_top].x2,Imig[Stack_top].y2);
     gotoxy(1,1);
     TextBackground(Imig[Stack_top].b1);TextColor(Imig[Stack_top].c1);
     GotoXY((Imig[Stack_top].w1-1),Imig[Stack_top].w2)
end;
{----------------------------------------------------------------------------}
{                   W  I  N  D  O  W  _  T  I  T  L  E                       }
{----------------------------------------------------------------------------}
Procedure Window_Title(Name: Maxstr; color:integer);

var i, k, l, m: integer;

begin
     If Length(name)>0 then
     begin
     l:=1;
     color:=color+(Imig[Stack_top].b1*16);
     if f1 < 4 then Real_Screen[(((Imig[Stack_top].Y1-2)*160)+(Imig[Stack_top].X1*2))+l]:=$5b;
     for i:=1 to length(Name) do
             begin
                  k:=(((Imig[Stack_top].Y1-2)*160)+(Imig[Stack_top].X1*2))+l+1;
                  Real_Screen[k+1]:=ord(copy(Name,i,1));
                  Real_Screen[k+2]:=color;
                  l:=l+2
             end;
     if f1 < 4 then Real_Screen[k+3]:=$5d
     end
end;

{ Thats all.. }