ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/MISC/PCTV1N6.ZIP/POLITE.PAS

Pascal/Delphi Source File | 1990-07-16 | 7.8 KB | 251 lines

{

         TITLE : POLITE.TPU,  Version 9004.05
       PURPOSE : Unit that allows saving and restoring DOS states.
        AUTHOR : David Gerrold, CompuServe ID:  70307,544
   ________________________________________________________________

    Written in Turbo Pascal, Version 5.5,
    with routines from TurboPower, Object Professional.

    Turbo Pascal is a product of Borland International.
    Object Professional is a product of TurboPower Software.
   ________________________________________________________________

    This is not public domain software.
    This software is copyright 1990, by David Gerrold.
    Permission is hereby granted for personal use.

         The Brass Cannon Corporation
         9420 Reseda Blvd., #804
         Northridge, CA  91324-2932.

                                                                   }

{ Compiler Directives ============================================ }

{$R-}    {Range checking off}
{$B-}    {Boolean complete evaluation off}
{$S-}    {Stack checking off}
{$I-}    {I/O checking off}
{$N+,E+} {Simulate numeric coprocessor}
{$M 16384,0,327680} {stack and heap}
{$V-}    {Variable range checking off}

{ Name =========================================================== }

UNIT Polite;
{
  The purpose of this unit is to automate the process of writing
  a well-behaved program.  A well-behaved program should save the
  state of the operating system before the program begins running,
  and then restore the system to that state again after the program
  concludes.

  This means that the program must:
    * restore the operative display mode
    * restore the cursor to the same size
    * if necessary, restore the cursor to the same location
    * if necessary, restore the previous contents of the screen

  In addition, the program should
    * restore the state of Ctrl-Break
    * restore a damaged cursor

  This unit also includes code to
    * automatically note the time the program began,
      for logging functions
    * automatically randomize, for game programs

  To use, simply include this unit as the first one in your
  program's USES statement, or include these routines in your own
  initialization unit.

  To save and restore the state of the DOS screen, frame your main
  code with the OpenProgram and CloseProgram procedures:

     BEGIN
       OpenProgram;
       ...
       DoSomeStuff;
       ...
       CloseProgram;
     END.
}

{ Interface ====================================================== }

INTERFACE

USES
{ Object Professional Units }
  OpCrt,
  OpDate,
  OpString;

{ Declarations =================================================== }

VAR
  LogOnTime : DateTimeRec;                  { time program started }

{ Save and Restore DOS screen ------------------------------------ }

PROCEDURE OpenProgram;
{
  Save Dos screen.
  MUST be used with CloseProgram, MUST be first statement in program.
}

PROCEDURE CloseProgram;
{
  Restore Dos screen.
  MUST be used with OpenProgram, MUST be last statement in program.
}

{ Implementation ================================================= }

IMPLEMENTATION

{ Open and Close Variables ======================================= }

VAR
  CursorLoc  : word;                             { DOS cursor loc }
  CursorSize : word;                            { DOS cursor size }

  DosMode    : word;                          { DOS mode at start }
  DosScreen  : pointer;                        { saved DOS screen }

{ Open Program =================================================== }

PROCEDURE OpenProgram;
{
  Save DOS screen.
  MUST be used with CloseProgram, -MUST be 1st statement in program.
}
VAR
  Flag : boolean;

BEGIN
{
  Save the DOS mode.  If text mode, save the screen.
}
  DosMode := CurrentMode;                    { save existing mode }
  Case DosMode of
    bw80,
    co80,
    Mono : Flag := SaveWindow (1, 1, 80, 25, true, DosScreen);
        { false means not enough heap space to store saved window }
    end;  { case }

  If DefColorChoice = ForceMono
    then TextMode (bw80)
    else TextMode (co80);
  HiddenCursor;                              { turn off cursor }
END;

{ CloseProgram ================================================== }

PROCEDURE CloseProgram;
{
  Restore DOS screen.
  MUST be used with OpenProgram, MUST be last statement in program.
}

BEGIN
  If DosMode <> CurrentMode then
    TextMode (DosMode);                   { restore previous mode }
  Case DosMode of
    bw80,
    co80,
    Mono  : If DosScreen <> nil then begin
            RestoreWindow (1, 1, 80, 25, true, DosScreen);
            RestoreCursorState (CursorLoc, CursorSize); { curs. on }
            end;
    end;  {case}
END;

{ Initialization Variables ======================================= }

VAR
  ExitSave     : pointer;                    { for ExitProc }
  Loop         : byte;                       { for initialization }

{ ExitUnit ======================================================= }

{$F+} PROCEDURE ExitUnit; {$F-}

BEGIN
  ExitProc := ExitSave;                   { reset original address }
  SetCursorSize (hi (CursorSize), lo (CursorSize));
  NormVideo;                              { sets original TextAttr }
                                          { return to DOS }
END;

{ Initialization ================================================= }

BEGIN
  ExitSave := ExitProc;                   { save old address }
  ExitProc := @ExitUnit;                  { get new exit address }

{
  OpCrt forces break-checking off when a program begins and restores
  it to its former state when the program ends. See the Turbo Pascal
  reference manual for details on GetCBreak & SetCBreak procedures.
}

{ Check for mono ------------------------------------------------- }
{
  If the current display is not capable of color or the user has set
  his display to mono mode, we need to force mono attributes.
}
  Case CurrentDisplay of
    MonoHerc : DefColorChoice := ForceMono;
    end;  {case}
  Case CurrentMode of
    bw40, bw80, Mono : DefColorChoice := ForceMono;
    end;  {case}

{
  There is no way that a program can tell if a user has a color card
  connected to a bw monitor.  To force a bw display, let the user
  call the program with the command line option of '-bw' or '/bw'.
  The program will look through the ParamStrs and set DefColorChoice
  to ForceMono.

  For this to work, however, EVERY color choice called must be mapped
  with OpCrt's ColorMono (color, mono) function.
}
  For Loop := 1 to ParamCount do
    if
      (CompUCString ('/bw', ParamStr (Loop)) = equal)
        or
      (CompUCString ('-bw', ParamStr (Loop)) = equal)
    then
      DefColorChoice := ForceMono;

  TextAttr := ColorMono (Yellow, LightGray); { set new attributes }

{ Initialize the cursor ------------------------------------------ }

  GetCursorState (CursorLoc, CursorSize);  { save cursor loc, size }
  dec (CursorLoc, 256);                   { adjust cursor row up 1 }
{
  There are some very obscure situations in which DOS will hide the
  cursor, leaving the scan lines set for 32 and 0.  This code will
  detect that situation and will restore the cursor to a normal size
  for the DOS text mode.  It may be incompatible with TSR routines
  that turn the cursor off and fake a non-blinking cursor. I haven't
  tested it.  Feedback would be appreciated.
}
  If CursorSize = $2000 then CursorSize := $0607;

{
  Log what time the program started, randomize the random num. seed.
}
  LogOnTime.T := CurrentTime;            { what time did we start? }
  LogOntime.D := Today;                  { what day is today? }
  Randomize;                             { for games, etc. }
END.

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