ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/PCMAG/VOL9N21.ZIP/DGCRT.PAS

Pascal/Delphi Source File | 1990-09-25 | 27.0 KB | 918 lines

{
 ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄
 █                                                                         █
 █        TITLE :      DGCRT.TPU                                           █
 █      PURPOSE :      Useful screen handling routines.                    █
 █       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 ===================================================== }

{$A-}    {Switch word alignment off, necessary for cloning}
{$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 DgCrt;
{
  Screen-handling routines.
}

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

INTERFACE

USES
{ Turbo Pascal Units}
  Dos,

{ Object Professional Units }
  OpCrt,
  OpWindow,
  OpMouse,

{ DG Units }
  DgDec,
  DgBit;

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

TYPE
  EgaRegArray = array [0..16] of byte;
  { byte 16 is the overscan (border) area }

  VgaRegArray = array [0..16, 1..3] of byte;
  { Vga register values for assignment to standard colors. }

CONST
  StandardColors  : EgaRegArray =
    (0, 1, 2, 3, 4, 5, 20, 7, 56, 57, 58, 59, 60, 61, 62, 63, 0);
  FadeToBlackFlag : boolean = false;
  FadeRate        : byte = 12;                   { steps to dissolve }

VAR
  StoreEgaPal  : EgaRegArray;                    { Ega palette }
  StoreVgaPal  : VgaRegArray;                    { Vga palette }
  StoreKeyStateByte : byte;                      { store shift key status }
  StoreScreenHeight : byte;                      { how many rows? }
  StoreScreenWidth  : byte;                      { how many cols? }

  EgaPal       : EgaRegArray;                    { working palette }
  VgaPal       : VgaRegArray;                    { working palette }

  DissolveProc     : procedure;                  { for dissolve process }
  FinalFadeOutProc : procedure;                  { for final fade out }

{ Procs and Funcs ========================================================= }

FUNCTION Attribute (FG, BG : Byte) : Byte;

PROCEDURE DisableUV;
{ Disables UltraVision. }

PROCEDURE DispPackedWindow (PackedWindow : Pointer);
{ Display a packed window. }

PROCEDURE Dissolve (Hither, Yon : VgaRegArray);
{ Dissolves registers from one palette to another }

FUNCTION EgaVal (Red, Green, Blue : byte) : byte;
{ Returns single byte containing red, green, and blue color values. }

PROCEDURE EnableUV (Mode : byte);
{ Enables UltraVision. }

PROCEDURE FadeIn (FadeInProc : Proc;  Mode : byte);
{ Fades in to screen painted by FadeInProc. }

PROCEDURE FadeOut;
{ Fades out to black }

PROCEDURE FadeStart (FadeInProc : Proc;  Mode : byte);
{ Fades out DOS to black, fades in program. }

(*
FUNCTION GetMode : byte;
{ Returns EGA display mode.  If UltraVision installed, returns UV mode. }
*)
PROCEDURE GetEgaPalette (VAR P : EgaRegArray);
{ Gets current EGA palette, returns it in P. }

FUNCTION GetEgaRegister (ColorNum : byte) : byte;
{ Returns Ega register of ColorNum (0..15).  Returns 0..64. }

FUNCTION GetUvMode : byte;
{ Gets UltraVision mode. }

PROCEDURE GetVgaPalette (VAR P : VgaRegArray);
{ Gets current VGA palette, stores it in P. }

PROCEDURE GetVgaRegister (ColorReg : byte;  VAR Red, Green, Blue : byte);
{ Gets R, G, and B values of Color Register Number (0-64). }

PROCEDURE ReadAtCursor (VAR Ch : char;  VAR Attr : byte);
{ Reads char and attr at cursor loc }

PROCEDURE SaveDosScreen;
{
  Sets ExitProc to automatically restore DOS screen on exit.
  MUST be first statement in program.
}

PROCEDURE SetMode (Mode : byte);
{ Sets EGA mode.  If UltraVision installed, sets UV mode. }

PROCEDURE SetEgaPalette (VAR P : EgaRegArray);
{ Load a palette into Ega registers (0-64). }

PROCEDURE SetEgaRegister (ColorNum, EgaReg : byte);
{ Resets ColorNum (0-15) with number of EGA register.  64-color palette. }

PROCEDURE SetUvMode (Mode : byte);
{ Sets UltraVision mode. }

PROCEDURE SetVgaPalette (P : VgaRegArray);
{ Loads a VGA palette into whatever EGA registers are active. }

PROCEDURE SetVgaRegister (ColorReg, Red, Green, Blue : byte);
{ Resets Color Register Number (0-64) with R, G, B values 0-63. }

FUNCTION UVactive : boolean;
{ Is UltraVision on? }

FUNCTION UVinstalled : boolean;
{ Is UltraVision present? }

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

IMPLEMENTATION

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

CONST
  StoreDosScreen  : pointer = nil;               { saved DOS screen }

VAR
  StoreCheckBreak : boolean;                     { DOS BREAK status }
  StoreCursorLoc  : word;                        { DOS cursor loc }
  StoreCursorSize : word;                        { DOS cursor size }
  StoreDosMode    : byte;                        { DOS mode at start }
  StoreUvMode     : byte;                        { Ultra Vision mode }
  StoreDosPalette : EgaRegArray;                 { store system palette }

  BlinkByte  : byte absolute $40:$65;            { system blink is bit 5 }
  BlinkFlag  : boolean;                          { system blink on or off? }
  ScreenFlag : boolean;                          { restore DOS screen? }
  FadeFlag   : boolean;                          { fade in DOS screen? }

{ ========================================================================= }
{ Attribute =============================================================== }

FUNCTION Attribute (FG, BG : Byte) : Byte;
{ Translates Foreground and Background colors into a video attribute. }

BEGIN
Attribute := (FG + BG Shl 4) And $7F;

{ "And $7F" turns off the high bit, which triggers blinking.  Blinking
can be turned on by adding 128 to the result of this function. }
END;

{ DisableUV =============================================================== }

PROCEDURE DisableUV;
{ Disables UltraVision. }

VAR
  R : registers;

BEGIN
  if not UVinstalled then exit;
  with R do begin
    AH := $CC;
    AL := $01;
    end;
  Intr ($10, R);                                 { turns off UV }
  with R do begin
    AH := $0;
    AL := $03;                                   { set color text mode }
    end;
  Intr ($10, R);
END;

{ DispPackedWindow ======================================================== }

PROCEDURE DispPackedWindow (PackedWindow : Pointer);
VAR
  P : PackedWindowPtr;

BEGIN
  New (P, InitFromMemory (PackedWindow));
  P^.Display;
  Dispose (P, Done);
END;

{ Dissolve ================================================================ }

PROCEDURE Dissolve (Hither, Yon : VgaRegArray);
{ Dissolves registers from one palette to another }
VAR
  EgaPal    : EgaRegArray;
  Transfer,
  Factor    : array [0..16, 1..3] of real;
  Loop,
  Color,
  Number    : byte;

BEGIN
  if CurrentDisplay < Vga then exit;
  GetEgaPalette (EgaPal);

  if FadeRate = 0 then begin
    SetVgaPalette (Yon);
    DissolveProc;
    exit;
    end;

{
  If FadeRate > 0 then do a real dissolve.
}
  for Loop := 0 to 15 do
    for color := 1 to 3 do begin
      Transfer [Loop, Color] := Hither [Loop, Color];
      Factor [Loop, Color] :=
        (Yon [Loop, Color] - Hither [Loop, Color])/FadeRate;
      end;
  for Loop := 0 to pred (FadeRate) do begin
    for Number := 0 to 15 do begin
      for Color := 1 to 3 do
        Transfer [Number, Color] :=
          Transfer [Number, Color] + Factor [Number, Color];
      SetVgaRegister (EgaPal [Number],
                      round (Transfer [Number, 1]),
                      round (Transfer [Number, 2]),
                      round (Transfer [Number, 3]));
      end;
    DissolveProc;
    end;
END;

{ EgaVal ================================================================ }

FUNCTION EgaVal (Red, Green, Blue : byte) : byte;
{
  Returns single byte containing red, green, and blue color values.
  Red, Green, and Blue must be in range [0..3].
}

CONST
  R : array [0..3] of byte = (0, 32, 4, 36);
  G : array [0..3] of byte = (0, 16, 2, 18);
  B : array [0..3] of byte = (0,  8, 1,  9);
{
  Colors are stored as six bit numbers:

    rgbRGB
    001001  =  both blue bits on  =  9.
    010010  =  both green bits on = 18.
    100100  =  both red bits on   = 36.

  Bits 5, 4, and 3 are secondary red, green, and blue.
  Bits 2, 1, and 0 are primary red, green, and blue.

  Primary  blue = 1, secondary  blue =  8;  if both are on, value is 9.
  Primary green = 2, secondary green = 16;  if both are on, value is 18.
  Primary   red = 4, secondary   red = 32;  if both are on, value is 36.
}

BEGIN
  EgaVal := R [Red] + G [Green] + B [Blue];
END;

{ EnableUV ================================================================ }

PROCEDURE EnableUV (Mode : byte);
{ Enables UltraVision. }

VAR
  R : registers;
BEGIN
  if not UVinstalled then exit;
  with R do begin
    AH := $CC;
    AL := $02;
    end;
  Intr ($10, R);                                 { turns on UV }
  with R do begin
    AH := $0;
    AL := Mode;
    end;
  Intr ($10, R);                                 { restore video mode }
END;

{ FadeIn ================================================================== }

PROCEDURE FadeIn (FadeInProc : Proc;  Mode : byte);
{ Fades in to screen painted by FadeInProc. }

VAR
  BlackPal  : VgaRegArray;
  ColorReg  : array [1 .. 3] of byte;
  Loop,
  InnerLoop : byte;
BEGIN
  if CurrentDisplay < Vga then exit;
  SetMode (Mode);
  HiddenCursor;
  ClrScr;
  if FadeToBlackFlag then
    for InnerLoop := 1 to 3 do
      ColorReg [InnerLoop] := 0
  else
    GetVgaRegister (0, ColorReg [1], ColorReg [2], ColorReg [3]);
  For Loop := 0 to 15 do
    For InnerLoop := 1 to 3 do
      BlackPal [Loop, InnerLoop] := ColorReg [InnerLoop];
  SetVgaPalette (BlackPal);
  FadeInProc;                                    { set up fade in screen }
  Dissolve (BlackPal, VgaPal);
END;

{ FadeOut ================================================================= }

PROCEDURE FadeOut;
{ Fades out to black }
VAR
  BlackPal,
  VgaPal    : VgaRegArray;
  ColorReg  : array [1 .. 3] of byte;
  Loop,
  InnerLoop : byte;
BEGIN
  if CurrentDisplay < Vga then exit;
  GetVgaPalette (VgaPal);
  if FadeToBlackFlag then
    for InnerLoop := 1 to 3 do
      ColorReg [InnerLoop] := 0
  else
    for InnerLoop := 1 to 3 do
      ColorReg [InnerLoop] := VgaPal [0, InnerLoop];
  For Loop := 0 to 15 do
    For InnerLoop := 1 to 3 do
      BlackPal [Loop, InnerLoop] := ColorReg [InnerLoop];
  Dissolve (VgaPal, BlackPal);
END;

{ FadeStart =============================================================== }

PROCEDURE FadeStart (FadeInProc : Proc;  Mode : byte);
{ Fades out DOS to black, fades in program. }

BEGIN
  FadeOut;
  SaveDosScreen;
{
  If fading in to a different palette, set Vpal to new palette
  in FadeInProc.
}
  FadeIn (FadeInProc, Mode);
  FadeFlag := true;
END;

{ GetEgaPalette =========================================================== }

PROCEDURE GetEgaPalette (VAR P : EgaRegArray);
{ Gets current EGA palette, returns it in P. }

VAR
  R    : registers;
  Loop : byte;

BEGIN
  if CurrentDisplay < Ega then exit;
  for Loop := 0 to 15 do
    P [Loop] := GetEgaRegister (Loop);
END;

{ GetEgaRegister ========================================================== }

FUNCTION GetEgaRegister (ColorNum : byte) : byte;
{ Returns Ega register of ColorNum (0..15).  Returns 0..64. }

VAR
  R : registers;

BEGIN
  with R do begin
    AH := $10;
    AL := $7;
    BL := ColorNum;
    intr ($10, R);
    GetEgaRegister := BH;
    end;
END;

{ GetUvMode =============================================================== }

FUNCTION GetUvMode : byte;
{ Gets UltraVision mode. }

VAR
  R : registers;
BEGIN
  if not UVactive then
    GetUvMode := 255
  else
    with R do begin
      AH := $CD;
      AL := $04;
      Intr ($10, R);
      GetUvMode := AL;
      end;
END;

{ GetVgaPalette =========================================================== }

PROCEDURE GetVgaPalette (VAR P : VgaRegArray);
{
  Gets current VGA palette, stores it in P.

  This procedure does not get the Vga registers stored in 0-15.
  It gets the Vga registers pointed to by EgaPal [0..15] which
  can be any value in the range 0..64.
}

VAR
  Loop   : byte;
  EgaPal : EgaRegArray;

BEGIN
  if CurrentDisplay < Vga then exit;
  GetEgaPalette (EgaPal);
  for Loop := 0 to 15 do
    GetVgaRegister (EgaPal [Loop],
                    P [Loop, 1],
                    P [Loop, 2],
                    P [Loop, 3]);
END;

{ GetVgaRegister ========================================================== }

PROCEDURE GetVgaRegister (ColorReg : byte;  VAR Red, Green, Blue : byte);
{
  Gets R, G, and B values of Color Register Number (0-64).
  Values will be in range of 0-63.
}

VAR
  R : registers;

BEGIN
  with R do begin
    AX := $1015;
    BX := ColorReg;
    Intr ($10, R);
    Red := DH;
    Green := CH;
    Blue := CL;
    end;
END;

{ ReadAtCursor ============================================================ }

PROCEDURE ReadAtCursor (VAR Ch : char;  VAR Attr : byte);
{ Reads char and attr at cursor loc }

VAR
  R : registers;

BEGIN
  with R do begin
    AH := $08;
    BH := $00;
    end;
  Intr ($10, R);
  Ch := chr (R.AL);
  Attr := R.AH;
END;

{ RestoreDosScreen ======================================================== }

{$F+}  PROCEDURE RestoreDosScreen; {$F-}
BEGIN
  SetMode (StoreDosMode);
  SetUvMode (StoreUvMode);
  HiddenCursor;
  RestoreWindow
    (1, 1, StoreScreenWidth, StoreScreenHeight, true, StoreDosScreen);
END;

{ SaveDosScreen =========================================================== }

{$F+} PROCEDURE SaveDosScreen; {$F-}
{
  Sets ExitProc to automatically restore DOS screen on exit.
  MUST be first statement in program.
}

BEGIN
  Case StoreDosMode of
    Bw40 : begin
           textmode (bw80);
           StoreDosMode := CurrentMode;
           end;
    Co40 : begin
           textmode (co80);
           StoreDosMode := CurrentMode;
           end;
    end;  { case }

  ScreenFlag := SaveWindow (1, 1,
                            StoreScreenWidth, StoreScreenHeight,
                            true, StoreDosScreen);
  { false means not enough heap space to store saved window }
  { true will force restoring this screen on exit }

  if Font8x8Selected then                     { turn off graphics }
    SelectFont8x8 (false);
  if DefColorChoice = ForceMono then
    SetMode (bw80)                            { force b/w 25 line mode }
  else begin
    SetMode (co80);
    if ScreenHeight <> 25 then SetUvMode ($11);
    end;

  ReinitCrt;                                     { restore OpCrt variables }
  InitializeMouse;                               { restore mouse limits }
  HiddenCursor;
END;

{ SetEgaPalette =========================================================== }

PROCEDURE SetEgaPalette (VAR P : EgaRegArray);
VAR
  Loop   : byte;

BEGIN
  if CurrentDisplay < Ega then exit;
  for Loop := 0 to 15 do
    SetEgaRegister (Loop, P [Loop]);
END;

{ SetEgaRegister ========================================================== }

PROCEDURE SetEgaRegister (ColorNum, EgaReg : byte);
{ Resets ColorNum (0-15) with number of EGA register.  64-color palette. }

VAR
  R : registers;

BEGIN
  with R do begin
    AX := $1000;
    BL := ColorNum;
    BH := EgaReg;
    end;
  intr ($10, R);
END;

{ SetMode ================================================================= }

PROCEDURE SetMode (Mode : byte);
{
  Sets EGA mode.  If UltraVision installed, sets UV mode.
  UV modes are a superset of EGA modes.
}

VAR
  R : registers;
BEGIN
  if CurrentDisplay < Ega then exit;
  if CurrentMode = Mode then exit;
  with R do begin
    AH := $00;                                   { EGA mode }
    AL := Mode;
    end;
  Intr ($10, R);
  ReinitCrt;
  InitializeMouse;                               { reset mouse limits }
END;

{ SetUvMode =============================================================== }

PROCEDURE SetUvMode (Mode : byte);
{ Sets UltraVision mode. }

VAR
  R : registers;
BEGIN
  if not UVactive then exit;
  if GetUvMode = Mode then exit;
  with R do begin
    AH := $CD;
    AL := Mode;
    end;
  Intr ($10, R);
  ReinitCrt;
  InitializeMouse;                               { reset mouse limits }
END;

{ SetVgaPalette =========================================================== }

PROCEDURE SetVgaPalette (P : VgaRegArray);
{
  Loads a VGA palette into whatever EGA registers are active.

  This procedure does not load Vga registers 0-15.
  It loads the Vga registers pointed to by EgaPal [0..15] which
  can be any value in the range 0..64.
}
VAR
  Loop   : byte;
  EgaPal : EgaRegArray;

BEGIN
  if CurrentDisplay < Vga then exit;
  GetEgaPalette (EgaPal);
  for Loop := 0 to 15 do
    SetVgaRegister (EgaPal [Loop],
                    P [Loop, 1],
                    P [Loop, 2],
                    P [Loop, 3]);
END;

{ SetVgaRegister ========================================================== }

PROCEDURE SetVgaRegister (ColorReg, Red, Green, Blue : byte);
{ Resets Color Register Number (0-64) with R, G, B values 0-63. }

VAR
  R : registers;

BEGIN
  with R do begin
    AX := $1010;
    BX := ColorReg;
    DH := Red;
    CH := Green;
    CL := Blue;
    end;
  Intr ($10, R);
END;

{ UVactive ================================================================ }

FUNCTION UVactive : boolean;
{ Is UltraVision on? }

VAR
  R : registers;
BEGIN
  With R do begin
    AH := $CC;
    AL := $00;
    end;
  Intr ($10, R);
  if (R.CX = $ABCD) and (R.AL = $00) then        { UV installed?  active? }
    UVactive := true
  else
    UVactive := false;
END;

{ UVinstalled ============================================================= }

FUNCTION UVinstalled : boolean;
{ Is UltraVision present? }

VAR
  R : registers;
BEGIN
  With R do begin
    AH := $CC;
    AL := $00;
    end;
  Intr ($10, R);
  if R.CX = $ABCD then
    UVinstalled := true
  else
    UVinstalled := false;
END;

{ ========================================================================= }
{ Exit Process Variable =================================================== }

VAR
  ExitSave : pointer;                            { for ExitProc }

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

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

BEGIN
  ExitProc := ExitSave;                          { reset original address }

  HiddenMouseCursor;                             { ATI VGA-wonder bug? }
  HideMouse;                                     { no more mouse cursor }

{
  Restore a saved screen.  ScreenFlag is true if the system screen
  has been saved.
}
  if FadeFlag then begin
    FadeOut;
    DissolveProc := Zen;                       { reinstall dummy }
    FinalFadeOutProc;                          { user proc }
    VgaPal := StoreVgaPal;
    end;

  if BlinkFlag then                              { restore system blink }
    SetBlink (true)                              { to what it was before }
  else
    SetBlink (false);

  if ScreenFlag and (StoreDosScreen <> nil) then begin
    if FadeFlag then
      FadeIn (RestoreDosScreen, StoreDosMode)
    else
      RestoreDosScreen;
    end
  else begin
    SetMode (StoreDosMode);
    SetUvMode (StoreUvMode);
    SetEgaPalette (StoreEgaPal);
    SetVgaPalette (StoreVgaPal);
    end;

  if ScreenFlag then
    RestoreCursorState (StoreCursorLoc, StoreCursorSize)   { cursor on }
  else
    SetCursorSize (hi (StoreCursorSize), lo (StoreCursorSize));
  KeyStateByte := StoreKeyStateByte;             { restore shift keys }
  NormVideo;                                     { resets original TextAttr }
  CheckBreak := StoreCheckBreak;                 { restore BREAK }
END;

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

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

  StoreKeyStateByte := KeyStateByte;             { save shift key states }
  StoreScreenHeight := ScreenHeight;             { save number of rows }
  StoreScreenWidth  := ScreenWidth;              { save number of cols }
  StoreCheckBreak := CheckBreak;                 { save state of BREAK }

  CheckBreak := false;                           { no BREAK allowed }
  ScreenFlag := false;                           { don't restore DOS screen }
  FadeFlag   := false;                           { don't fade DOS back in }

{
  If Ega or Vga is installed and running, save the existing Ega and Vga
  palettes so they can be restored in the Exit unit if the program messes
  around with them.

  GetEgaPalette and GetVgaPalette will test for presence of Ega/Vga.
}
  StoreDosMode := CurrentMode;                   { save existing mode }
  StoreUvMode  := GetUvMode;                     { save existing mode }
  GetEgaPalette (StoreEgaPal);                   { save Ega palette }
  GetVgaPalette (StoreVgaPal);                   { save Vga palette }
  EgaPal := StoreEgaPal;                         { working palette }
  VgaPal := StoreVgaPal;                         { working palette }

{ Check for mono, get existing DOS mode ----------------------------------- }
{
  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;      { force b/w? }
    end;  {case}

{
  If system is running in mono, force mono.  The user has his own
  reasons for running in mono mode.
}
  Case StoreDosMode of
    bw40,
    bw80,
    Mono : DefColorChoice := ForceMono;
    end;  {case}

  if DefColorChoice = ForceMono then
    FadeToBlackFlag := true;

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

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

  GetCursorState
    (StoreCursorLoc, StoreCursorSize);           { save cursor loc, size }
  dec (StoreCursorLoc, 256);                     { adjust cursor row up 1 }

{
  There are some very obscure situations in which DOS will hide the
  cursor.  This happens when the scan lines are set for 32 and 0, or
  13 and 14.  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.
}
  case StoreCursorSize of                        { disappearing cursor }
    8192,                                        { lines 0, 32 }
    3342  : StoreCursorSize := 1543;             { lines 13, 14 }
    end;

  HiddenCursor;

{ Check for blinking ------------------------------------------------------ }

  BlinkFlag := BlinkByte and $20 = $20;          { system blink on? }

{ Misc -------------------------------------------------------------------- }

  DissolveProc     := Zen;                       { install dummy proc }
  FinalFadeOutProc := Zen;                       { install dummy proc }
  Randomize;
END.

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

VERSION HISTORY:
  9005.05
    Completely restructured for consistency with Object Professional.

  9006.01
    Added routine to check system blink status and restore it.

  9006.20
    Added Dissolve, FadeIn, FadeOut procedures.  VGA only.

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

ACKNOWLEDGMENTS:

  9006.01
    UltraVision is a product of Personics Corporation.
    63 Great Road, Maynard, MA  01754.
    Copyright 1987-1990 by M+H Consulting and John Jurewicz.

    UltraVision compatible routines are derived from the Ultra Vision
    manual, Appendix C:  Bios Interface.

  9006.01
    GetVgaRegister and SetVgaRegister routines are both from code
    supplied by Michael Covington, contributing editor of PC Techniques
    magazine.  Additional help by Tom Gryder and Steve Sneed.

  9006.22
    FadeIn, FadeOut, and FadeStart procedures added.

    When using graphics mode, always begin with FadeStart or
    SaveDosScreen, as this will restore the DOS screen on exit.  If
    you do not want to restore the DOS screen on exit, precede the
    call to SaveDosScreen with ClrScr.

    The idea behind these procedures is to automate the process
    of restoring DOS to its previous state when exiting the program.

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

NEED TO FIX:
  When in 50-line mode, even if not changing mode, there's a flicker as
  the mode is reset.  Why?


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