{******************************************************}
{*                                                    *}
{*                   OPCRT.PAS 1.30                   *}
{*                                                    *}
{*  Copyright (c) TurboPower Software 1987, 1992.     *}
{*                                                    *}
{*  Compatibility with Virtual Pascal for OS/2 v1.0:  *}
{*    Copyright (c) fPrint UK Ltd 1995                *}
{*                                                    *}
{*  Compatibility with Delphi 2.0 for Windows'95      *}
{*    Copyright (c) Konstantin Klyagin, 1997-98       *}
{*                                                    *}
{******************************************************}

unit OpCrt;
  {-Alternate CRT interface unit. Replaces Turbo's CRT unit.}

{$IFDEF OS2}

{$S-,R-,V-f,I-,B-,F-,O-,A-}

interface

uses
  OpInline,
  Use32,
  Os2Def,
  Os2Base,
  Dos;

  {low-level frame stuff}
const
  frTL = 0;
  frBL = 1;
  frTR = 2;
  frBR = 3;
  frTT = 4;
  frBB = 5;
  frLL = 6;
  frRR = 7;

type
  FrameCharType  = frTL..frRR;
  FrameArray     = array[FrameCharType] of Char;
  CursorType     = (cuNormal, cuFat, cuBlock, cuHidden, cuUnknown);
  RestrictCoords = Record
    X1, X2, Y1, Y2 : Byte;
  End;

const
  {video mode constants}
  BW40    = 0;
  CO40    = 1;
  C40     = CO40;
  BW80    = 2;
  CO80    = 3;
  C80     = CO80;
  Mono    = 7;
  Font8x8 = 256;

  {color constants}
  Black        = 0;
  Blue         = 1;
  Green        = 2;
  Cyan         = 3;
  Red          = 4;
  Magenta      = 5;
  Brown        = 6;
  LightGray    = 7;
  DarkGray     = 8;
  LightBlue    = 9;
  LightGreen   = 10;
  LightCyan    = 11;
  LightRed     = 12;
  LightMagenta = 13;
  Yellow       = 14;
  White        = 15;
  Blink        = 128;

  {special flag used by MapMono}
  AutoMapMono  = $FF;

const
  {Set to True to allow programs to run as background tasks under
   DesqView/TaskView. Must be set False for TSR's.}
  DetectMultitasking : Boolean = False;
  BiosScroll : Boolean = True; {False to use OPCRT routines for clean scrolling}

const
  FrameChars : FrameArray = 'ΥΤΈΎΝΝ³³';
  Restrict   : RestrictCoords = (X1: 0; X2: 0; Y1: 0; Y2: 0);
  scKoef     : Byte = 0;

const
  InsertCursor   : CursorType = cuFat;
  OvertypeCursor : CursorType = cuNormal;
  CtrlCharCursor : CursorType = cuBlock;

type
  DisplayType = (MonoHerc, CGA, MCGA, EGA, VGA, PGC);
  HercCardType = (HercNone, HercPlain, HercPlus, HercInColor);
  FlexAttrs = array[0..3] of Byte; {attributes for FlexWrite}

  {record used to save/restore window coordinates}
  WindowCoordinates =
    record
      XL, YL, XH, YH : Byte;
    end;

{from Turbo's CRT unit}

var
  CheckBreak : Boolean;      {enable Ctrl-Break checking}
  CheckEOF : Boolean;        {enable Ctrl-Z checking}
  DirectVideo : Boolean;     {write directly to screen?}
  CheckSnow : Boolean;       {True to prevent snow on CGA's}
  TextAttr : Byte;           {current video attribute}
  WindMin : Word;            {Window XLow and YLow: 0..24, 0..79 format}
  WindMax : Word;            {Window XHigh and YHigh: 0..24, 0..79 format}
  LastMode : Word;           {current video mode in low byte / 8x8 flag in high byte}

const
  CrtCheck : Boolean = True; {for internal use}

{unique to Object Professional version}

var
  CtrlBreakFlag : Boolean;   {set to true when ^Break pressed}
  CurrentPage : Byte;        {current video page}
  CurrentMode : Byte absolute LastMode; {current video mode}
  ScreenWidth : Word;        {current width of screen}
  ScreenHeight : Word;       {current height of screen}
  CurrentDisplay : DisplayType; {currently selected display adapter}
  EnhancedDisplay : DisplayType; {meaningful only if set to MCGA, VGA, or EGA}
  WhichHerc : HercCardType;  {type of Hercules card installed}
  InTextMode : Boolean;      {set to false when in graphics mode}
  NormalAttr : Byte;         {attribute for NormVideo}
  VideoSegment : Word;       {current segment for video memory}
  BufLen : Word;             {maximum length of string for Read/Ln}
  MultiTaskingOn : Boolean;  {needed to support DesqView, TaskView}
  OneMS : Word;              {loop count used for a 1 ms delay}
  SaveCtrlC : Boolean;       {was ^C checking on when program started?}
  {for backward compatibility}
  CurrentWidth : Word absolute ScreenWidth; {current width of display}
  CurrentHeight : Word;      {current height of display - 1}

var
  {hooks for virtual screens in OPWINDOW}
  VirtualSegment : Word;     {alternate segment for video memory}
  VideoLength     : SmallWord;
  VirtualWidth : Word;       {alternate width of display}
  VirtualHeight : Word;      {alternate height of display}

const
  DisplayOverride : ShortInt = -1; {use to override auto-detection of displays}

  UseEnhancedKbd : Boolean = False; {use to activate enhanced keyboard calls}

  {background character used by ClrScr, ScrollWindowUp/Down; gets reset to ' '
   automatically}
  TextChar : Char = ' ';
  HercExceptionReg : Byte = $27;

  {------------- miscellaneous default colors, etc. --------------}

type
  ColorChoice = (UseDefault, ForceColor, ForceMono);

const
  DefColorChoice : ColorChoice = UseDefault;

type
  ColorSetPtr = ^ColorSet;   {!!.20}
  ColorSet =
    object
      TextColor, TextMono : Byte;             {ordinary text}
      CtrlColor, CtrlMono : Byte;             {control characters}
      FrameColor, FrameMono : Byte;           {window frames}
      HeaderColor, HeaderMono : Byte;         {window headers}
      ShadowColor, ShadowMono : Byte;         {window shadows}
      HighlightColor, HighlightMono : Byte;   {found text, etc.}
      PromptColor, PromptMono : Byte;         {prompts}
      SelPromptColor, SelPromptMono : Byte;   {selected prompts}
      ProPromptColor, ProPromptMono : Byte;   {protected prompts}
      FieldColor, FieldMono : Byte;           {fields}
      SelFieldColor, SelFieldMono : Byte;     {selected fields}
      ProFieldColor, ProFieldMono : Byte;     {protected fields}
      ScrollBarColor, ScrollBarMono : Byte;   {scroll bars}
      SliderColor, SliderMono : Byte;         {slider in scroll bars}
      HotSpotColor, HotSpotMono : Byte;       {hot spots in frame corners}
      BlockColor, BlockMono : Byte;           {marked blocks}
      MarkerColor, MarkerMono : Byte;         {text markers}
      DelimColor, DelimMono : Byte;           {delimiters}
      SelDelimColor, SelDelimMono : Byte;     {selected delimiters}
      ProDelimColor, ProDelimMono : Byte;     {protected delimiters}
      SelItemColor, SelItemMono : Byte;       {selected pick and menu items}
      ProItemColor, ProItemMono : Byte;       {protected pick and menu items}
      HighItemColor, HighItemMono : Byte;     {highlight chars in pick and menu}
      AltItemColor, AltItemMono : Byte;       {alternate pick items}
      AltSelItemColor, AltSelItemMono : Byte; {alternate selected pick items}
      FlexAHelpColor, FlexAHelpMono : Byte;   {help flex highlight for ^A}
      FlexBHelpColor, FlexBHelpMono : Byte;   {help flex highlight for ^B}
      FlexCHelpColor, FlexCHelpMono : Byte;   {help flex highlight for ^C}
      UnselXrefColor, UnselXrefMono : Byte;   {unselected help xref}
      SelXrefColor, SelXrefMono : Byte;       {selected help xref}
      MouseColor, MouseMono : Byte;           {mouse colors}

      procedure SetTextAttr(Color, Mono : Byte);
        {-Set attributes for ordinary text}
      procedure SetCtrlAttr(Color, Mono : Byte);
        {-Set attributes for control characters}
      procedure SetFrameAttr(Color, Mono : Byte);
        {-Set attributes for window frames}
      procedure SetHeaderAttr(Color, Mono : Byte);
        {-Set attributes for window headers}
      procedure SetShadowAttr(Color, Mono : Byte);
        {-Set attributes for window shadows}
      procedure SetHighlightAttr(Color, Mono : Byte);
        {-Set attributes used to highlight found text}
      procedure SetPromptAttr(Color, Mono : Byte);
        {-Set attributes for entry field prompts}
      procedure SetSelectedPromptAttr(Color, Mono : Byte);
        {-Set attributes for selected entry field prompts}
      procedure SetProtectedPromptAttr(Color, Mono : Byte);
        {-Set attributes for protected entry field prompts}
      procedure SetFieldAttr(Color, Mono : Byte);
        {-Set attributes for unselected entry fields}
      procedure SetSelectedFieldAttr(Color, Mono : Byte);
        {-Set attributes for selected entry field fields}
      procedure SetProtectedFieldAttr(Color, Mono : Byte);
        {-Set attributes for protected entry fields}
      procedure SetScrollBarAttr(Color, Mono : Byte);
        {-Set attributes for scroll bars}
      procedure SetSliderAttr(Color, Mono : Byte);
        {-Set attributes for sliders in scroll bars}
      procedure SetHotSpotAttr(Color, Mono : Byte);
        {-Sets attributes for mouse hot spots}
      procedure SetBlockAttr(Color, Mono : Byte);
        {-Set attributes for marked blocks}
      procedure SetMarkerAttr(Color, Mono : Byte);
        {-Set attributes for text markers}
      procedure SetDelimAttr(Color, Mono : Byte);
        {-Set attributes for unselected entry field delimiters}
      procedure SetSelectedDelimAttr(Color, Mono : Byte);
        {-Set attributes for selected entry field delimiters}
      procedure SetProtectedDelimAttr(Color, Mono : Byte);
        {-Set attributes for protected entry field delimiters}
      procedure SetSelectedItemAttr(Color, Mono : Byte);
        {-Set attributes for selected pick and menu items}
      procedure SetProtectedItemAttr(Color, Mono : Byte);
        {-Set attributes for protected pick and menu items}
      procedure SetHighlightItemAttr(Color, Mono : Byte);
        {-Set attributes for highlighted selection characters for menu items}
      procedure SetAltItemAttr(Color, Mono : Byte);          {!!.01}
        {-Set attributes for alternate pick items}
      procedure SetAltSelItemAttr(Color, Mono : Byte);       {!!.01}
        {-Set attributes for alternate selected pick items}
      procedure SetFlexAHelpAttr(Color, Mono : Byte);
        {-Set attributes for help text surrounded by ^A}
      procedure SetFlexBHelpAttr(Color, Mono : Byte);
        {-Set attributes for help text surrounded by ^B}
      procedure SetFlexCHelpAttr(Color, Mono : Byte);
        {-Set attributes for help text surrounded by ^C}
      procedure SetUnselXrefAttr(Color, Mono : Byte);
        {-Set attributes for unselected cross-references in help text}
      procedure SetSelXrefAttr(Color, Mono : Byte);
        {-Set attributes for selected cross-references in help text}
      procedure SetMouseAttr(Color, Mono : Byte);
        {-Set attributes for mouse cursor}
    end;

const
  DefaultPasswordChar = ^G;
  DefaultPadChar = ' ';
  DefaultColorSet : ColorSet = (
    TextColor       : $07; TextMono       : $07;
    CtrlColor       : $07; CtrlMono       : $07;
    FrameColor      : $0F; FrameMono      : $0F;
    HeaderColor     : $0F; HeaderMono     : $0F;
    ShadowColor     : $07; ShadowMono     : $07;
    HighlightColor  : $70; HighlightMono  : $70;
    PromptColor     : $07; PromptMono     : $07;
    SelPromptColor  : $07; SelPromptMono  : $07;
    ProPromptColor  : $07; ProPromptMono  : $07;
    FieldColor      : $0F; FieldMono      : $0F;
    SelFieldColor   : $70; SelFieldMono   : $70;
    ProFieldColor   : $07; ProFieldMono   : $07;
    ScrollBarColor  : $07; ScrollBarMono  : $07;
    SliderColor     : $07; SliderMono     : $07;
    HotSpotColor    : $70; HotSpotMono    : $07;

    BlockColor      : $0F; BlockMono      : $0F;
    MarkerColor     : $70; MarkerMono     : $70;
    DelimColor      : $0F; DelimMono      : $0F;
    SelDelimColor   : $70; SelDelimMono   : $70;
    ProDelimColor   : $07; ProDelimMono   : $07;
    SelItemColor    : $70; SelItemMono    : $70;
    ProItemColor    : $00; ProItemMono    : $01;
    HighItemColor   : $0F; HighItemMono   : $0F;
    AltItemColor    : $0F; AltItemMono    : $0F;
    AltSelItemColor : $70; AltSelItemMono : $70;
    FlexAHelpColor  : $0F; FlexAHelpMono  : $0F;
    FlexBHelpColor  : $01; FlexBHelpMono  : $01;
    FlexCHelpColor  : $70; FlexCHelpMono  : $70;
    UnselXrefColor  : $09; UnselXrefMono  : $09;
    SelXrefColor    : $70; SelXrefMono    : $70;
    MouseColor      : $4F; MouseMono      : $70
  );

  function MakeHiddenAttr(A : Byte) : Byte;
    {-Make foreground and background colors the same}
  inline;
  begin
    MakeHiddenAttr := ( A shr 4 ) or A and $F0;
  end;

type
  ColorMapTable = array[0..255] of Byte;
const
  ColorMap : ColorMapTable = (
      {00   01   02   03   04   05   06   07   08   09   0A   0B   0C   0D   0E   0F}
 {00} $00, $01, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $0F, $0F,
 {10} $70, $01, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $0F, $0F,
 {20} $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70,
 {30} $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70,
 {40} $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70,
 {50} $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70,
 {60} $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70,
 {70} $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70, $70,
 {80} $80, $81, $87, $87, $87, $87, $87, $87, $87, $87, $87, $87, $87, $87, $8F, $8F,
 {90} $F0, $81, $87, $87, $87, $87, $87, $87, $87, $87, $87, $87, $87, $87, $8F, $8F,
 {A0} $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
 {B0} $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
 {C0} $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
 {D0} $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
 {E0} $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
 {F0} $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0
     );

{
procedure tWrite (S : String);
procedure tWriteLn (S : String);
Procedure CopyScr;
}

procedure TextMode(Mode : Word);
  {-Switch to/set text mode}

procedure Window(XLow, YLow, XHigh, YHigh : Byte);
  {-Set current window coordinates}

procedure ClrScr;
  {-Clear the current window}

procedure ClrEol;
  {-Clear the remainder of the current screen line}

procedure InsLine;
  {-Insert a new line at the position of the cursor}

procedure DelLine;
  {-Delete current screen line}

procedure GoToXY(X, Y : Byte);
  {-Move cursor to column X, row Y, relative to Window}

function WhereX : Byte;
  {-Return column coordinate of cursor, relative to Window}

function WhereY : Byte;
  {-Return row coordinate of cursor, relative to Window}

procedure TextColor(Color : Byte);
  {-Set foreground color for screen writes}

procedure TextBackground(Color : Byte);
  {-Set background color for screen writes}

procedure LowVideo;
  {-Select low intensity}

procedure HighVideo;
  {-Select high intensity}

procedure NormVideo;
  {-Select video attribute used at start of program}

function KeyPressed : Boolean;
  {-Return true if a key has been pressed}

function ReadKey : Char;
  {-Read a character from the keyboard}

procedure AssignCrt(var F : Text);
  {-Routes input and output through our routines}

procedure Delay(MS : Word);
  {-Delay for MS milliseconds}

procedure PlaySound(Freq,Duration: Longint);
  {-Play sound}


  {****** extensions to Turbo's CRT unit ******}

function GetCrtMode : Byte;
 {-Get the current video mode. Also reinitializes internal variables. May
   reset: CurrentMode, ScreenWidth, ScreenHeight, CurrentPage, and
   VideoSegment.}

procedure GotoXYAbs(X, Y : Byte);
  {-Move cursor to column X, row Y. No error checking done.}

function WhereXY : Word;
 {-Return absolute row and column coordinates of cursor. High byte has current
   row (Y), low byte has current column (X).}

function WhereYAbs : Byte;
  {-Return absolute row coordinate of cursor}

function WhereXAbs : Byte;
  {-Return absolute column coordinate of cursor}

procedure WhereXYdirect(var X, Y : Byte);
  {-Read the current position of the cursor directly from the CRT controller}

procedure SetVisiblePage(PageNum : Byte);
  {-Set current video page}

procedure SetActivePage(PageNo : Byte);
 {-Selects the video page that will be written to with subsequent operations
   on the screen. Does not affect Write/Ln or Read/Ln.}

function GetPageSegment(PageNo : Byte) : Word;
  {-Get the video segment corresponding to the specified video page}

function GetPagePointer(PageNo : Byte) : Pointer;
  {-Get a pointer to the start of the specified video page}

procedure ClearPage(PageNo : Byte);
  {-Clear the specified video page with TextChar and TextAttr}

procedure ScrollWindowUp(XLo, YLo, XHi, YHi, Lines : Byte);
  {-Scrolls the designated window up the specified number of lines.}

procedure ScrollWindowDown(XLo, YLo, XHi, YHi, Lines : Byte);
  {-Scrolls the designated window down the specified number of lines.}

function CursorTypeSL : Word;
  {-Returns a word. High byte has starting scan line, low byte has ending.}

function CursorStartLine : Byte;
  {-Returns the starting scan line of the cursor}

function CursorEndLine : Byte;
  {-Returns the ending scan line of the cursor.}

procedure SetCursorSize(Startline, EndLine : Byte);
  {-Sets the cursor's starting and ending scan lines.}

procedure NormalCursor;
  {-Set normal scan lines for cursor based on current video mode}

procedure FatCursor;
  {-Set larger scan lines for cursor based on current video mode}

procedure BlockCursor;
  {-Set scan lines for a block cursor}

procedure HiddenCursor;
  {-Hide the cursor}

procedure SetCursorType(CT : CursorType);
  {-Sets the cursor shape to the specified type}

function ClassifyCursorType : CursorType;
  {-Classify cursor type based on scan lines}

function ReadCharAtCursor : Char;
  {-Returns character at the current cursor location on the selected page.}

function ReadAttrAtCursor : Byte;
  {-Returns attribute at the current cursor location on the selected page.}

procedure GetCursorState(var XY, ScanLines : Word);
  {-Return the current position and size of the cursor}

procedure RestoreCursorState(XY, ScanLines : Word);
  {-Reset the cursor to a position and size saved with GetCursorState}

procedure FastWrite(St : string; Row, Col : Word; Attr : Byte);
  {-Write St at Row,Col in Attr (video attribute) without snow}

procedure FastText(St : string; Row, Col : Word);
  {-Write St at Row,Col without changing the underlying video attribute.}

procedure FastVert(St : string; Row, Col : Word; Attr : Byte);
  {-Write St vertically at Row,Col in Attr (video attribute)}

procedure FastFill(Number : Word; Ch : Char; Row, Col : Word; Attr : Byte);
  {-Fill Number chs at Row,Col in Attr (video attribute) without snow}

procedure FastFillVert(Number : Word; Ch : Char; Row, Col : Word; Attr : Byte); {!!.03}
  {-Fill Number chs vertically at Row,Col in Attr (video attribute)} {!!.03}

procedure FastCenter(St : string; Row, Attr : Byte);
  {-Write St centered on window Row in Attr (video attribute) without snow}

procedure FastFlush(St : string; Row, Attr : Byte);
  {-Write St flush right on window Row in Attr (video attribute) without snow}

procedure FastRead(Number : Byte; Row, Col : Word; var St : string);
  {-Read Number characters from the screen into St starting at Row,Col}

procedure ReadAttribute(Number : Byte; Row, Col : Word; var St : string);
  {-Read Number attributes from the screen into St starting at Row,Col}

procedure WriteAttribute(St : String; Row, Col : Word);
  {-Write string of attributes St at Row,Col without changing characters}

procedure ChangeAttribute(Number : Word; Row, Col : Word; Attr : Byte);
  {-Change Number video attributes to Attr starting at Row,Col}

procedure MoveScreen(var Source, Dest; Length : Word);
  {-Move Length words from Source to Dest without snow}

procedure FastWriteAttr(St : String; Row, Col : Word; AttrSt : String);
  {-Write St at Row,Col using attributes in AttrSt}

procedure FlexWrite(St : string; Row, Col : Word; var FAttrs : FlexAttrs);
  {-Write St at Row,Col with flexible color handling}

function FlexLen(S : string) : Byte;
  {-Return actual (visible) length of a flex string}

procedure FastWriteCtrl(St : String; Row, Col : Word; Attr, Ctrl : Byte);
  {-Write St at Row,Col in Attr (video attribute) without snow.
    Control characters displayed in Ctrl as upper-case letters}

function SaveWindow(XLow, YLow, XHigh, YHigh : Byte; Allocate : Boolean;
                    var Covers : Pointer) : Boolean;
  {-Allocate buffer space if requested and save window contents}

procedure RestoreWindow(XLow, YLow, XHigh, YHigh : Byte;
                        Deallocate : Boolean; var Covers : Pointer);
  {-Restore screen contents and deallocate buffer space if requested}

procedure ClearWindow(XLow, YLow, XHigh, YHigh : Word; Ch : Char; A : Byte);
  {-Clear a window using the specified character and attribute}

procedure FrameWindow(LeftCol, TopRow, RightCol, BotRow : Word;
                      FAttr, HAttr : Byte;
                      Header : string);
  {-Draws a frame around a window}

procedure StoreWindowCoordinates(var WC : WindowCoordinates);
  {-Store the window coordinates for the active window}

procedure RestoreWindowCoordinates(WC : WindowCoordinates);
  {-Restore previously saved window coordinates}

function MapColor(C : Byte) : Byte;
  {-Map a video attribute for visibility on mono/bw displays}

function UseColor : Boolean;
  {-Returns True if color video attributes should be used}

function ColorMono(Color, Mono : Byte) : Byte;
  {-Choose between a color and a monochrome video attribute}

function MapMono(Color, Mono : Byte) : Byte;
  {-Return a mapped color video attribute if Mono = $FF}

procedure SetBlink(On : Boolean);
  {-Enable text mode attribute blinking if On is True}

procedure RestBlink;
  {-Restore blinking attr}

procedure SetCrtBorder(Attr : Byte);
  {-Set border to background color if card type and mode allow}

function Font8x8Selected : Boolean;
  {-Return True if EGA or VGA is active and in 8x8 font}

procedure SelectFont8x8(On : Boolean);
  {-Toggle 8x8 font on or off}

function HercPresent : Boolean;
  {-Return true if a Hercules graphics card is present}

procedure SwitchInColorCard(ColorOn : Boolean);
  {-Activate or deactivate colors on a Hercules InColor card}

function HercGraphicsMode : Boolean;
  {-Return True if a Hercules card is in graphics mode}

function HercModeTestWorks : Boolean;
  {-Return True if HercGraphicsMode will work}

procedure SetHercMode(GraphMode : Boolean; GraphPage : Byte);
 {-Set Hercules card to graphics mode or text mode, and activate specified
   graphics page (if switching to graphics mode).}

function ReadKeyWord : Word;
 {-Waits for keypress, then returns scan and character codes together}

function CheckKbd(var KeyCode : Word) : Boolean;
  {-Returns True (and the key codes) if a keystroke is waiting}

function KbdFlags : Byte;
  {-Returns keyboard status flags as a bit-coded byte}

function EnhancedKbdInstalled : Boolean;
  {-Returns True if an enhanced keyboard is installed}

procedure StuffKey(W : Word);
  {-Stuff one key into the keyboard buffer}

procedure StuffString(S : string);
  {-Stuff the contents of S into the keyboard buffer}

procedure ReInitCrt;
  {-Reinitialize CRT unit's internal variables. For TSR's or programs with
    DOS shells. May reset: CurrentMode, ScreenWidth, ScreenHeight,
    WindMin/WindMax, CurrentPage, CurrentDisplay, CheckSnow, and VideoSegment.}

procedure DelayCalibrate;
  {-Perform delay calibration}

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

implementation

{.$I opcrt.in2}

type
  BufPtr = ^BufferArray;
  BufferArray = array[0..MaxInt] of Char;
  BiosNameType = Array[1..6] of Char;                               {!!.20}

var
  SystemSeg    : Word;
  SaveExitProc : Pointer;
  OldBlink     : Byte;

  Procedure Unsupported;
    begin
      Writeln('Function not supported!');
      Halt;
    end;

  {$I VPCRT.IN1}
  {$I OPCRT.IN1}    {Hercules stuff, alternate video page routines}

  procedure InitMemorySegments;                               {!!.20 - new}
    {-initialize important vars from segment/selector data}
  begin
  end;

  procedure CrtTest;
    {-Test for presence of CRT in program}
  begin
    if CrtCheck then
    If TextRec( Input ).OpenFunc <> TextRec( System.Input ).OpenFunc then
        begin
          WriteLn('CRT/OPCRT conflict');
          Halt(1);
        end;
  end;

  procedure NormalCursor;
    {-Set normal scan lines for cursor based on current video mode}
  var
    ScanLines : Word;
  begin
    if (Hi(LastMode) <> 0) then
      ScanLines := $0507
    else
      if CurrentMode = 7 then
        ScanLines := $0B0C
      else
        ScanLines := $0C0D;
    SetCursorSize(Hi(ScanLines), Lo(ScanLines));
  end;

  procedure FatCursor;
    {-Set larger scan lines for cursor based on current video mode}
  var
    ScanLines : Word;
  begin
    if (Hi(LastMode) <> 0) then
      ScanLines := $0307
    else if CurrentMode = 7 then
      ScanLines := $090C
    else
      ScanLines := $0507;
    SetCursorSize(Hi(ScanLines), Lo(ScanLines));
  end;

  procedure BlockCursor;
    {-Set scan lines for a block cursor}
  var
    EndLine : Byte;
  begin
    if (Hi(LastMode) <> 0) or (CurrentMode <> 7) then
      EndLine := $07
    else
      EndLine := $0C;
    SetCursorSize(0, EndLine);
  end;

  procedure HiddenCursor;
    {-Hide the cursor}
  begin
    SetCursorSize($20, 0);
  end;

  procedure SetCursorType(CT : CursorType);
    {-Sets the cursor shape to the specified type}
  begin
    case CT of
      cuNormal : NormalCursor;
      cuFat    : FatCursor;
      cuBlock  : BlockCursor;
      else       HiddenCursor;
    end;
  end;

  function ClassifyCursorType : CursorType;
    {-Classify cursor type based on scan lines}
  var
    CT : Word;
  begin
    CT := CursorTypeSL;
    if CT = $2000 then
      ClassifyCursorType := cuHidden
    else if Hi(LastMode) <> 0 then
      case CT of
        $0507 : ClassifyCursorType := cuNormal;
        $0307 : ClassifyCursorType := cuFat;
        $0007 : ClassifyCursorType := cuBlock;
        else    ClassifyCursorType := cuUnknown;
      end
    else if CurrentMode = 7 then
      case CT of
        $0B0C : ClassifyCursorType := cuNormal;
        $090C : ClassifyCursorType := cuFat;
        $000C : ClassifyCursorType := cuBlock;
        else    ClassifyCursorType := cuUnknown;
      end
    else
      case CT of
        $0607 : ClassifyCursorType := cuNormal;
        $0507 : ClassifyCursorType := cuFat;
        $0007 : ClassifyCursorType := cuBlock;
        else    ClassifyCursorType := cuUnknown;
      end;
  end;

  procedure GetCursorState(var XY, ScanLines : Word);
    {-Return the current position and size of the cursor}
  begin
    XY := WhereXY;
    ScanLines := CursorTypeSL;
  end;

  procedure RestoreCursorState(XY, ScanLines : Word);
    {-Reset the cursor to a position and size saved with GetCursorState}
  begin
    SetCursorSize(Hi(ScanLines), Lo(ScanLines));
    GotoXYAbs(Lo(XY), Hi(XY));
  end;

  procedure WhereXYdirect(var X, Y : Byte);
    {-Read the current position of the cursor directly from the CRT controller}
    begin
      X := WhereX;
      Y := WhereY;
    end;

  function EnhancedKbdInstalled : Boolean;
    {-Returns True if an enhanced keyboard is installed}
  Var
    rc      : ApiRet16;
    HwId    : KbdHwId;
    Handle  : SmallWord;

  begin
    EnhancedKbdInstalled := False;

    rc := KbdOpen( Handle );
    If rc <> No_Error then
      Exit;

    HwId.cb := Sizeof( HwId );
    rc := KbdGetHwId( HwId, Handle );
    If rc = No_Error then
      EnhancedKbdInstalled := ( HwId.IdKbd = keyboard_Enhanced_101 ) or
                              ( HwId.IdKbd = keyboard_Enhanced_122 );

    rc := KbdClose( Handle );
  end;

  procedure StuffKey(W : Word);
    {-Stuff one key into the keyboard buffer}
    begin
      Unsupported;
    end;

  procedure StuffString(S : string);
    {-Stuff the contents of S into the keyboard buffer}
  var
    I : Byte;
  begin
    {allow at most 15 characters}
    if Length(S) > 15 then
      S[0] := #15;

    {stuff each key}
    for I := 1 to Length(S) do
      StuffKey(Ord(S[I]));
  end;

  function SaveWindow(XLow, YLow, XHigh, YHigh : Byte; Allocate : Boolean;
                      var Covers : Pointer) : Boolean;
    {-Allocate buffer space if requested and save window contents}
  var
    CoversP : BufPtr absolute Covers;
    WordsPerRow : Word;
    BufBytes : Word;
    SrcPos : Word;
    DestPos : Word;
    Row : Word;
  begin
    {assume success}
    SaveWindow := True;

    {compute number of words to move per row}
    WordsPerRow := Succ(XHigh-XLow);

    if Allocate then begin
      {compute bytes needed for screen buffer}
      BufBytes := (WordsPerRow*Succ(YHigh-YLow)) shl 1;

      {make sure enough memory is available}
      if MaxAvail < LongInt(BufBytes) then begin
        SaveWindow := False;
        Exit;
      end
      else
        {allocate the screen buffer}
        GetMem(CoversP, BufBytes);
    end;

    {save current contents to the screen buffer}
    DestPos := 0;
    SrcPos := (Pred(YLow)*VirtualWidth+Pred(XLow)) shl 1;
    for Row := YLow to YHigh do begin
      MoveScreen(Mem[VirtualSegment+SrcPos], CoversP^[DestPos], WordsPerRow);
      Inc(SrcPos, VirtualWidth shl 1);
      Inc(DestPos, WordsPerRow shl 1);
    end;
  end;

  procedure RestoreWindow(XLow, YLow, XHigh, YHigh : Byte;
                          Deallocate : Boolean; var Covers : Pointer);
    {-Restore screen contents and deallocate buffer space if requested}
  var
    CoversP : BufPtr absolute Covers;
    WordsPerRow : Word;
    SrcPos : Word;
    DestPos : Word;
    Row : Word;
  begin
    {compute number of words to move per row}
    WordsPerRow := Succ(XHigh-XLow);

    {Restore current contents to the screen buffer}
    DestPos := 0;
    SrcPos := (Pred(YLow)*VirtualWidth+Pred(XLow)) shl 1;
    for Row := YLow to YHigh do begin
      MoveScreen(CoversP^[DestPos], Mem[VirtualSegment+SrcPos], WordsPerRow);
      Inc(SrcPos, VirtualWidth shl 1);
      Inc(DestPos, WordsPerRow shl 1);
    end;

    {deallocate buffer space if requested}
    if Deallocate then begin
      FreeMem(CoversP, (WordsPerRow*Succ(YHigh-YLow)) shl 1);
      CoversP := nil;
    end;
  end;

  procedure ClearWindow(XLow, YLow, XHigh, YHigh : Word; Ch : Char; A : Byte);
    {-Clear a window using the specified character and attribute}
  var
    Row, Width : Word;
  begin
    Width := Succ(XHigh-XLow);
    for Row := YLow to YHigh do
      FastFill(Width, Ch, Row, XLow, A);
  end;

  procedure FrameWindow(LeftCol, TopRow, RightCol, BotRow : Word;
                        FAttr, HAttr : Byte; Header : string);
    {-Draws a frame around a window}
  var
    HeaderLen : Byte absolute Header;
    Row, Width, HeaderPos : Word;
  begin
    {calculate width of window}
    if RightCol <= LeftCol then     {!!.03}
      Width := 0                    {!!.03}
    else                            {!!.03}
      Width := RightCol-LeftCol-1;

    {draw the upper border}
    FastFill(1,     FrameChars[frTL], TopRow, LeftCol, FAttr);
    if Width > 0 then               {!!.03}
      FastFill(Width, FrameChars[frTT], TopRow, LeftCol+1, FAttr);
    FastFill(1,     FrameChars[frTR], TopRow, RightCol, FAttr);

    {draw the header}
    if HeaderLen > 0 then begin
      if HeaderLen > Width then
        HeaderLen := Width;
      HeaderPos := (Width-HeaderLen) shr 1;
      FastWrite(Header, TopRow, LeftCol+HeaderPos+1, HAttr);
    end;

    {draw the vertical bars}
    for Row := Succ(TopRow) to Pred(BotRow) do begin
      FastFill(1, FrameChars[frLL], Row, LeftCol, FAttr);
      FastFill(1, FrameChars[frRR], Row, RightCol, FAttr);
    end;

    {draw the bottom border}
    FastFill(1,     FrameChars[frBL], BotRow, LeftCol, FAttr);
    if Width > 0 then      {!!.03}
      FastFill(Width, FrameChars[frBB], BotRow, LeftCol+1, FAttr);
    FastFill(1,     FrameChars[frBR], BotRow, RightCol, FAttr);
  end;

  procedure SetBlink(On : Boolean);
    {-Enable text mode attribute blinking if On is True}
  var
    State       : VioIntensity;

  begin
    State. cb := SizeOf (State);
    State. rType := 2;
    VioGetState (State, 0);
    State. cb := SizeOf (State);
    State. rType := 2;
    OldBlink := State. fs;
    State. fs := Ord (Not On);
    VioSetState (State, 0);
  end;

  procedure RestBlink;
    {-Restore blinking attr}
  var
    State       : VioIntensity;
  begin
    State. cb := SizeOf (State);
    State. rType := 2;
    VioGetState (State, 0);
    State. cb := SizeOf (State);
    State. rType := 2;
    State. fs := OldBlink;
    VioSetState (State, 0);
  end;

  procedure SetCrtBorder(Attr : Byte); {!!.01}
    {-Set border to background color if card type and mode allow}
  begin
    Unsupported;
  end;

  function MapColor(C : Byte) : Byte;
    {-Map a video attribute for visibility on mono/bw displays}
  begin
    if UseColor then
      MapColor := C
    else
      MapColor := ColorMap[C];
  end;

  function UseColor : Boolean;
    {-Returns True if color video attributes should be used}
  begin
    if (DefColorChoice <> UseDefault) then
      UseColor := (DefColorChoice = ForceColor)
    else case CurrentMode of
      0, 2 :
        UseColor := False;
      7 :
        UseColor := (WhichHerc = HercInColor);
      else
        UseColor := True;
    end;
  end;

  function ColorMono(Color, Mono : Byte) : Byte;
    {-Choose between a color and a monochrome video attribute}
  begin
    if UseColor then
      ColorMono := Color
    else
      ColorMono := Mono;
  end;

  function MapMono(Color, Mono : Byte) : Byte;
    {-Return a mapped video attribute if Mono = $FF}
  begin
    if Mono = AutoMapMono then
      MapMono := ColorMap[Color]
    else
      MapMono := Mono;
  end;

  procedure StoreWindowCoordinates(var WC : WindowCoordinates);
    {-Store the window coordinates for the active window}
  type
    XY = record
           X, Y : Byte;
         end;
  begin
    with WC do begin
      XL := Succ(XY(WindMin).X);
      YL := Succ(XY(WindMin).Y);
      XH := Succ(XY(WindMax).X);
      YH := Succ(XY(WindMax).Y);
    end;
  end;

  procedure RestoreWindowCoordinates(WC : WindowCoordinates);
    {-Restore previously saved window coordinates}
  begin
    with WC do
      Window(XL, YL, XH, YH);
  end;

  procedure ColorSet.SetTextAttr(Color, Mono : Byte);
    {-Set attribute for ordinary text}
  begin
    TextColor := Color;
    TextMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetCtrlAttr(Color, Mono : Byte);
    {-Set attribute for control characters}
  begin
    CtrlColor := Color;
    CtrlMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetFrameAttr(Color, Mono : Byte);
    {-Set attribute for frames}
  begin
    FrameColor := Color;
    FrameMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetHeaderAttr(Color, Mono : Byte);
    {-Set attribute for headers}
  begin
    HeaderColor := Color;
    HeaderMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetShadowAttr(Color, Mono : Byte);
    {-Set attribute for shadows}
  begin
    ShadowColor := Color;
    ShadowMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetHighlightAttr(Color, Mono : Byte);
    {-Set attribute for highlighted text}
  begin
    HighlightColor := Color;
    HighlightMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetPromptAttr(Color, Mono : Byte);
    {-Set attribute for prompts}
  begin
    PromptColor := Color;
    PromptMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetSelectedPromptAttr(Color, Mono : Byte);
    {-Set attribute for prompts}
  begin
    SelPromptColor := Color;
    SelPromptMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetProtectedPromptAttr(Color, Mono : Byte);
    {-Set attribute for protected prompts}
  begin
    ProPromptColor := Color;
    ProPromptMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetFieldAttr(Color, Mono : Byte);
    {-Set attribute for unselected fields}
  begin
    FieldColor := Color;
    FieldMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetSelectedFieldAttr(Color, Mono : Byte);
    {-Set attribute for selected fields}
  begin
    SelFieldColor := Color;
    SelFieldMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetProtectedFieldAttr(Color, Mono : Byte);
    {-Set attribute for protected/disabled fields}
  begin
    ProFieldColor := Color;
    ProFieldMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetScrollBarAttr(Color, Mono : Byte);
    {-Set attribute for scroll bars}
  begin
    ScrollBarColor := Color;
    ScrollBarMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetSliderAttr(Color, Mono : Byte);
    {-Set attribute for sliders in scroll bars}
  begin
    SliderColor := Color;
    SliderMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetHotSpotAttr(Color, Mono : Byte);
    {-Set attribute for hot spots in frame corners}
  begin
    HotSpotColor := Color;
    HotSpotMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetBlockAttr(Color, Mono : Byte);
    {-Set attribute for marked blocks}
  begin
    BlockColor := Color;
    BlockMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetMarkerAttr(Color, Mono : Byte);
    {-Set attribute for text markers}
  begin
    MarkerColor := Color;
    MarkerMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetDelimAttr(Color, Mono : Byte);
    {-Set attribute for unselected delimiters}
  begin
    DelimColor := Color;
    DelimMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetSelectedDelimAttr(Color, Mono : Byte);
    {-Set attribute for selected delimiters}
  begin
    SelDelimColor := Color;
    SelDelimMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetProtectedDelimAttr(Color, Mono : Byte);
    {-Set attribute for protected/disabled delimiters}
  begin
    ProDelimColor := Color;
    ProDelimMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetSelectedItemAttr(Color, Mono : Byte);
    {-Set attribute for selected pick and menu items}
  begin
    SelItemColor := Color;
    SelItemMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetProtectedItemAttr(Color, Mono : Byte);
    {-Set attribute for protected pick and menu items}
  begin
    ProItemColor := Color;
    ProItemMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetHighlightItemAttr(Color, Mono : Byte);
    {-Set attribute for protected pick and menu items}
  begin
    HighItemColor := Color;
    HighItemMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetAltItemAttr(Color, Mono : Byte);    {!!.01}
    {-Set attributes for alternate pick items}
  begin
    AltItemColor := Color;
    AltItemMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetAltSelItemAttr(Color, Mono : Byte); {!!.01}
    {-Set attributes for alternate selected pick items}
  begin
    AltSelItemColor := Color;
    AltSelItemMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetFlexAHelpAttr(Color, Mono : Byte);
    {-Set attribute for help text surrounded by ^A}
  begin
    FlexAHelpColor := Color;
    FlexAHelpMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetFlexBHelpAttr(Color, Mono : Byte);
    {-Set attribute for help text surrounded by ^B}
  begin
    FlexBHelpColor := Color;
    FlexBHelpMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetFlexCHelpAttr(Color, Mono : Byte);
    {-Set attribute for help text surrounded by ^C}
  begin
    FlexCHelpColor := Color;
    FlexCHelpMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetUnselXrefAttr(Color, Mono : Byte);
    {-Set attribute for unselected help cross-references}
  begin
    UnselXrefColor := Color;
    UnselXrefMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetSelXrefAttr(Color, Mono : Byte);
    {-Set attribute for selected help cross-references}
  begin
    SelXrefColor := Color;
    SelXrefMono := MapMono(Color, Mono);
  end;

  procedure ColorSet.SetMouseAttr(Color, Mono : Byte);
    {-Set attribute for mouse cursor}
  begin
    MouseColor := Color;
    MouseMono := MapMono(Color, Mono);
  end;

  procedure FindSystemSeg;
    {-Find the segment for SYSTEM}
    {!!.21 rewritten for compatibility with pmode}
  var
    F : Text;
  begin
    {try to detect presence of CRT in the same program}
    Assign(F, '');
    If TextRec(F).OpenFunc <> TextRec(Input).OpenFunc then
      CrtTest;
  end;

function VPCtrlBreak(Report:       PExceptionReportRecord;
                     Registration: PExceptionRegistrationRecord;
                     Context:      PContextRecord;
                     P:            Pointer): ULong; cdecl;
begin
  if not CheckBreak and (Report^.ExceptionNum = xcpt_Signal)
    then VPCtrlBreak := xcpt_Continue_Execution
    else VPCtrlBreak := xcpt_Continue_Search;
end;

  procedure Break; {!!.22}
    {-Halt if break pressed (called from ASM)}
  begin
    Halt(255);
  end;

begin
  InitMemorySegments;  {initialize important pointers/selectors}      {!!.20}

  {find the segment for SYSTEM}
  FindSystemSeg;

  {initialize global variables}
  CheckBreak := True;
  CheckEOF := False;

  {initialize internal variables}
  InitCrt;

  {reopen Input}
  AssignCrt(Input);
  Reset(Input);

  {reopen Output}
  AssignCrt(Output);
  Rewrite(Output);

{$ENDIF}

{$IFDEF MSDOS}

{$S-,R-,V-,I-,B-,F-,A-,O+}

interface

uses
  OpInline;

const
  frTL = 0;
  frBL = 1;
  frTR = 2;
  frBR = 3;
  frTT = 4;
  frBB = 5;
  frLL = 6;
  frRR = 7;

type
  FrameCharType  = frTL..frRR;
  FrameArray     = array[FrameCharType] of Char;
  CursorType     = (cuNormal, cuFat, cuBlock, cuHidden, cuUnknown);
  RestrictCoords = Record
    X1, X2, Y1, Y2 : Byte;
  End;

const
  {video mode constants}
  BW40 = 0;
  CO40 = 1;
  C40 = CO40;
  BW80 = 2;
  CO80 = 3;
  C80 = CO80;
  Mono = 7;
  Font8x8 = 256;

  {color constants}
  Black = 0;
  Blue = 1;
  Green = 2;
  Cyan = 3;
  Red = 4;
  Magenta = 5;
  Brown = 6;
  LightGray = 7;
  DarkGray = 8;
  LightBlue = 9;
  LightGreen = 10;
  LightCyan = 11;
  LightRed = 12;
  LightMagenta = 13;
  Yellow = 14;
  White = 15;
  Blink = 128;

const
 {Set to True to allow programs to run as background tasks under
  DesqView/TaskView. Must be set False for TSR's.}
  DetectMultitasking : Boolean = False;
  BiosScroll : Boolean = True; {False to use TPCRT routines for clean scrolling}

const
  FrameChars : FrameArray = 'ΥΤΈΎΝ³';
  Restrict   : RestrictCoords = (X1: 0; X2: 0; Y1: 0; Y2: 0);
  scKoef     : Byte = 0;

const
  MapColors : Boolean = True; {True to let MapColor map colors for mono visibility}

type
  DisplayType = (MonoHerc, CGA, MCGA, EGA, VGA, PGC);
  HercCardType = (HercNone, HercPlain, HercPlus, HercInColor);
  FlexAttrs = array[0..3] of Byte; {attributes for FlexWrite}

  {record used to save/restore window coordinates}
  WindowCoordinates =
    record
      XL, YL, XH, YH : Byte;
    end;

var
  {from Turbo's CRT unit}
  CheckBreak : Boolean;      {enable Ctrl-Break checking}
  CheckEOF : Boolean;        {enable Ctrl-Z checking}
  DirectVideo : Boolean;     {write directly to screen?}
  CheckSnow : Boolean;       {True to prevent snow on CGA's}
  TextAttr : Byte;           {current video attribute}
  WindMin : Word;            {Window XLow and YLow: 0..24, 0..79 format}
  WindMax : Word;            {Window XHigh and YHigh: 0..24, 0..79 format}
  LastMode : Word;           {current video mode in low byte / 8x8 flag in high byte}
  {$IFDEF Ver40}
  SaveInt1B : Pointer;       {old INT $1B handler}
  {$ENDIF}

  {unique to Turbo Professional version}
  CtrlBreakFlag : Boolean;   {set to true when ^Break pressed}
  CurrentPage : Byte;        {current video page}
  CurrentMode : Byte absolute LastMode; {current video mode}
  ScreenWidth : Word;        {current width of screen}
  ScreenHeight : Word;       {current height of screen}
  CurrentDisplay : DisplayType; {currently selected display adapter}
  EnhancedDisplay : DisplayType; {meaningful only if set to MCGA, VGA, or EGA}
  WhichHerc : HercCardType;  {type of Hercules card installed}
  InTextMode : Boolean;      {set to false when in graphics mode}
  NormalAttr : Byte;         {attribute for NormVideo}
  VideoSegment : Word;       {current segment for video memory}
  BufLen : Word;             {maximum length of string for Read/Ln}
  MultiTaskingOn : Boolean;  {needed to support DesqView, TaskView}
  OneMS : Word;              {loop count used for a 1 ms delay}
  {for backward compatibility}
  CurrentWidth : Word absolute ScreenWidth; {current width of display}
  CurrentHeight : Word;      {current height of display - 1}
var
  {hooks for virtual screens in TPWINDOW}
  VirtualSegment : Word;     {alternate segment for video memory}
  VirtualWidth : Word;       {alternate width of display}

const
  DisplayOverride : ShortInt = -1; {use to override auto-detection of displays}
  {background character used by ClrScr, ScrollWindowUp/Down; gets reset to ' '
   automatically}
  TextChar : Char = ' ';

type
  PackedScreen = array[1..4000] of Byte; {dummy--actual size varies}
  PackedWindow =             {!!do not change!!}
    record
      Size   : Word;         {size of packed window, including this header}
      TopRow : Byte;         {coordinates for top left corner of window}
      TopCol : Byte;
      Rows   : Byte;         {height of window}
      Cols   : Byte;         {width of window}
      AStart : Word;         {index to start of attributes section in Contents}
      CDelta : Word;         {bytes before first PackRec - chars}
      ADelta : Word;         {bytes before first PackRec - attrs}
      Contents : PackedScreen; {the contents of the packed screen}
    end;
  PackedWindowPtr = ^PackedWindow;

const
  deInUse = 0;
  deUnused = -1;
  deDeleted = -2;

type
  LibName = string[12];
  deName = array[1..11] of Char; {first 8 have name, last 3 have extension}
  DirectoryEntry =
    record
      Status       : ShortInt; {0 = in use, -1 = unused, -2 = deleted}
      Name         : deName;   {name and extension in FCB format}
      Index        : Word;     {index to this member}
      MemberLength : Word;     {# of 128-byte blocks used by member}
      CRC          : Word;     {not implemented}
      CreationDate : Word;     {date entry was created--not used}
      LastChangeDate : Word;   {date it was last changed--not used}
      CreationTime : Word;     {time entry was created--not used}
      LastChangeTime : Word;   {time it was last changed--not used}
      PadCount     : Byte;     {unused bytes in last block of member}
      Filler : array[28..32] of Byte; {padded to 32 bytes}
    end;
  DirectoryType = array[0..255] of DirectoryEntry;
  DirectoryPtr = ^DirectoryType;

const
  BlankDeName : deName = '           ';

const
  CrtError : Word = 0;
  {non-standard error codes for CrtError}
  CrtNotEnoughMem = $FFFF;
  CrtNilPointer = $FFFE;
  CrtNotValidLib = $FFFD;
  CrtWinNotFound = $FFFC;
  CrtDirectoryFull = $FFFB;
  CrtBadWindow = $FFFA;

  {unit codes for use in conjunction with TPHELP--see manual}
  HelpForUser  = 00;         {unused}
  HelpForPick  = 01;         {TPPICK}
  HelpForEdit  = 02;         {TPEDIT}
  HelpForMenu  = 03;         {TPMENU}
  HelpForEntry = 04;         {TPENTRY}
  HelpForMacEd = 05;         {TPMACED}
  HelpForMemo  = 06;         {TPMEMO}
  HelpForXXXX2 = 07;         {reserved}
  HelpForXXXX3 = 08;         {reserved}
  HelpForXXXX4 = 09;         {reserved}
  HelpForXXXX5 = 10;         {reserved}

{
procedure tWrite (S : String);
procedure tWriteLn (S : String);
Procedure CopyScr;
}

procedure TextMode(Mode : Word);
  {-Switch to/set text mode}

procedure Window(XLow, YLow, XHigh, YHigh : Byte);
  {-Set current window coordinates}

procedure ClrScr;
  {-Clear the current window}

procedure ClrEol;
  {-Clear the remainder of the current screen line}

procedure InsLine;
  {-Insert a new line at the position of the cursor}

procedure DelLine;
  {-Delete current screen line}

procedure GoToXY(X, Y : Byte);
  {-Move cursor to column X, row Y, relative to Window}

function WhereX : Byte;
  {-Return column coordinate of cursor, relative to Window}

function WhereY : Byte;
  {-Return row coordinate of cursor, relative to Window}

procedure TextColor(Color : Byte);
  {-Set foreground color for screen writes}

procedure TextBackground(Color : Byte);
  {-Set background color for screen writes}

procedure LowVideo;
  {-Select low intensity}

procedure HighVideo;
  {-Select high intensity}

procedure NormVideo;
  {-Select video attribute used at start of program}

function KeyPressed : Boolean;
  {-Return true if a key has been pressed}

function ReadKey : Char;
  {-Read a character from the keyboard}

procedure AssignCrt(var F : Text);
  {-Routes input and output through our routines}

procedure Delay(MS : Word);
  {-Delay for MS milliseconds}

procedure Sound(Hz : Word);
  {-Turn on the sound at the designated frequency}

procedure NoSound;
  {-Turn off the sound}

procedure PlaySound (Freq, Duration: Longint);

  {****** extensions to Turbo's CRT unit ******}

function GetCrtMode : Byte;
 {-Get the current video mode. Also reinitializes internal variables. May
   reset: CurrentMode, ScreenWidth, ScreenHeight, CurrentPage, and
   VideoSegment.}

procedure GotoXYAbs(X, Y : Byte);
  {-Move cursor to column X, row Y. No error checking done.}

function WhereXY : Word;
 {-Return absolute row and column coordinates of cursor. High byte has current
   row (Y), low byte has current column (X).}

function WhereYAbs : Byte;
  {-Return absolute row coordinate of cursor}

function WhereXAbs : Byte;
  {-Return absolute column coordinate of cursor}

procedure WhereXYdirect(var X, Y : Byte);
  {-Read the current position of the cursor directly from the CRT controller}

procedure SetVisiblePage(PageNum : Byte);
  {-Set current video page}

procedure ScrollWindowUp(XLo, YLo, XHi, YHi, Lines : Byte);
  {-Scrolls the designated window up the specified number of lines.}

procedure ScrollWindowDown(XLo, YLo, XHi, YHi, Lines : Byte);
  {-Scrolls the designated window down the specified number of lines.}

function CursorTypeSL : Word;
  {-Returns a word. High byte has starting scan line, low byte has ending.}

function CursorStartLine : Byte;
  {-Returns the starting scan line of the cursor}

function CursorEndLine : Byte;
  {-Returns the ending scan line of the cursor.}

procedure SetCursorSize(Startline, EndLine : Byte);
  {-Sets the cursor's starting and ending scan lines.}

procedure NormalCursor;
  {-Set normal scan lines for cursor based on current video mode}

procedure FatCursor;
  {-Set larger scan lines for cursor based on current video mode}

procedure BlockCursor;
  {-Set scan lines for a block cursor}

procedure HiddenCursor;
  {-Hide the cursor}

function ReadCharAtCursor : Char;
  {-Returns character at the current cursor location on the selected page.}

function ReadAttrAtCursor : Byte;
  {-Returns attribute at the current cursor location on the selected page.}

procedure GetCursorState(var XY, ScanLines : Word);
  {-Return the current position and size of the cursor}

procedure RestoreCursorState(XY, ScanLines : Word);
  {-Reset the cursor to a position and size saved with GetCursorState}

procedure FastWrite(St : string; Row, Col, Attr : Byte);
  {-Write St at Row,Col in Attr (video attribute) without snow}

procedure FastWriteWindow(St : string; Row, Col, Attr : Byte);
  {-Write a string using window-relative coordinates}

procedure FastText(St : string; Row, Col : Byte);
  {-Write St at Row,Col without changing the underlying video attribute.}

procedure FastTextWindow(St : string; Row, Col : Byte);
  {-Write St at window Row,Col without changing the underlying video attribute.}

procedure FastVert(St : string; Row, Col, Attr : Byte);
  {-Write St vertically at Row,Col in Attr (video attribute)}

procedure FastVertWindow(St : string; Row, Col, Attr : Byte);
  {-Write a string vertically using window-relative coordinates}

procedure FastFill(Number : Word; Ch: Char; Row, Col, Attr : Byte);
  {-Fill Number chs at Row,Col in Attr (video attribute) without snow}

procedure FastFillWindow(Number : Word; Ch : Char; Row, Col, Attr : Byte);
  {-Fill Number chs at window Row,Col in Attr (video attribute) without snow}

procedure FastCenter(St : string; Row, Attr : Byte);
  {-Write St centered on window Row in Attr (video attribute) without snow}

procedure FastFlush(St : string; Row, Attr : Byte);
  {-Write St flush right on window Row in Attr (video attribute) without snow}

procedure FastRead(Number, Row, Col : Byte; var St : string);
  {-Read Number characters from the screen into St starting at Row,Col}

procedure FastReadWindow(Number, Row, Col : Byte; var St : string);
  {-Read Number characters from the screen into St starting at window Row,Col}

procedure ReadAttribute(Number, Row, Col : Byte; var St : string);
  {-Read Number attributes from the screen into St starting at Row,Col}

procedure ReadAttributeWindow(Number, Row, Col : Byte; var St : string);
  {-Read Number attributes from the screen into St starting at window Row,Col}

procedure WriteAttribute(St : String; Row, Col : Byte);
  {-Write string of attributes St at Row,Col without changing characters}

procedure WriteAttributeWindow(St : String; Row, Col : Byte);
  {-Write string of attributes St at window Row,Col without changing characters}

procedure ChangeAttribute(Number : Word; Row, Col, Attr : Byte);
  {-Change Number video attributes to Attr starting at Row,Col}

procedure ChangeAttributeWindow(Number : Word; Row, Col, Attr : Byte);
  {-Change Number video attributes to Attr starting at window Row,Col}

procedure MoveScreen(var Source, Dest; Length : Word);
  {-Move Length words from Source to Dest without snow}

procedure FlexWrite(St : string; Row, Col : Byte; var FAttrs : FlexAttrs);
  {-Write St at Row,Col with flexible color handling}

procedure FlexWriteWindow(St : string; Row, Col : Byte; var FAttrs : FlexAttrs);
  {-Write a string flexibly using window-relative coordinates.}

function SaveWindow(XLow, YLow, XHigh, YHigh : Byte; Allocate : Boolean;
                    var Covers : Pointer) : Boolean;
  {-Allocate buffer space if requested and save window contents}

procedure RestoreWindow(XLow, YLow, XHigh, YHigh : Byte;
                        Deallocate : Boolean; var Covers : Pointer);
  {-Restore screen contents and deallocate buffer space if requested}

procedure FrameWindow(LeftCol, TopRow, RightCol, BotRow : Word;
                      FAttr, HAttr : Byte; Header : string);
  {-Draws a frame around a window}

procedure StoreWindowCoordinates(var WC : WindowCoordinates);
  {-Store the window coordinates for the active window}

procedure RestoreWindowCoordinates(WC : WindowCoordinates);
  {-Restore previously saved window coordinates}

function PackWindow(XLow, YLow, XHigh, YHigh : Byte) : PackedWindowPtr;
  {-Return a pointer to a packed window, or nil if not enough memory}

procedure DispPackedWindow(PWP : PackedWindowPtr);
  {-Display the packed window pointed to by PWP}

procedure DispPackedWindowAt(PWP : PackedWindowPtr; Row, Col : Byte);
 {-Display the packed window pointed to by PWP at Row,Col. If necessary,
   the coordinates are adjusted to allow it to fit on the screen.}

procedure MapPackedWindowColors(PWP : PackedWindowPtr);
 {-Map the colors in a packed window for improved appearance on mono/B&W
   displays}

procedure DisposePackedWindow(var PWP : PackedWindowPtr);
  {-Dispose of a packed window, setting PWP to nil on exit}

procedure DisposePackedWindowLarge(var PWP : PackedWindowPtr);


procedure WritePackedWindow(PWP : PackedWindowPtr; FName : string);
 {-Store the packed window pointed to by PWP in FName}

function ReadPackedWindow(FName : string) : PackedWindowPtr;
 {-Read the packed window stored in FName into memory}

function CreateLibrary(var F : file; Name : string;
                       Entries : Byte) : DirectoryPtr;
 {-Create a library with the specified # of directory entries}

function OpenLibrary(var F : file; Name : string) : DirectoryPtr;
 {-Open the specified library and return a pointer to its directory}

procedure CloseLibrary(var F : file; var DP : DirectoryPtr);
  {-Close library F and deallocate its directory}

procedure PackLibrary(LName : string);
 {-Pack a library to remove deleted entries.}

procedure AddWindowToLibrary(PWP : PackedWindowPtr; var F : file;
                             DP : DirectoryPtr; WinName : LibName);
 {-Add a packed window to the specified library}

function ReadWindowFromLibrary(var F : file; DP : DirectoryPtr;
                               WinName : LibName) : PackedWindowPtr;
 {-Read a packed window from a library}

procedure DeleteWindowFromLibrary(var F : file; DP : DirectoryPtr;
                                  WinName : LibName);
 {-Delete a packed window from the specified library}

function MapColor(c : Byte) : Byte;
  {-Map a video attribute for visibility on mono/bw displays}

procedure SetBlink(On : Boolean);
  {-Enable text mode attribute blinking if On is True}

procedure RestBlink;
  {-Restore blinking attr}

procedure SetCrtBorder(Attr : Byte);
  {-Set border to background color if card type and mode allow}

function Font8x8Selected : Boolean;
  {-Return True if EGA or VGA is active and in 8x8 font}

procedure SelectFont8x8(On : Boolean);
  {-Toggle 8x8 font on or off}

function HercPresent : Boolean;
  {-Return true if a Hercules graphics card is present}

procedure SwitchInColorCard(ColorOn : Boolean);
  {-Activate or deactivate colors on a Hercules InColor card}

function HercGraphicsMode : Boolean;
  {-Return True if a Hercules card is in graphics mode}

function HercModeTestWorks : Boolean;
  {-Return True if HercGraphicsMode will work}

procedure SetHercMode(GraphMode : Boolean; GraphPage : Byte);
 {-Set Hercules card to graphics mode or text mode, and activate specified
   graphics page (if switching to graphics mode).}

function ReadKeyWord : Word;
 {-Waits for keypress, then returns scan and character codes together}

function CheckKbd(var KeyCode : Word) : Boolean;
  {-Returns True (and the key codes) if a keystroke is waiting}

function KbdFlags : Byte;
  {-Returns keyboard status flags as a bit-coded byte}

procedure StuffKey(W : Word);
  {-Stuff one key into the keyboard buffer}

procedure StuffString(S : string);
  {-Stuff the contents of S into the keyboard buffer}

procedure ClearWindow(XLow, YLow, XHigh, YHigh : Word; Ch : Char; A : Byte);

procedure ReInitCrt;
 {-Reinitialize CRT unit's internal variables. For TSR's or programs with
   DOS shells. May reset: CurrentMode, ScreenWidth, ScreenHeight,
   WindMin/WindMax, CurrentPage, CurrentDisplay, CheckSnow, and VideoSegment.}

  {the following are for internal use only}
const
  CrtCheck : Boolean = True;
  TpUnitsFlag : Byte = 0;
  TpScreenFlag = 1;
  TpWindowFlag = 2;

type
  PackRec =                  {!!do not change!!}
    record
      Link    : Word;           {number of bytes to next PackRec}
      FillVal : Byte;        {fill value}
      FillCnt : Word;        {fill count}
    end;

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

implementation

type
  FIB =
    record
      Handle : Word;
      Mode : Word;
      BufSize : Word;
      Private : Word;
      BufPos : Word;
      BufEnd : Word;
      BufPtr : Pointer;
      OpenProc : Pointer;
      InOutProc : Pointer;
      FlushProc : Pointer;
      CloseProc : Pointer;
      UserData : array[1..16] of Byte;
      Name : array[0..79] of Char;
      Buffer : array[1..128] of Char;
    end;

  SegOfs =
    record
      Ofst, Segm : Word;
    end;

var
  Vector23 : Pointer absolute $0 : $8C;
  SystemSeg : Word;

type
  BufPtr = ^BufferArray;
  BufferArray = array[0..MaxInt] of Char;

var
  BiosScanLines : Word absolute $40 : $60;
  IsCompaq : Boolean;
  CompaqBiosName : array[1..6] of Char absolute $FFFE : $000A;
  IsZenith : Boolean absolute IsCompaq;
  ZenithBiosName : array[1..6] of Char absolute $FB00 : $0000;
  NextChar : Byte;
  SaveExitProc : Pointer;
  {$IFDEF Ver40}
    Save1B : Pointer absolute SaveInt1B;
  {$ELSE}
    Save1B : Pointer;
  {$ENDIF}

const
  {tables for Hercules graphics}
  HercTtable : array[0..11] of Byte = (
    $61, $50, $52, $0F, $19, $06, $19, $19, $02, $0D, $0B, $0C);
  HercGtable : array[0..11] of Byte = (
    $35, $2D, $2E, $07, $5B, $02, $57, $57, $02, $03, $00, $00);

  {$L TPCRT.OBJ}
  {$L TPCRT2.OBJ}
  {$L TPFAST.OBJ}
  {$L TPFAST2.OBJ}
  {$L TPCMISC.OBJ}
  {$L TPPACK.OBJ}
  {$L TPFLEX.OBJ}

  {local routines in TPCRT.OBJ}
  procedure ReadCursorPrim; external;
  procedure SetCursorPrim; external;
  procedure GetCursorPrim; external;
  procedure GetCrtModePrim; external;
  procedure ScrollUpPrim; external;
  procedure ScrollDownPrim; external;
  procedure AdapterCheck; external;
  procedure DelayMS; external;
  procedure GetCharAttr; external;
  procedure SetWindowPrim; external;
  procedure FullWindow; external;
  procedure GetAttribute; external;
  procedure InitCrt; external;
  procedure CalcOffset; external;

  {global routines in TPCRT.OBJ}
  function ReadKey : Char; external;
  procedure AssignCrt(var F : Text); external;
  procedure ReInitCrt; external;

  {routines in TPCRT2.OBJ}
  procedure TextMode(Mode : Word); external;
  procedure Window(XLow, YLow, XHigh, YHigh : Byte); external;
  procedure ClrScr; external;
  procedure GoToXY(X, Y : Byte); external;
  function WhereX : Byte; external;
  function WhereY : Byte; external;
  procedure TextColor(Color : Byte); external;
  procedure TextBackground(Color : Byte); external;
  procedure LowVideo; external;
  procedure HighVideo; external;
  procedure NormVideo; external;
  function KeyPressed : Boolean; external;
  procedure Delay(MS : Word); external;
  function GetCrtMode : Byte; external;
  procedure GotoXYAbs(X, Y : Byte); external;
  function Font8x8Selected : Boolean; external;
  procedure SelectFont8x8(On : Boolean); external;
  function ReadKeyWord : Word; external;

  {routines in TPCMISC.OBJ}
  procedure ClrEol; external;
  procedure InsLine; external;
  procedure DelLine; external;
  procedure Sound(Hz : Word); external;
  procedure NoSound; external;
  function WhereXY : Word; external;
  function WhereXAbs : Byte; external;
  function WhereYAbs : Byte; external;
  function ReadCharAtCursor : Char; external;
  function ReadAttrAtCursor : Byte; external;
  procedure SetVisiblePage(PageNum : Byte); external;
  procedure ScrollWindowUp(XLo, YLo, XHi, YHi, Lines : Byte); external;
  procedure ScrollWindowDown(XLo, YLo, XHi, YHi, Lines : Byte); external;
  function CursorTypeSL : Word; external;
  function CursorStartLine : Byte; external;
  function CursorEndLine : Byte; external;
  procedure SetCursorSize(Startline, EndLine : Byte); external;
  function KbdFlags : Byte; external;
  function CheckKbd(var KeyCode : Word) : Boolean; external;

  {routines in TPFAST.OBJ}
  procedure FastWrite(St : string; Row, Col, Attr : Byte); external;
  procedure FastWriteWindow(St : string; Row, Col, Attr : Byte); external;
  procedure FastRead(Number, Row, Col : Byte; var St : string); external;
  procedure FastReadWindow(Number, Row, Col : Byte; var St : string); external;
  procedure ReadAttribute(Number, Row, Col : Byte; var St : string); external;
  procedure ReadAttributeWindow(Number, Row, Col : Byte; var St : string); external;
  procedure ChangeAttribute(Number : Word; Row, Col, Attr : Byte); external;
  procedure ChangeAttributeWindow(Number : Word; Row, Col, Attr : Byte); external;
  procedure MoveScreen(var Source, Dest; Length : Word); external;

  {routines in TPFAST2.OBJ}
  procedure FastText(St : string; Row, Col : Byte); external;
  procedure FastTextWindow(St : string; Row, Col : Byte); external;
  procedure FastVert(St : string; Row, Col, Attr : Byte); external;
  procedure FastVertWindow(St : string; Row, Col, Attr : Byte); external;
  procedure FastFill(Number : Word; Ch : Char; Row, Col, Attr : Byte); external;
  procedure FastFillWindow(Number : Word; Ch : Char; Row, Col, Attr : Byte); external;
  procedure FastCenter(St : string; Row, Attr : Byte); external;
  procedure FastFlush(St : string; Row, Attr : Byte); external;
  procedure WriteAttribute(St : String; Row, Col : Byte); external;
  procedure WriteAttributeWindow(St : String; Row, Col : Byte); external;

  {routines in TPFLEX.OBJ}
  procedure FlexWrite(St : string; Row, Col : Byte; var FAttrs : FlexAttrs); external;
  procedure FlexWriteWindow(St : string; Row, Col : Byte; var FAttrs : FlexAttrs); external;

  {routines in TPPACK.OBJ}
  function PackPrim(Height, Width : Byte; DstSeg, DstOfs, SrcOfs : Word;
    var Delta : Word) : Word; external;
  procedure DispPackedWindow(PWP : PackedWindowPtr); external;

{.$I opcrt.in2}

  procedure CrtTest;
    {-Test for presence of CRT in program}
  begin
    if CrtCheck then
      with SegOfs(FIB(Input).InOutProc) do
        if (Segm <> CSeg) and (Segm <> SystemSeg) then begin
          WriteLn('CRT/TPCRT conflict');
          Halt(1);
        end;
  end;

  procedure NormalCursor;
    {-Set normal scan lines for cursor based on current video mode}
  var
    ScanLines : Word;
  begin
    if (Hi(LastMode) <> 0) then
      ScanLines := $0507
    else
      if CurrentMode = 7 then
        ScanLines := $0B0C
      else
        ScanLines := $0607;
    SetCursorSize(Hi(ScanLines), Lo(ScanLines));
  end;

  procedure FatCursor;
    {-Set larger scan lines for cursor based on current video mode}
  var
    ScanLines : Word;
  begin
    if (Hi(LastMode) <> 0) then
      ScanLines := $0307
    else if CurrentMode = 7 then
      ScanLines := $090C
    else
      ScanLines := $0507;
    SetCursorSize(Hi(ScanLines), Lo(ScanLines));
  end;

  procedure BlockCursor;
    {-Set scan lines for a block cursor}
  var
    EndLine : Byte;
  begin
    if (Hi(LastMode) <> 0) or (CurrentMode <> 7) then
      EndLine := $07
    else
      EndLine := $0C;
    SetCursorSize(0, EndLine);
  end;

  procedure PlaySound (Freq, Duration: Longint);
  begin
    Sound (Freq);
    Delay (Duration);
    NoSound;
  end;

  procedure HiddenCursor;
    {-Hide the cursor}
  begin
    SetCursorSize($20, 0);
  end;

  procedure GetCursorState(var XY, ScanLines : Word);
    {-Return the current position and size of the cursor}
  begin
    XY := WhereXY;
    ScanLines := CursorTypeSL;
  end;

  procedure RestoreCursorState(XY, ScanLines : Word);
    {-Reset the cursor to a position and size saved with GetCursorState}
  begin
    SetCursorSize(Hi(ScanLines), Lo(ScanLines));
    GotoXYAbs(Lo(XY), Hi(XY));
  end;

  procedure WhereXYdirect(var X, Y : Byte);
    {-Read the current position of the cursor directly from the CRT controller}
  var
    CrtPort : Word absolute $40:$63;
    CrtWidth : Word absolute $40:$4A;
    CrtLen   : Word absolute $40:$4C; {!!.08}
    XP, XY : Word;
  begin
    Port[CrtPort] := 14;
    XP := Port[CrtPort+1];
    Port[CrtPort] := 15;
    XY := ((XP shl 8)+Port[CrtPort+1]) mod (CrtLen shr 1); {!!.08}
    Y := Succ(XY div CrtWidth);
    X := Succ(XY mod CrtWidth);
  end;

  procedure StuffKey(W : Word);
    {-Stuff one key into the keyboard buffer}
  const
    KbdStart = $1E;
    KbdEnd = $3C;
  var
    KbdHead : Word absolute $40 : $1A;
    KbdTail : Word absolute $40 : $1C;
    SaveKbdTail : Word;
  begin
    SaveKbdTail := KbdTail;
    if KbdTail = KbdEnd then
      KbdTail := KbdStart
    else
      Inc(KbdTail, 2);
    if KbdTail = KbdHead then
      KbdTail := SaveKbdTail
    else
      MemW[$40:SaveKbdTail] := W;
  end;

  procedure StuffString(S : string);
    {-Stuff the contents of S into the keyboard buffer}
  var
    I : Byte;
  begin
    {allow at most 15 characters} {!!.07}
    if Length(S) > 15 then        {!!.07}
      S[0] := #15;                {!!.07}

    {stuff each key}
    for I := 1 to Length(S) do
      StuffKey(Ord(S[I]));
  end;

  function SaveWindow(XLow, YLow, XHigh, YHigh : Byte; Allocate : Boolean;
                      var Covers : Pointer) : Boolean;
    {-Allocate buffer space if requested and save window contents}
  var
    CoversP : BufPtr absolute Covers;
    WordsPerRow : Word;
    BufBytes : Word;
    SrcPos : Word;
    DestPos : Word;
    Row : Word;
  begin
    {assume success}
    SaveWindow := True;

    {compute number of words to move per row}
    WordsPerRow := Succ(XHigh-XLow);

    if Allocate then begin
      {compute bytes needed for screen buffer}
      BufBytes := (WordsPerRow*Succ(YHigh-YLow)) shl 1;

      {make sure enough memory is available}
      if MaxAvail < LongInt(BufBytes) then begin
        SaveWindow := False;
        Exit;
      end
      else
        {allocate the screen buffer}
        GetMem(CoversP, BufBytes);
    end;

    {save current contents to the screen buffer}
    DestPos := 0;
    SrcPos := (Pred(YLow)*ScreenWidth+Pred(XLow)) shl 1;
    for Row := YLow to YHigh do begin
      MoveScreen(Mem[VideoSegment:SrcPos], CoversP^[DestPos], WordsPerRow);
      Inc(SrcPos, ScreenWidth shl 1);
      Inc(DestPos, WordsPerRow shl 1);
    end;
  end;

  procedure RestoreWindow(XLow, YLow, XHigh, YHigh : Byte;
                          Deallocate : Boolean; var Covers : Pointer);
    {-Restore screen contents and deallocate buffer space if requested}
  var
    CoversP : BufPtr absolute Covers;
    WordsPerRow : Word;
    SrcPos : Word;
    DestPos : Word;
    Row : Word;
  begin
    {compute number of words to move per row}
    WordsPerRow := Succ(XHigh-XLow);

    {Restore current contents to the screen buffer}
    DestPos := 0;
    SrcPos := (Pred(YLow)*ScreenWidth+Pred(XLow)) shl 1;
    for Row := YLow to YHigh do begin
      MoveScreen(CoversP^[DestPos], Mem[VideoSegment:SrcPos], WordsPerRow);
      Inc(SrcPos, ScreenWidth shl 1);
      Inc(DestPos, WordsPerRow shl 1);
    end;

    {deallocate buffer space if requested}
    if Deallocate then begin
      FreeMem(CoversP, (WordsPerRow*Succ(YHigh-YLow)) shl 1);
      CoversP := nil;
    end;
  end;

  procedure FrameWindow(LeftCol, TopRow, RightCol, BotRow : Word;
                        FAttr, HAttr : Byte; Header : string);
    {-Draws a frame around a window}
  var
    HeaderLen : Byte absolute Header;
    Row, Width, HeaderPos : Word;
  begin
    {calculate width of window}
    if RightCol <= LeftCol then     {!!.03}
      Width := 0                    {!!.03}
    else                            {!!.03}
      Width := RightCol-LeftCol-1;

    {draw the upper border}
    FastFill(1,     FrameChars[frTL], TopRow, LeftCol, FAttr);
    if Width > 0 then               {!!.03}
      FastFill(Width, FrameChars[frTT], TopRow, LeftCol+1, FAttr);
    FastFill(1,     FrameChars[frTR], TopRow, RightCol, FAttr);

    {draw the header}
    if HeaderLen > 0 then begin
      if HeaderLen > Width then
        HeaderLen := Width;
      HeaderPos := (Width-HeaderLen) shr 1;
      FastWrite(Header, TopRow, LeftCol+HeaderPos+1, HAttr);
    end;

    {draw the vertical bars}
    for Row := Succ(TopRow) to Pred(BotRow) do begin
      FastFill(1, FrameChars[frLL], Row, LeftCol, FAttr);
      FastFill(1, FrameChars[frRR], Row, RightCol, FAttr);
    end;

    {draw the bottom border}
    FastFill(1,     FrameChars[frBL], BotRow, LeftCol, FAttr);
    if Width > 0 then      {!!.03}
      FastFill(Width, FrameChars[frBB], BotRow, LeftCol+1, FAttr);
    FastFill(1,     FrameChars[frBR], BotRow, RightCol, FAttr);
  end;

  function MapColor(c : Byte) : Byte;
    {-Map a video attribute for visibility on mono/bw displays}
  const
    MonoTable : array[0..15] of Byte = (
      0, 1, 7, 7, 7, 7, 7, 7,   7, 7, 7, 7, 7, 7, 15, 15);
  var
    Fore, Back : Byte;
  begin
    if MapColors then begin
      Fore := c and $F;
      Back := (c shr 4) and $7;
      if WhichHerc <> HercInColor then
        case CurrentMode of
          0, 2, 7 :
            {B&W modes}
            begin
              Fore := MonoTable[Fore];
              Back := MonoTable[Back];
            end;
        end;
      if (CurrentMode = 7) and (WhichHerc <> HercInColor) then
        {Monochrome mode}
        if (Fore or Back) <> 0 then
          {Not black on black}
          if (Fore = 0) or (Back = $07) then begin
            {Force to reverse video}
            Fore := 0;
            Back := $7;
          end
          else if Back <> 0 then
            {Force to black background}
            Back := 0;
      if (c and $80) <> 0 then
        {Set blink}
        Back := Back or $08;
      MapColor := Byte(Back shl 4) or Fore;
    end
    else
      MapColor := c;
  end;

  procedure StoreWindowCoordinates(var WC : WindowCoordinates);
    {-Store the window coordinates for the active window}
  type
    XY = record
           X, Y : Byte;
         end;
  begin
    with WC do begin
      XL := Succ(XY(WindMin).X);
      YL := Succ(XY(WindMin).Y);
      XH := Succ(XY(WindMax).X);
      YH := Succ(XY(WindMax).Y);
    end;
  end;

  procedure RestoreWindowCoordinates(WC : WindowCoordinates);
    {-Restore previously saved window coordinates}
  begin
    with WC do
      Window(XL, YL, XH, YH);
  end;

  function HercPresent : Boolean;
    {-Return true if a Hercules graphics card is present}
  begin
    inline(
      $31/$DB/               {xor bx,bx}
      $CD/$11/               {int $11}
      $25/$30/$00/           {and ax,$30     ;check equipment list}
      $3D/$30/$00/           {cmp ax,$30     ;"switches" set for mono?}
      $75/$18/               {jne done       ;no - quit}
      $BA/$BA/$03/           {mov dx,$3BA    ;Take a reading}
      $EC/                   {in al,dx}
      $24/$80/               {and al,$80}
      $88/$C4/               {mov ah,al      ;Save bit 7 for test}
      $B9/$00/$80/           {mov cx,$8000   ;How many times to test}
                             {Examine:}
      $EC/                   {in al,dx       ;Take another reading}
      $24/$80/               {and al,$80     ;Isolate bit 7}
      $38/$E0/               {cmp al,ah}
      $75/$05/               {jne herc       ;If bit 7 changes then it}
      $E2/$F7/               {loop examine   ; is a Hercules}
      $E9/$01/$00/           {jmp done       ;it must be something else}
                             {Herc:}
      $43/                   {inc bx         ;return true}
                             {Done:}
      $88/$5E/$FF);          {mov [bp-1],bl  ;set function result}
  end;

  function WhichHercPrim : HercCardType;
    {-Distinguish HGC, HGC+, and InColor card}
  inline(
    $BA/$BA/$03/             {mov dx,$3ba   ;read status port}
    $EC/                     {in al,dx}
    $88/$C4/                 {mov ah,al     ;result into AH}
    $80/$E4/$70/             {and ah,$70    ;mask out bits 4-6}
    $B0/$03/                 {mov al,3      ;assume HercInColor}
    $80/$FC/$50/             {cmp ah,$50    ;just bits 4 and 6 set?}
    $74/$09/                 {je done       ;if so, done}
    $FE/$C8/                 {dec al        ;assume HercPlus}
    $80/$FC/$10/             {cmp ah,$10    ;just bit 4 set?}
    $74/$02/                 {je done       ;if so, done}
    $FE/$C8);                {dec al        ;else, HercPlain}
                             {done:}

  function WhichHercCard : HercCardType;
    {-Returns Hercules card type}
  begin
    if (CurrentDisplay <> MonoHerc) or not HercPresent then
      WhichHercCard := HercNone
    else if (CurrentDisplay = MonoHerc) then
      WhichHercCard := WhichHercPrim
    else
      WhichHercCard := HercPlain;
  end;

  procedure SwitchInColorCard(ColorOn : Boolean);
    {-Activate or deactivate colors on a Hercules InColor card}
  begin
    inline(
      $8A/$66/<ColorOn/      {mov ah,[bp+<ColorOn] ;AH = ColorOn}
      $80/$F4/$01/           {xor ah,1             ;flip bit 0}
      $B1/$05/               {mov cl,5             ;move it to bit 5}
      $D2/$E4/               {shl ah,cl            ;!!}
      $B0/$17/               {mov al,$17           ;AL = Exception Register #}
      $BA/$B4/$03/           {mov dx,$3B4          ;DX = I/O port}
      $EF);                  {out dx,ax}
  end;

  function HercGraphModePrim : Boolean;
    {-Return True if a Hercules card is in graphics mode}
  begin
    inline(
      $30/$C0/               {XOR AL,AL}
      $BA/$BA/$03/           {MOV DX,$03BA    ;display status port}
                             {Wait1:          ;test for v-sync transition}
      $EC/                   {IN AL,DX}
      $A8/$80/               {TEST AL,$80     ;mask for v-sync}
      $74/$FB/               {JZ Wait1}
                             {Wait2:}
      $EC/                   {IN AL,DX}
      $A8/$80/               {TEST AL,$80     ;mask for v-sync}
      $75/$FB/               {JNZ Wait2}
      $30/$C0/               {XOR AL,AL       ;reset and Set Light Pen.}
      $BA/$BB/$03/           {MOV DX,$03BB    ;reset light pen port}
      $EE/                   {OUT DX,AL}
      $EB/$00/               {JMP SHORT X1    ;Delay for AT}
                             {X1:}
      $BA/$B9/$03/           {MOV DX,$03B9    ;set light pen port}
      $EE/                   {OUT DX,AL}
      $B0/$10/               {MOV AL,16       ;Look in the 6845 for the offset}
      $BA/$B4/$03/           {MOV DX,$03B4    ; into buffer when the light pen}
      $EE/                   {OUT DX,AL       ; is tripped - high byte.}
      $EB/$00/               {JMP SHORT X2    ;Delay for AT}
                             {X2:}
      $42/                   {INC DX}
      $EC/                   {IN AL,DX}
      $88/$C7/               {MOV BH,AL}
      $B0/$11/               {MOV AL,17       ;Get low byte of light pen}
      $BA/$B4/$03/           {MOV DX,$03B4    ; trip address}
      $EE/                   {OUT DX,AL}
      $EB/$00/               {JMP SHORT X3    ;Delay for AT}
                             {X3:}
      $42/                   {INC DX}
      $EC/                   {IN AL,DX}
      $88/$C3/               {MOV BL,AL       ;BX now contains Light Pen trip address}
      $30/$C0/               {XOR AL,AL       ;assume text mode}
      $81/$FB/$8E/$0B/       {CMP BX,$0B8E    ;If BX < threshold value - text mode}
      $72/$02/               {JB HGMPdone     ;Jump to what should happen for text}
      $FE/$C0/               {INC AL          ;return true for graph mode}
                             {HGMPdone:}
      $88/$46/$FF);          {MOV [BP-1],AL}
  end;

  function HercGraphicsMode : Boolean;
    {-Return True if a Hercules card is in graphics mode}
  const
    Votes = 5;               {keep it odd}
  var
    I, Graph : Byte;
  begin
    Graph := 0;
    {run test several times--it doesn't always work, even on a true Herc}
    for I := 1 to Votes do
      if HercGraphModePrim then
        Inc(Graph);
    {if test succeeded more times than it failed, it's a Herc}
    HercGraphicsMode := (Graph > (Votes shr 1));
  end;

  function HercModeTestWorks : Boolean;
    {-Return True if HercGraphicsMode will work}
  begin
    inline(
      $30/$DB/               {XOR BL,BL     ;assume False}
      $BA/$B9/$03/           {MOV DX,$03B9  ;set light pen address}
      $EE/                   {OUT DX,AL}
      $BA/$BA/$03/           {MOV DX,$03BA  ;display status port}
      $EC/                   {IN AL,DX}
      $A8/$02/               {TEST AL,2}
      $74/$0E/               {JZ HMTWdone   ;If light pen stuck low, can't do mode test - abort}
      $BA/$BB/$03/           {MOV DX,$03BB  ;reset light pen address}
      $EE/                   {OUT DX,AL}
      $BA/$BA/$03/           {MOV DX,$03BA  ;display status port}
      $EC/                   {IN AL,DX}
      $A8/$02/               {TEST AL,2}
      $75/$02/               {JNZ HMTWdone  ;If light pen stuck high, can't do mode test - abort}
      $FE/$C3/               {INC BL        ;test works}
                             {HMTWdone:}
      $88/$5E/$FF);          {MOV [BP-1],BL ;set function result}
  end;

  procedure SetHercMode(GraphMode : Boolean; GraphPage : Byte);
    {-Set Hercules card to graphics mode or text mode, and activate specified
      graphics page (if switching to graphics mode).}
  begin
    inline(
      $EB/$21/               {JMP SHORT SetHercMode}
                             {SetHercModePrim:}
      $50/                   {PUSH AX                ;save screen mode}
      $BA/$B8/$03/           {MOV DX,$03B8}
      $EE/                   {OUT DX,AL              ;change mode with screen off}
      $B9/$0C/$00/           {MOV CX,12              ;12 parameters to be output starting from}
      $30/$E4/               {XOR AH,AH              ;  register 0}
      $BA/$B4/$03/           {MOV DX,$03B4           ;index register}
      $FC/                   {CLD                    ;go forward}
                             {Parms:}
      $88/$E0/               {MOV AL,AH              ;AL = 0}
      $EE/                   {OUT DX,AL              ;output register number}
      $42/                   {INC DX                 ;data register}
      $AC/                   {LODSB                  ;next 6845 parameter}
      $EE/                   {OUT DX,AL              ;output data}
      $FE/$C4/               {INC AH                 ;next value}
      $4A/                   {DEC DX                 ;back to index register}
      $E2/$F5/               {LOOP Parms             ;repeat}
      $BA/$B8/$03/           {MOV DX,$03B8}
      $58/                   {POP AX                 ;get back screen mode}
      $04/$08/               {ADD AL,8               ;turn screen back on}
      $EE/                   {OUT DX,AL}
      $C3/                   {RET}
                             {SetHercMode:}
      $BA/$BF/$03/           {MOV DX,$03BF           ;configuration port}
      $B0/$01/               {MOV AL,1               ;allow graphics, page 0 only}
      $EE/                   {OUT DX,AL}
      $8A/$46/<GraphMode/    {MOV AL,[BP+<GraphMode]}
      $08/$C0/               {OR  AL,AL              ;switching to graphics mode?}
      $74/$1D/               {JZ  TMode              ;no - back to text}
                             {;set graphics mode}
      $B0/$02/               {MOV AL,2               ;select graphics mode}
      $BE/>HercGtable/       {MOV SI,>HercGtable     ;point to graphics table}
      $E8/$CA/$FF/           {CALL SetHercModePrim}
                             {;need to set page 1 of graphics?}
      $8A/$46/<GraphPage/    {MOV AL,[BP+<GraphPage] ;AL = Page number}
      $08/$C0/               {OR AL,AL               ;is it 0?}
      $74/$16/               {JZ SHMdone             ;if so, we're done}
      $B0/$03/               {MOV AL,3}
      $BA/$BF/$03/           {MOV DX,$03BF}
      $EE/                   {OUT DX,AL              ;allow graphics, both pages}
      $B0/$8A/               {MOV AL,$8A}
      $BA/$B8/$03/           {MOV DX,$03B8}
      $EE/                   {OUT DX,AL              ;set graphics mode, page 1}
      $EB/$08/               {JMP SHORT SHMdone      ;finished}
      {TMode:                 ;set text mode}
      $B0/$20/               {MOV AL,$20             ;select text mode}
      $BE/>HercTtable/       {MOV SI,>HercTtable     ;point SI to text table}
      $E8/$AD/$FF);          {CALL SetHercModePrim}
                             {SHMdone:}
  end;

  procedure SetBlink(On : Boolean);
    {-Enable text mode attribute blinking if On is True}
  const
    PortVal : array[0..4] of Byte = ($0C, $08, $0D, $09, $09);
  var
    PortNum : Word;
    Index : Byte;
    PVal : Byte;
  begin
    case CurrentDisplay of
      MonoHerc :
        begin
          PortNum := $3B8;
          Index := 4;
        end;
      CGA :
        begin
          PortNum := $3D8;
          case LastMode of
            0..3 : Index := LastMode;
          else Exit;
          end;
        end;
      MCGA..VGA :
        begin
          inline(
            $8A/$5E/<On/     {mov bl,[bp+<On]}
            $B8/$03/$10/     {mov ax,$1003}
            $CD/$10);        {int $10}
          Exit;
        end;
    else Exit;
    end;
    PVal := PortVal[Index];
    if On then
      PVal := PVal or $20;
    Port[PortNum] := PVal;
  end;

  procedure RestBlink;
    {-Restore blinking attr}
  begin
  end;

  procedure SetCrtBorder(Attr : Byte);
    {-Set border to background color if card type and mode allow}
  begin
    inline(
      $8A/$46/<Attr/         {mov AL,[BP+<Attr] ;get attribute}
      $B1/$04/               {mov CL,4          ;shift count}
      $D2/$E8/               {shr AL,CL         ;get background color}
      $24/$07/               {and AL,$07        ;make sure blink bit off}
      $88/$C3/               {mov BL,AL         ;right place for CGA}
      $A0/>CurrentDisplay/   {mov AL,[>CurrentDisplay];get current display}
      $8A/$26/>CurrentMode/  {mov AH,[>CurrentMode];get current mode}
      $3C/$01/               {cmp AL,CGA        ;check for CGA}
      $75/$0E/               {jne chkega        ;nope, go check EGA}
      $80/$FC/$03/           {cmp AH,3          ;check for modes 0-3}
      $77/$1A/               {ja  exit          ;forget it}
      $B4/$0B/               {mov AH,$0B        ;set color palette}
      $B7/$00/               {mov BH,$00        ;color palette ID}
      $CD/$10/               {int $10           ;let BIOS do it}
      $E9/$11/$00/           {jmp exit          ;and get out}
                             {chkega:}
      $3C/$03/               {cmp AL,EGA        ;check for EGA/VGA}
      $72/$0D/               {jb  exit          ;forget it}
      $80/$FC/$03/           {cmp AH,3          ;check for modes 0-3}
      $77/$08/               {ja  exit          ;forget it}
      $B4/$10/               {mov AH,$10        ;set color palette}
      $B0/$01/               {mov AL,$01        ;set border color}
      $88/$DF/               {mov BH,BL         ;the color}
      $CD/$10);              {int $10           ;let BIOS do it}
                             {exit:}
  end;

  function PackWindow(XLow, YLow, XHigh, YHigh : Byte) : PackedWindowPtr;
    {-Return a pointer to a packed window, or nil if not enough memory}
  var
    I, J : Word;
    InitialSize : Word;
    HeaderSize : Word;
    FinalSize : Word;
    Width : Integer;
    Height : Integer;
    SrcOfs : Word;
    PWP : PackedWindowPtr;
  begin
    {compute bytes needed for screen buffer}
    HeaderSize := SizeOf(PackedWindow)-SizeOf(PackedScreen);
    Width := Succ(Integer(XHigh)-Integer(XLow));
    Height := Succ(Integer(YHigh)-Integer(YLow));
    InitialSize := ((Width*Height) shl 1)+HeaderSize;

    {check available memory}
    if (MaxAvail < InitialSize) or (Width <= 0) or (Height <= 0) then begin
      PackWindow := nil;
      Exit;
    end;
    GetMem(PWP, InitialSize);

    {calculate starting offset on screen}
    SrcOfs := (Pred(YLow)*VirtualWidth+Pred(XLow)) shl 1;

    {pack the characters and attributes}
    with PWP^ do begin
      I := PackPrim(Height, Width, Seg(Contents), Ofs(Contents), SrcOfs, CDelta);
      J := PackPrim(Height, Width, Seg(Contents), Ofs(Contents[I+1]), SrcOfs+1, ADelta);
    end;

    {initialize the rest of the header}
    with PWP^ do begin
      FinalSize := HeaderSize+I+J;
      Size := FinalSize;
      TopRow := YLow;
      TopCol := XLow;
      Rows := Height;
      Cols := Width;
      AStart := I+1;
    end;

    {return pointer to packed window}
    PackWindow := PWP;

(*    {free up unused portion of window}
       PWP := Normalized(@PWP^.Contents[I+J+1]);
       FreeMem(PWP, InitialSize-FinalSize);
*)  end;

  procedure DisposePackedWindow(var PWP : PackedWindowPtr);
    {-Dispose of a packed window, setting PWP to nil on exit}
  begin
    if PWP <> nil then begin
      FreeMem(PWP,PWP^.Size);
      PWP := nil;
    end;
  end;

  procedure DisposePackedWindowLarge(var PWP : PackedWindowPtr);
    {-Dispose of a packed window, setting PWP to nil on exit}
  Var InitialSize,
      HeaderSize:word;
  begin
    if PWP <> nil then begin
     HeaderSize := SizeOf(PackedWindow)-SizeOf(PackedScreen);
     With PWP^  do begin
     InitialSize := ((rows*cols) shl 1)+HeaderSize;
      FreeMem(PWP,InitialSize);  end;
      PWP := nil;
    end;
  end;


  procedure DispPackedWindowAt(PWP : PackedWindowPtr; Row, Col : Byte);
    {-Display the packed window pointed to by PWP at Row,Col. If necessary,
      the coordinates are adjusted to allow it to fit on the screen.}
  var
    SaveRow, SaveCol : Byte;
  begin
    with PWP^ do begin
      {check for 0}
      if Row = 0 then
        Row := 1;
      if Col = 0 then
        Col := 1;

      {make sure the window can be displayed}
      if Pred(Row)+Rows > ScreenHeight then
        Row := Succ(ScreenHeight-Rows);
      if Pred(Col)+Cols > ScreenWidth then
        Col := Succ(ScreenWidth-Cols);

      {save the current coordinates and reset them temporarily}
      SaveRow := TopRow;
      TopRow := Row;
      SaveCol := TopCol;
      TopCol := Col;

      {display the window}
      DispPackedWindow(PWP);

      {restore the old coordinates}
      TopRow := SaveRow;
      TopCol := SaveCol;
    end;
  end;

  procedure MapPackedWindowColors(PWP : PackedWindowPtr);
    {-Map the colors in a packed window for improved appearance on mono/B&W
      displays}
  var
    Segm, Ofst : Word;
    LastOfst, Count : Word;
  begin
    {get out fast if color mapping not needed}
    if (CurrentMode = 1) or (CurrentMode = 3) or not MapColors then
      Exit;

    with PWP^ do begin
      {get starting address of the attributes in Contents}
      Segm := Seg(Contents);
      Ofst := Ofs(Contents[AStart]);

      {calculate offset of last element in Contents}
      LastOfst := Ofs(Size)+Pred(Size);

      {get number of attributes before the first PackRec}
      Count := ADelta;

      repeat
        {is it a PackRec?}
        if Count = 0 then begin
          {get number of attributes before the next PackRec}
          Count := MemW[Segm:Ofst];

          {map the FillVal}
          Mem[Segm:Ofst+2] := not MapColor(not Mem[Segm:Ofst+2]);

          {skip over the PackRec}
          Inc(Ofst, SizeOf(PackRec));
        end
        else begin
          {map the attribute}
          Mem[Segm:Ofst] := not MapColor(not Mem[Segm:Ofst]);

          {decrement counter to next PackRec}
          Dec(Count);

          {skip ahead}
          Inc(Ofst);
        end;
      until (Ofst > LastOfst) or (Ofst = 0);
    end;
  end;

  procedure WritePackedWindow(PWP : PackedWindowPtr; FName : string);
    {-Store the packed window pointed to by PWP in FName}
  var
    F : file;
    I : Word;
  begin
    {check for nil pointer}
    if PWP = nil then begin
      CrtError := CrtNilPointer;
      Exit;
    end;

    {try to open the file}
    Assign(F, FName);
    Rewrite(F, 1);
    CrtError := IoResult;
    if CrtError = 0 then begin
      {write the packed window to disk}
      BlockWrite(F, PWP^, PWP^.Size);
      CrtError := IoResult;
    end;

    {close the file}
    Close(F);
    if CrtError = 0 then
      CrtError := IoResult
    else
      I := IoResult;
  end;

  function ReadPackedWindow(FName : string) : PackedWindowPtr;
    {-Read the packed window stored in FName into memory}
  var
    PWP : PackedWindowPtr;
    F : file;
    I : Word;
  label
    Done;
  begin
    ReadPackedWindow := nil;

    {try to open the file}
    Assign(F, FName);
    Reset(F, 1);
    CrtError := IoResult;
    if CrtError <> 0 then
      Exit;

    {allocate memory for the window}
    I := FileSize(F);
    if (I > MaxAvail) then begin
      CrtError := CrtNotEnoughMem;
      goto Done;
    end;
    GetMem(PWP, I);

    {read the window into memory}
    BlockRead(F, PWP^, I);
    CrtError := IoResult;
    if CrtError = 0 then begin
      if PWP^.Size <> I then begin
        CrtError := CrtBadWindow;
        FreeMem(PWP, I);
      end
      else
        ReadPackedWindow := PWP;
    end
    else
      FreeMem(PWP, I);

Done:
    Close(F);
    if CrtError = 0 then
      CrtError := IoResult
    else
      I := IoResult;
  end;

  function CreateLibrary(var F : file; Name : string; Entries : Byte) : DirectoryPtr;
    {-Create a library with the specified # of directory entries}
  var
    FHandle : Word absolute F;
    I, J, K : Word;
    DP : DirectoryPtr;
  begin
    CreateLibrary := nil;

    {add main directory entry and round to multiple of 4}
    I := (Word(Entries)+4) and $FFFC;

    {allocate the directory}
    J := I*SizeOf(DirectoryEntry);
    if MaxAvail < J then begin
      CrtError := CrtNotEnoughMem;
      Exit;
    end;
    GetMem(DP, J);

    {open the library}
    Assign(F, Name);
    Rewrite(F, 1);
    CrtError := IoResult;
    if CrtError <> 0 then begin
      FreeMem(DP, J);
      Close(F);
      I := IoResult;
      Exit;
    end;

    {initialize the directory}
    FillChar(DP^, J, 0);

    {initialize the main directory entry}
    with DP^[0] do begin
      {name is all blanks}
      Name := BlankDeName;

      {size of the directory}
      MemberLength := I div 4;
    end;

    {mark the remaining entries as unused}
    for K := 1 to Pred(I) do
      DP^[K].Status := deUnused;

    {write the directory to disk}
    BlockWrite(F, DP^, J);
    CrtError := IoResult;
    if CrtError = 0 then
      CreateLibrary := DP
    else begin
      FreeMem(DP, J);
      Close(F);
      I := IoResult;
    end;
  end;

  function OpenLibrary(var F : file; Name : string) : DirectoryPtr;
    {-Open the specified library and return a pointer to its directory}
  var
    DP : DirectoryPtr;
    DE : DirectoryEntry;
    I : Word;
  begin
    OpenLibrary := nil;

    {open the library}
    Assign(F, Name);
    Reset(F, 1);
    CrtError := IoResult;
    if CrtError <> 0 then
      Exit;

    {read in the first directory entry and check its validity}
    BlockRead(F, DE, SizeOf(DE));
    CrtError := IoResult;
    if CrtError = 0 then
      if (DE.Status <> deInUse) or (DE.Name <> BlankDeName) then
        CrtError := CrtNotValidLib;
    if CrtError <> 0 then begin
      Close(F);
      I := IoResult;
      Exit;
    end;

    {calculate size of directory and allocate it}
    I := DE.MemberLength*128;
    if I > MaxAvail then begin
      CrtError := CrtNotEnoughMem;
      Close(F);
      I := IoResult;
      Exit;
    end;
    GetMem(DP, I);

    {reposition file pointer and read in the directory}
    Seek(F, 0);
    BlockRead(F, DP^, I);
    CrtError := IoResult;
    if CrtError = 0 then
      OpenLibrary := DP
    else begin
      FreeMem(DP, I);
      Close(F);
      I := IoResult;
    end;
  end;

  procedure CloseLibrary(var F : file; var DP : DirectoryPtr);
    {-Close library F and deallocate its directory}
  var
    I : Word;
  begin
    {close the file}
    Close(F);
    CrtError := IoResult;

    {deallocate the directory}
    FreeMem(DP, DP^[0].MemberLength*128);
    DP := nil;
  end;

  procedure MakeEntryName(S : LibName; var N : deName);
    {-Make a directory name out of a regular filename}
  var
    I, J : Word;
  begin
    {initialize with blanks}
    FillChar(N, SizeOf(N), ' ');

    {convert name to upper case}
    for I := 1 to Length(S) do
      S[I] := Upcase(S[I]);

    I := Pos('.', S);
    if I = 0 then begin
      {plug in the name and leave extension blank}
      J := Length(S);
      if J > 8 then
        J := 8;
      Move(S[1], N, J);
    end
    else begin
      {plug in the name, 8 chars max}
      if I > 9 then
        J := 8
      else
        J := Pred(I);
      Move(S[1], N, J);

      {plug in the extension, 3 chars max}
      J := Length(S)-I;
      if J > 3 then
        J := 3;
      Move(S[I+1], N[9], J);
    end;
  end;

  function FindWinName(DP : DirectoryPtr; WinName : LibName; DelCheck : Boolean) : Word;
    {-Find the directory entry for WinName}
  var
    DN : deName;
    I, J : Word;
  begin
    FindWinName := 0;
    MakeEntryName(WinName, DN);
    J := DP^[0].MemberLength*4;
    for I := 1 to Pred(J) do
      with DP^[I] do
        if ((Status = deInUse) or not DelCheck) and (Name = DN) then begin
          FindWinName := I;
          Exit;
        end;
  end;

  function UpdateDirectory(var F : file; DP : DirectoryPtr; Entry : Byte) : Boolean;
    {-Update the specified directory entry}
  begin
    UpdateDirectory := False;
    {seek to the right location}
    Seek(F, Entry*SizeOf(DirectoryEntry));
    CrtError := IoResult;
    if CrtError <> 0 then
      Exit;

    {write the directory entry to disk}
    BlockWrite(F, DP^[Entry], SizeOf(DirectoryEntry));
    CrtError := IoResult;
    UpdateDirectory := (CrtError = 0);
  end;

  procedure AddWindowToLibrary(PWP : PackedWindowPtr; var F : file;
                               DP : DirectoryPtr; WinName : LibName);
    {-Add a packed window to the specified library}
  var
    Padding : array[1..128] of Byte;
    S, I, J, K : Word;
    FP : LongInt;
  begin
    {mark any existing entry with this name as deleted}
    I := FindWinName(DP, WinName, True);
    if I <> 0 then begin
      DP^[I].Status := deDeleted;
      if not UpdateDirectory(F, DP, I) then
        Exit;
    end;

    {find the first blank directory entry}
    J := DP^[0].MemberLength*4;
    I := 1;
    K := 0;
    while (K = 0) and (I < J) do
      if DP^[I].Status = deUnused then
        K := I
      else
        Inc(I);
    if K = 0 then begin
      CrtError := CrtDirectoryFull;
      Exit;
    end;

    {seek to end of file}
    Seek(F, FileSize(F));
    CrtError := IoResult;
    if CrtError <> 0 then
      Exit;
    FP := FilePos(F);

    {write the packed window}
    S := PWP^.Size;
    BlockWrite(F, PWP^, S);
    CrtError := IoResult;
    if CrtError <> 0 then
      Exit;

    {pad to the end of the block with ^Z}
    J := 128-(S and $7F);
    if J <> 0 then begin
      FillChar(Padding, J, ^Z);
      BlockWrite(F, Padding, J);
      CrtError := IoResult;
      if CrtError <> 0 then
        Exit;
    end;

    {update the directory}
    with DP^[K] do begin
      Status := deInUse;
      MakeEntryName(WinName, Name);
      MemberLength := (S+J) div 128;
      Index := FP div 128;
      PadCount := J;
    end;
    if UpdateDirectory(F, DP, K) then {} ;
  end;

  function ReadWindowPrim(var F : file; DP : DirectoryPtr;
                          Entry : Byte) : PackedWindowPtr;
    {-Primitive routine to read a packed window from a library}
  var
    PWP : PackedWindowPtr;
    I : Word;
  begin
    ReadWindowPrim := nil;
    with DP^[Entry] do begin
      {calculate size of entry and allocate the window}
      I := (MemberLength*128)-PadCount;
      if I > MaxAvail then begin
        CrtError := CrtNotEnoughMem;
        Exit;
      end;
      GetMem(PWP, I);

      {seek to the start of the window}
      Seek(F, LongInt(Index)*128);
      CrtError := IoResult;
      if CrtError <> 0 then begin
        FreeMem(PWP, I);
        Exit;
      end;

      {read in the packed window}
      BlockRead(F, PWP^, I);
      CrtError := IoResult;
      if CrtError = 0 then begin
        if PWP^.Size <> I then begin
          CrtError := CrtBadWindow;
          FreeMem(PWP, I);
        end
        else
          ReadWindowPrim := PWP
      end
      else
        FreeMem(PWP, I);
    end;
  end;

  function ReadWindowFromLibrary(var F : file; DP : DirectoryPtr;
                                 WinName : LibName) : PackedWindowPtr;
    {-Read a packed window from a library and return a pointer to it}
  var
    I : Word;
  begin
    {locate the window's directory entry}
    I := FindWinName(DP, WinName, True);
    if I = 0 then
      ReadWindowFromLibrary := nil
    else
      ReadWindowFromLibrary := ReadWindowPrim(F, DP, I);
  end;

  procedure ClearWindow(XLow, YLow, XHigh, YHigh : Word; Ch : Char; A : Byte);
    {-Clear a window using the specified character and attribute}
  var
    Row, Width : Word;
  begin
    Width := Succ(XHigh-XLow);
    for Row := YLow to YHigh do
      FastFill(Width, Ch, Row, XLow, A);
  end;

  procedure DeleteWindowFromLibrary(var F : file; DP : DirectoryPtr;
                                    WinName : LibName);
    {-Delete a packed window from the specified library}
  var
    I, J : Word;
  begin
    {locate the window's directory entry}
    I := FindWinName(DP, WinName, True);
    if I = 0 then begin
      CrtError := CrtWinNotFound;
      Exit;
    end;

    {mark entry as deleted}
    DP^[I].Status := deDeleted;
    if UpdateDirectory(F, DP, I) then {} ;
  end;

  procedure PackLibrary(LName : string);
    {-Pack a library to remove deleted entries.}
  var
    FOld, FNew : file;
    DPold, DPnew : DirectoryPtr;
    I, J, K : Word;
    PWP : PackedWindowPtr;
  label
    FoundOne;

    function deNameToString(Name : deName) : string;
      {-Convert a deName to a string}
    var
      S : string;
      I : Word;
    begin
      S[0] := #0;
      for I := 1 to 8 do
        if Name[I] <> ' ' then
          S := S+Name[I];
      if Name[9] <> ' ' then begin
        S := S+'.';
        for I := 9 to 11 do
          if Name[I] <> ' ' then
            S := S+Name[I];
      end;
      deNameToString := S;
    end;

  begin
    {open the library}
    DPold := OpenLibrary(FOld, LName);
    if DPold = nil then
      Exit;

    {make sure there are deleted entries}
    J := DPold^[0].MemberLength*4;
    for I := 1 to Pred(J) do
      if DPold^[I].Status = deDeleted then
        goto FoundOne;

    {if we get here, there are no deleted entries}
    CloseLibrary(FOld, DPold);
    Exit;

FoundOne:
    {create new library}
    DPnew := CreateLibrary(FNew, '$$WORK$$.LBR', J-1);
    if DPnew = nil then begin
      CloseLibrary(FOld, DPold);
      Exit;
    end;

    {add all undeleted entries to new lib}
    for I := 1 to Pred(J) do
      with DPold^[I] do
        if Status = deInUse then begin
          PWP := ReadWindowPrim(FOld, DPold, I);
          if PWP <> nil then
            AddWindowToLibrary(PWP, FNew, DPnew, deNameToString(Name));
          if (PWP = nil) or (CrtError <> 0) then begin
            K := CrtError;              {!!.08}
            CloseLibrary(FOld, DPold);
            CloseLibrary(FNew, DPnew);
            if K <> 0 then              {!!.08}
              CrtError := K;            {!!.08}
            Erase(FNew);
            K := IoResult;
            Exit;
          end
          else
            DisposePackedWindow(PWP)
        end;

    {delete old lib, rename new one}
    CloseLibrary(FOld, DPold);
    Erase(FOld);
    K := IoResult;
    CloseLibrary(FNew, DPnew);
    Rename(FNew, LName);
    K := IoResult;
    if CrtError = 0 then
      CrtError := K;
  end;

begin
  {try to detect presence of CRT in the same program}
  Mark(SaveExitProc);
  inline(
    $E8/$00/$00/           {call x}
    $5B/                   {x: pop bx}
    $2E/$8B/$47/$FB/       {mov ax,cs:[bx-5]}
    $A3/>SystemSeg);       {mov [>SystemSeg],ax}

  if SegOfs(FIB(Input).InOutProc).Segm <> SystemSeg then
    CrtTest;

  {initialize global variables}
  CheckBreak := True;
  CheckEOF := False;

  {for internal use}
  IsCompaq := (CompaqBiosName = 'COMPAQ');
  if (ZenithBiosName = 'Zenith') then
    IsZenith := True;

  {initialize internal variables}
  InitCrt;

  {activate colors on Hercules InColor card}
  if WhichHerc = HercInColor then
    SwitchInColorCard(True);

  {$IFNDEF Ver40}
   {disable our exit handler it this isn't TP 4.0}
   ExitProc := SaveExitProc;
 {$ENDIF}

  {reopen Input}
  AssignCrt(Input);
  Reset(Input);

  {reopen Output}
  AssignCrt(Output);
  Rewrite(Output);

  {correct some BIOS bugs involving cursor scan lines}
  case BiosScanLines of
    $0607 :
      if CurrentMode = 7 then
        {mono adapter, but CGA scan lines -- happens on most mono systems}
        BiosScanLines := $0B0C;
    $0067 :
      {incorrect scan lines bug -- most often seen on Compaqs}
      BiosScanLines := $0607;
  end;

{$ENDIF}

{$IFDEF WIN32}
{$B-,X+}

Interface

Uses
  Windows,
  SysUtils;

Const
  AnyFile = faAnyFile;
  VolumeID = faVolumeID;
  Directory = faDirectory;
  Hidden = faHidden;
  Archive = faArchive;
  ReadOnly = faReadOnly;

  frTL = 0;
  frBL = 1;
  frTR = 2;
  frBR = 3;
  frTT = 4;
  frBB = 5;
  frLL = 6;
  frRR = 7;

Type
  PSaveWindRec  = ^TSaveWindRec;
  TSaveWindRec  = Array [0..120, 0..80] Of TCharInfo;
  FrameCharType = frTL..frRR;
  FrameArray    = Array [FrameCharType] of Char;
  ExtStr        = String [  3];
  PathStr       = String [ 80];
  NameStr       = String [  8];
  DirStr        = String [ 80];
  ComStr        = String [127];

  Date = LongInt;
  Time = LongInt;

  DateTimeRec = Record
    D : Date;
    T : Time;
  End;

  DayType = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);

  DateTime      = Record
    Year, Month, Day, Hour, Min, Sec: Word;
  End;

  RestrictCoords = Record
    X1, X2, Y1, Y2 : Byte;
  End;

Var
  StdInput, StdOutput : THandle;

Const

  {color constants}
  Black        = 0;
  Blue         = 1;
  Green        = 2;
  Cyan         = 3;
  Red          = 4;
  Magenta      = 5;
  Brown        = 6;
  LightGray    = 7;
  DarkGray     = 8;
  LightBlue    = 9;
  LightGreen   = 10;
  LightCyan    = 11;
  LightRed     = 12;
  LightMagenta = 13;
  Yellow       = 14;
  White        = 15;
  Blink        = 128;

  FrameChars    : FrameArray = 'ΥΤΈΎΝΝ³³';
  Restrict      : RestrictCoords = (X1: 0; X2: 0; Y1: 0; Y2: 0);
  DOSerror      : Word = 0;
  WindMin       : Word = 0;
  WindMax       : Word = 6223;
  scKoef        : Byte = 0;

(*
Procedure ClrScr;
Procedure CopyScr;
Function ReadKey : Char;
Function KeyPressed : Boolean;
Procedure FastFill (Number : dWord; Ch : Char; Row, Col : Word; Attr : Word);
Procedure FastWrite (St : String; Row, Col : Word; Attr : Word);
Procedure GoToXY (X, Y: Byte);
Function WhereY: Byte;
Function WhereX: Byte;
Procedure ClrEol;
Procedure SetBlink (B: Boolean);
Procedure TextColor (Clr: Byte);
Procedure TextBackGround (Clr: Byte);

Procedure SaveWindow (XLow, YLow, XHigh, YHigh : Byte; Allocate : Boolean; Var Covers : Pointer);
Procedure RestoreWindow (XLow, YLow, XHigh, YHigh : Byte; Deallocate : Boolean; Var Covers : Pointer);
Procedure FrameWindow (LeftCol, TopRow, RightCol, BotRow : Word; FAttr, HAttr : Byte; Header : String);
Procedure ClearWindow (XLow, YLow, XHigh, YHigh : Word; Ch : Char; A : Byte);

procedure Window(XLow, YLow, XHigh, YHigh : Byte);
  {-Set current window coordinates}

procedure ScrollWindowUp(XLo, YLo, XHi, YHi, Lines : Byte);
  {-Scrolls the designated window up the specified number of lines.}

procedure ScrollWindowDown(XLo, YLo, XHi, YHi, Lines : Byte);
  {-Scrolls the designated window down the specified number of lines.}

Procedure HiddenCursor;
Procedure NormalCursor;
Procedure BlockCursor;
*)

Procedure GetTime (Var Hour, Min, Sec, Sec100: Word);
Procedure GetDate (Var Year, Month, Day, DOW: Word);
Procedure ExchangeStructs (Var A, B; Const Size: LongInt);

Procedure PackTime (DT: DateTime; Var DosDate: LongInt);
Procedure UnpackTime (DosDate: Integer; Var DT: DateTime);
{
Procedure ChangeAttribute (Number : Word; Row, Col : Word; Attr : Byte);
}
Procedure FSplit (F: String; Var Dir: DirStr; Var Name: NameStr; Var Ext: ExtStr);
Function GetEnv (Name: String): String;

{
Procedure tWrite (S : String);
Procedure tWriteLn (S : String);
}

Procedure SetTitle (S : String);

Implementation

Const
  NO_KEY        : Char = #255;

Var
  BufReadKey    : Char;
  Len           : Integer;
  P             : PChar;
  C             : Char;
  Buf           : TInputRecord;
  Coord         : TCoord;

Procedure InitCrt;
Begin
  StdInput := GetStdHandle (STD_INPUT_HANDLE);
  StdOutput := GetStdHandle (STD_OUTPUT_HANDLE);
  SetConsoleMode (StdInput, ENABLE_PROCESSED_INPUT or ENABLE_MOUSE_INPUT);
  SetConsoleMode (StdOutput, ENABLE_PROCESSED_OUTPUT or ENABLE_WRAP_AT_EOL_OUTPUT);
End;

Function ReadKey : Char;
Begin
{
  If BufReadKey <> NO_KEY Then
  Begin
    ReadKey := BufReadKey;
    BufReadKey := NO_KEY;
    Exit;
  End;

  P := @C;
  ReadKey := #0;

  While WaitForSingleObject (StdInput, INFINITE) = 0 Do
  Begin
    PeekConsoleInput (StdInput, Buf, 1, Len);

    If Buf. EventType = KEY_EVENT Then
    With Buf. KeyEvent Do
    If (Not bKeyDown) Or (wVirtualScanCode in [87, 88]) Or
       ((wVirtualScanCode in [29, 54, 56, 42, 59]) And
       (dwControlKeyState <> 0))
    Then Begin
      ReadConsoleInput (StdInput, Buf, 1, Len);
      Continue;
    End;

    With Buf. KeyEvent Do
    If (wVirtualScanCode in [59..68, 72, 77, 75, 80, 82..83]) Or
       ((wVirtualScanCode in [73, 81, 71, 79]) And
       (dwControlKeyState And 1024 = 0) And
       (dwControlKeyState And 2048 = 0)) Or
       ((AsciiChar <> #0) And
       ((dwControlKeyState And 256 <> 0) Or
       (dwControlKeyState And 512 <> 0)))
    Then Begin
      BufReadKey := Chr (wVirtualScanCode);
      ReadConsoleInput (StdInput, Buf, 1, Len);
      Exit;
    End;

    With Buf. KeyEvent Do
    If ((dwControlKeyState And 1024 <> 0) Or
       (dwControlKeyState And 2048 <> 0)) And
       (wVirtualScanCode in [73, 81, 71, 79])
    Then Begin
      Case wVirtualScanCode Of
        71 : BufReadKey := #119;
        73 : BufReadKey := #132;
        79 : BufReadKey := #117;
        81 : BufReadKey := #118;
      End;
      ReadConsoleInput (StdInput, Buf, 1, Len);
      Exit;
    End;

    ReadConsole (StdInput, P, 1, Len, Nil);
    ReadKey := PChar (P)^;
    Break;
  End;
}  
End;

Function KeyPressed : Boolean;
Var
  i     : dWord;

Begin
{
  KeyPressed := True;
  If BufReadKey <> NO_KEY Then Exit;

  GetNumberOfConsoleInputEvents (StdInput, Len);

  If Len > 0 Then
  Begin
    For i := 1 To Len Do
    Begin
      PeekConsoleInput (StdInput, Buf, 1, Len);

      If (Buf. EventType <> KEY_EVENT) Or ((Buf. EventType = KEY_EVENT) And
         ((Not Buf. KeyEvent. bKeyDown) Or (Buf. KeyEvent. wVirtualScanCode in
         [87, 88]) Or ((Buf. KeyEvent. wVirtualScanCode in
         [29, 54, 56, 42, 59]) And (Buf. KeyEvent. dwControlKeyState <> 0))))
      Then Begin
        ReadConsoleInput (StdInput, Buf, 1, Len);
        Continue;
      End;

      Exit;
    End;
  End;

  KeyPressed := False;
}
End;

Procedure FastFill (Number : dWord; Ch : Char; Row, Col : Word; Attr : Word);
Begin
  Coord. X := Col-1;
  Coord. Y := Row-1;
  FillConsoleOutputCharacter (StdOutput, Ch, Number, Coord, Number);
  FillConsoleOutputAttribute (StdOutput, Attr, Number, Coord, Number);
End;
{
Procedure ChangeAttribute (Number : Word; Row, Col : Word; Attr : Byte);
Begin
  Coord. X := Col-1;
  Coord. Y := Row-1;
  FillConsoleOutputAttribute (StdOutput, Attr, Number, Coord, Len);
End;

Procedure FastWrite (St : String; Row, Col : Word; Attr : Word);
Var
  P     : PChar;

Begin
  Coord. X := Col-1;
  Coord. Y := Row-1;
  GetMem (P, Length (St)+1);
  StrPCopy (P, St);
  WriteConsoleOutputCharacter (StdOutput, P, Length (St), Coord, Len);
  FillConsoleOutputAttribute (StdOutput, Attr, Length (St), Coord, Len);
  FreeMem (P, Length (St)+1);
End;
}
(*
Procedure SaveWindow;
Var
  BS, BC        : TCoord;
  Rect          : TSmallRect;

Begin
  Dec (XLow); Dec (YLow);
  If Allocate Then GetMem (Covers, SizeOf (TSaveWindRec));

  BS. X := XHigh-XLow; BS. Y := YHigh-YLow;
  BC. X := 0; BC. Y := 0;
  Rect. Left := XLow;
  Rect. Top := YLow;
  Rect. Right := XHigh-1;
  Rect. Bottom := YHigh-1;

  ReadConsoleOutput (StdOutput, Covers, BS, BC, Rect);
End;

Procedure RestoreWindow;
Var
  BS, BC        : TCoord;
  Rect          : TSmallRect;

Begin
  Dec (XLow); Dec (YLow);

  BS. X := XHigh-XLow; BS. Y := YHigh-YLow;
  BC. X := 0; BC. Y := 0;
  Rect. Left := XLow;
  Rect. Top := YLow;
  Rect. Right := XHigh-1;
  Rect. Bottom := YHigh-1;

  WriteConsoleOutput (StdOutput, Covers, BS, BC, Rect);
  If DeAllocate Then FreeMem (Covers, SizeOf (TSaveWindRec));
End;

Procedure ClearWindow (XLow, YLow, XHigh, YHigh : Word; Ch : Char; A : Byte);
Var
  i     : Byte;

Begin
  {Dec (XLow);
  Dec (YLow);}
  For i := YLow To YHigh Do FastFill (XHigh-XLow+1, Ch, i, XLow, A);
End;

Procedure ClrScr;
Begin
  ClearWindow (Lo (WindMin)+1, Hi (WindMin)+1, Lo (WindMax)+1, Hi (WindMax)+1, ' ', TextAttr);
  GoToXY (Lo (WindMin)+1, Hi (WindMin)+1);
End;

Procedure GoToXY (X, Y: Byte);
Begin
  If X = 0 Then X := 1; If Y = 0 Then Y := 1;
  Coord. X := X-1; Coord. Y := Y-1;
  SetConsoleCursorPosition (StdOutput, Coord);
End;

Var
  CursorInfo : TConsoleCursorInfo;

Procedure NormalCursor;
Begin
  CurSorinfo. bVisible := True;
  CurSorinfo. dwSize := 2;
  SetConsoleCursorInfo (StdOutput, CursorInfo);
End;

Procedure HiddenCursor;
Begin
  CurSorinfo. bVisible := False;
  CurSorinfo. dwSize := 1;
  SetConsoleCursorInfo (StdOutput, CursorInfo);
End;

Procedure BlockCursor;
Begin
  CurSorinfo. bVisible := True;
  CurSorinfo. dwSize := 100;
  SetConsoleCursorInfo (StdOutput, CursorInfo);
End;

Procedure FrameWindow (LeftCol, TopRow, RightCol, BotRow : Word; FAttr, HAttr : Byte; Header : String);
  {-Draws a frame around a window}
Var
  Row, Width, HeaderPos : Word;

Begin
  If RightCol <= LeftCol Then
    Width := 0
  Else
    Width := RightCol-LeftCol-1;

  {draw the upper border}
  FastFill(1,     FrameChars[frTL], TopRow, LeftCol, FAttr);
  If Width > 0 then
    FastFill(Width, FrameChars[frTT], TopRow, LeftCol+1, FAttr);
  FastFill(1,     FrameChars[frTR], TopRow, RightCol, FAttr);

  {draw the header}
  if Length (Header) > 0 then begin
    if Length (Header) > Width then
      SetLength (Header, Width);
    HeaderPos := (Width-Length (Header)) shr 1;
    FastWrite (Header, TopRow, LeftCol+HeaderPos+1, HAttr);
  end;

  {draw the vertical bars}
  for Row := Succ(TopRow) to Pred(BotRow) do begin
    FastFill(1, FrameChars[frLL], Row, LeftCol, FAttr);
    FastFill(1, FrameChars[frRR], Row, RightCol, FAttr);
  end;

  {draw the bottom border}
  FastFill(1,     FrameChars[frBL], BotRow, LeftCol, FAttr);
  If Width > 0 Then
    FastFill(Width, FrameChars[frBB], BotRow, LeftCol+1, FAttr);
  FastFill(1,     FrameChars[frBR], BotRow, RightCol, FAttr);
End;
*)

Procedure GetTime (Var Hour, Min, Sec, Sec100: Word);
Begin
  DecodeTime (SysUtils. Time, Hour, Min, Sec, Sec100);
End;

Procedure GetDate (Var Year, Month, Day, DOW: Word);
Begin
  DecodeDate (Now, Year, Month, Day);
  DOW := DayOfWeek (Now)-1;
End;

Procedure ExchangeStructs (Var A, B; Const Size: LongInt);
Var
  C : Array [0..4096] Of Byte;

Begin
  Move (A, C, Size);
  Move (B, A, Size);
  Move (C, B, Size);
End;

Procedure PackTime (DT: DateTime; Var DosDate: LongInt);
Var
  D    : TDateTime;

Begin
  Try
    D := EncodeDate (Word (DT. Year), Word (DT. Month), Word (DT. Day)) +
    EncodeTime (Word (DT. Hour), Word (DT. Min), Word (DT. Sec), 0);
    DosDate := DateTimeToFileDate (D);
  Except
    DosDate := 0;
  End;
End;

Procedure UnpackTime (DosDate: Integer; Var DT: DateTime);
Var
  Year, Month, Day, Hour, Min, Sec, MSec    : Word;
  D                                         : TDateTime;

Begin
  Try
    D := FileDateToDateTime (DosDate);
    DecodeDate (D, Year, Month, Day);
    DecodeTime (D, Hour, Min, Sec, MSec);
  Except
  End;

  DT. Year := Year; DT. Month := Month; DT. Day := Day;
  DT. Hour := Hour; DT. Min := Min; DT. Sec := Sec;
End;

Procedure FSplit (F: String; Var Dir: DirStr; Var Name: NameStr; Var Ext: ExtStr);
Begin
  Dir := ExtractFileDir (F);
  Name := ExtractFileName (F);
  Ext := ExtractFileExt (F);
End;

Function GetEnv (Name: String): String;
Var
  P1 : PChar;

Begin
  GetMem (P, 257);
  GetMem (P1, Length (Name)+1);
  StrPCopy (P1, Name);

  GetEnvironmentVariable (P1, P, 256);

  GetEnv := StrPas (P);
  FreeMem (P, 257);
  FreeMem (P1, Length (Name)+1);
End;

(*
Procedure ClrEol;
Begin
  FastFill (80-WhereY, #0, WhereY, WhereX, TextAttr);
End;

Function WhereY: Byte;
Var
  Info     : TConsoleScreenBufferInfo;

Begin
  GetConsoleScreenBufferInfo (StdOutput, Info);
  WhereY := Info. dwCursorPosition. Y+1;
End;

Function WhereX: Byte;
Var
  Info     : TConsoleScreenBufferInfo;

Begin
  GetConsoleScreenBufferInfo (StdOutput, Info);
  WhereX := Info. dwCursorPosition. X+1;
End;

Procedure SetBlink (B: Boolean);
Begin
End;

Procedure Window (XLow, YLow, XHigh, YHigh : Byte);
  {-Set current window coordinates}
Begin
  WindMin := (XLow-1)+((YLow-1)shl 8);
  WindMax := (XHigh-1)+((YHigh-1) shl 8);
End;

Procedure TextColor (Clr: Byte);
Begin
  TextAttr := (TextAttr And $F0) * 16 + Clr;
              {background}              {foreground}
End;

Procedure TextBackGround (Clr: Byte);
Begin
  TextAttr := Clr * 16 + (TextAttr And $0F);
              {background}              {foreground}
End;

Procedure ScrollWindowUp (XLo, YLo, XHi, YHi, Lines : Byte);
  {-Scrolls the designated window up the specified number of lines.}
Var
  R  : TSmallRect;
  R1 : PSmallRect;
  C  : TCharInfo;

Begin
  New (R1);
  Dec (YHi);
  Dec (XHi);
  R. Left := XLo-1; R. Top := YLo-1; R. Right := XHi; R. Bottom := YHi;
  R1^. Left := XLo-1; R1^. Top := YLo{+Lines}-1; R1^. Right := XHi; R1^. Bottom := YHi;
  C. AsciiChar := #0; C. Attributes := TextAttr;
  Coord. X := XLo-1; Coord. Y := YLo-Lines-1;
  ScrollConsoleScreenBuffer (StdOutput, R, R1, Coord, C);
  Dispose (R1);
End;

Procedure ScrollWindowDown (XLo, YLo, XHi, YHi, Lines : Byte);
  {-Scrolls the designated window down the specified number of lines.}
Var
  R  : TSmallRect;
  R1 : PSmallRect;
  C  : TCharInfo;

Begin
  New (R1);
  Dec (YHi);
  Dec (XHi);
  R. Left := XLo-1; R. Top := YLo-1; R. Right := XHi; R. Bottom := YHi;
  R1^. Left := XLo-1; R1^. Top := YLo-1; R1^. Right := XHi; R1^. Bottom := YHi;
  C. AsciiChar := #0; C. Attributes := TextAttr;
  Inc (YLo, 1+Lines); Coord. X := XLo-1; Coord. Y := YLo-2;
  ScrollConsoleScreenBuffer (StdOutput, R, R1, Coord, C);
  Dispose (R1);
End;
*)

Procedure SetTitle (S : String);
Begin
  GetMem (P, Length (S)+1);
  StrPCopy (P, S);
  SetConsoleTitle (P);
  FreeMem (P, Length (S)+1);
End;

{ Outputs packed string to the CRT device }

(*
procedure WritePackedString(S: PChar; Len: Longint);
var
  i, BufChars  : Integer;
  X, Y, X1, Y1 : Byte;
  C            : Char;
  Buf          : Array [1..256] Of Char;

procedure FlushBuffered;
begin
  If BufChars > 0 then
  begin
    FastWrite (Copy (StrPas (@Buf), 1, BufChars), Y1, X1, TextAttr);
    BufChars := 0;
    X1 := X;
    Y1 := Y;
  end;
end;

begin
  X := WhereX; X1 := X;
  Y := WhereY; Y1 := Y;
  BufChars := 0;

  for I := 0 to Len - 1 do
  begin
    C := S[I];
    case C of
      ^J:               { Line Feed }
        begin
          FlushBuffered;
          If Y-1 >= Hi (WindMax) Then
            ScrollWindowUp (Lo (WindMin)+1, Hi (WindMin)+1, Lo (WindMax)+1, Hi (WindMax)+1, 1)
          Else
            Inc (Y);
        end;
      ^M:               { Carriage return }
        begin
          FlushBuffered;
          X := Lo (WindMin);
        end;
      ^H:               { Backspace }
        begin
          FlushBuffered;
          if X > Lo (WindMin) then Dec (X);
        end;
      ^G:               { Bell }
        {VioWrtTTY(@C, 1, 0)};
      else
        Inc (BufChars);
        Buf [BufChars] := C;
        Inc (X);
        If X-1 > Lo (WindMax) then
        Begin
          FlushBuffered;
          X := Lo (WindMin);
          X1 := X;
          Inc (Y);
          If Y-1 > Hi (WindMax) then
          Begin
            FlushBuffered;
            ScrollWindowUp (Lo (WindMin)+1, Hi (WindMin)+1, Lo
                           (WindMax)+1, Hi (WindMax)+1, 1);
            Y := Hi (WindMax);
          End;
          Y1 := Y;
        End;
    End;
  End;
  FlushBuffered;
  GoToXY (X, Y);
end;

{.$I opcrt.in2}
*)

{
Begin
  InitCrt;
  BufReadKey := NO_KEY;
  TextAttr := 7;
}
{$ENDIF}

{$IFDEF LINUX}
{$I opcrt.in3}
{$ENDIF}

End.