
{*******************************************************}
{                                                       }
{       Turbo Pascal Version 7.0                        }
{       Turbo Vision Unit                               }
{                                                       }
{       Copyright (c) 1992 Borland International        }
{                                                       }
{       Virtual Pascal v2.1                             }
{       Copyright (C) 1996-2000 vpascal.com             }
{                                                       }
{*******************************************************}

unit Drivers;

{$X+,I-,S-,P-,Cdecl-,Delphi+,Use32+}

interface

uses Objects;

{ ******** EVENT MANAGER ******** }

const

{ Event codes }

  evMouseDown = $0001;
  evMouseUp   = $0002;
  evMouseMove = $0004;
  evMouseAuto = $0008;
  evKeyDown   = $0010;
  evCommand   = $0100;
  evBroadcast = $0200;

{ Event masks }

  evNothing   = $0000;
  evMouse     = $000F;
  evKeyboard  = $0010;
  evMessage   = $FF00;

{ Extended key codes }

  kbEsc       = $011B;  kbAltSpace  = $0200;  kbCtrlIns   = $0400;
  kbShiftIns  = $0500;  kbCtrlDel   = $0600;  kbShiftDel  = $0700;
  kbBack      = $0E08;  kbCtrlBack  = $0E7F;  kbShiftTab  = $0F00;
  kbTab       = $0F09;  kbAltQ      = $1000;  kbAltW      = $1100;
  kbAltE      = $1200;  kbAltR      = $1300;  kbAltT      = $1400;
  kbAltY      = $1500;  kbAltU      = $1600;  kbAltI      = $1700;
  kbAltO      = $1800;  kbAltP      = $1900;  kbCtrlEnter = $1C0A;
  kbEnter     = $1C0D;  kbAltA      = $1E00;  kbAltS      = $1F00;
  kbAltD      = $2000;  kbAltF      = $2100;  kbAltG      = $2200;
  kbAltH      = $2300;  kbAltJ      = $2400;  kbAltK      = $2500;
  kbAltL      = $2600;  kbAltZ      = $2C00;  kbAltX      = $2D00;
  kbAltC      = $2E00;  kbAltV      = $2F00;  kbAltB      = $3000;
  kbAltN      = $3100;  kbAltM      = $3200;  kbF1        = $3B00;
  kbF2        = $3C00;  kbF3        = $3D00;  kbF4        = $3E00;
  kbF5        = $3F00;  kbF6        = $4000;  kbF7        = $4100;
  kbF8        = $4200;  kbF9        = $4300;  kbF10       = $4400;
  kbHome      = $4700;  kbUp        = $4800;  kbPgUp      = $4900;
  kbGrayMinus = $4A2D;  kbLeft      = $4B00;  kbRight     = $4D00;
  kbGrayPlus  = $4E2B;  kbEnd       = $4F00;  kbDown      = $5000;
  kbPgDn      = $5100;  kbIns       = $5200;  kbDel       = $5300;
  kbShiftF1   = $5400;  kbShiftF2   = $5500;  kbShiftF3   = $5600;
  kbShiftF4   = $5700;  kbShiftF5   = $5800;  kbShiftF6   = $5900;
  kbShiftF7   = $5A00;  kbShiftF8   = $5B00;  kbShiftF9   = $5C00;
  kbShiftF10  = $5D00;  kbCtrlF1    = $5E00;  kbCtrlF2    = $5F00;
  kbCtrlF3    = $6000;  kbCtrlF4    = $6100;  kbCtrlF5    = $6200;
  kbCtrlF6    = $6300;  kbCtrlF7    = $6400;  kbCtrlF8    = $6500;
  kbCtrlF9    = $6600;  kbCtrlF10   = $6700;  kbAltF1     = $6800;
  kbAltF2     = $6900;  kbAltF3     = $6A00;  kbAltF4     = $6B00;
  kbAltF5     = $6C00;  kbAltF6     = $6D00;  kbAltF7     = $6E00;
  kbAltF8     = $6F00;  kbAltF9     = $7000;  kbAltF10    = $7100;
  kbCtrlPrtSc = $7200;  kbCtrlLeft  = $7300;  kbCtrlRight = $7400;
  kbCtrlEnd   = $7500;  kbCtrlPgDn  = $7600;  kbCtrlHome  = $7700;
  kbAlt1      = $7800;  kbAlt2      = $7900;  kbAlt3      = $7A00;
  kbAlt4      = $7B00;  kbAlt5      = $7C00;  kbAlt6      = $7D00;
  kbAlt7      = $7E00;  kbAlt8      = $7F00;  kbAlt9      = $8000;
  kbAlt0      = $8100;  kbAltMinus  = $8200;  kbAltEqual  = $8300;
  kbCtrlPgUp  = $8400;  kbAltBack   = $0800;  kbNoKey     = $0000;

{ Additional keyboard codes that Borland forgot to define }

 kbCtrlA      = $1E01;  kbCtrlB     = $3002;  kbCtrlC     = $2E03;
 kbCtrlD      = $2004;  kbCtrlE     = $1205;  kbCtrlF     = $2106;
 kbCtrlG      = $2207;  kbCtrlH     = $2308;  kbCtrlI     = $1709;
 kbCtrlJ      = $240A;  kbCtrlK     = $250B;  kbCtrlL     = $260C;
 kbCtrlM      = $320D;  kbCtrlN     = $310E;  kbCtrlO     = $180F;
 kbCtrlP      = $1910;  kbCtrlQ     = $1011;  kbCtrlR     = $1312;
 kbCtrlS      = $1F13;  kbCtrlT     = $1414;  kbCtrlU     = $1615;
 kbCtrlV      = $2F16;  kbCtrlW     = $1117;  kbCtrlX     = $2D18;
 kbCtrlY      = $1519;  kbCtrlZ     = $2C1A;

{ 101-key AT keyboard }

 kbAltTab     = $A500; kbAltDel     = $A300;  kbAltIns    = $A200;
 kbAltPgDn    = $A100; kbAltDown    = $A000;  kbAltEnd    = $9F00;
 kbAltRight   = $9D00; kbAltLeft    = $9B00;  kbAltPgUp   = $9900;
 kbAltUp      = $9800; kbAltHome    = $9700;  kbCtrlTab   = $9400;
 kbCtrlGreyPlus=$9000; kbCtrlCenter = $8F00;  kbCtrlMinus = $8E00;
 kbCtrlUp     = $8D00; kbAltF12     = $8C00;  kbAltF11    = $8B00;
 kbCtrlF12    = $8A00; kbCtrlF11    = $8900;  kbShiftF12  = $8800;
 kbShiftF11   = $8700; kbF12        = $8600;  kbF11       = $8500;
 kbAltGrayPlus= $4E00; kbCenter     = $4C00;  kbAltGreyAst= $3700;
 kbAltSlash   = $3500; kbAltPeriod  = $3400;  kbAltComma  = $3300;
 kbAltBackSlash=$2B00; kbAltOpQuote = $2900;  kbAltQuote  = $2800;
 kbAltSemicolon=$2700; kbAltRgtBrack= $1B00;  kbAltLftBrack=$1A00;
 kbAltEsc     = $0100; kbCtrlDown   = $9100;

{ Special keys }

kbAltShiftBack = $0900;

{ Keyboard state and shift masks }

  kbRightShift  = $0001;
  kbLeftShift   = $0002;
  kbCtrlShift   = $0004;
  kbAltShift    = $0008;
  kbScrollState = $0010;
  kbNumState    = $0020;
  kbCapsState   = $0040;
  kbInsState    = $0080;

{ Mouse button state masks }

  mbLeftButton  = $01;
  mbRightButton = $02;

type

{ Event record }

  PEvent = ^TEvent;
  TEvent = record
    What: Word;
    case Word of
      evNothing: ();
      evMouse: (
        Buttons: Byte;
        Double: Boolean;
        Where: TPoint);
      evKeyDown: (
        case Integer of
          0: (KeyCode: SmallWord;
              ShiftState: Byte);
          1: (CharCode: Char;
              ScanCode: Byte));
      evMessage: (
        Command: Word;
        case Word of
          0: (InfoPtr: Pointer);
          1: (InfoLong: Longint);
          2: (InfoWord: Word);
          3: (InfoInt: Integer);
          4: (InfoByte: Byte);
          5: (InfoChar: Char));
  end;

  TShiftStateHandler = function(var ShiftState: Byte): Boolean;
  TCtrlBreakAction = procedure;

const

{ Initialized variables }

  ButtonCount: Byte = 0;
  MouseEvents: Boolean = False;
  MouseReverse: Boolean = False;
  DoubleDelay: Word = 8;
  RepeatDelay: Word = 8;
  GetShiftStateHandler: TShiftStateHandler = nil;
  CtrlBreakAction: TCtrlBreakAction = nil;
  KeyDownMask: Word = evKeyDown;
  NonStandardModes = True;

var
  MouseButtons: Byte;
  MouseWhere: TPoint;
  MouseEventMask: SmallWord;
  CodePage: SmallWord;

{ Event manager routines }

procedure InitEvents;
procedure DoneEvents;
procedure ShowMouse;
procedure HideMouse;
procedure UpdateMouseWhere;
procedure GetMouseEvent(var Event: TEvent);
procedure GetKeyEvent(var Event: TEvent);
function GetShiftState: Byte;

{ ******** SCREEN MANAGER ******** }

const

{ Screen modes }

  smBW80        = $0002;
  smCO80        = $0003;
  smMono        = $0007;
  smNonStandard = $00FF;
  smFont8x8     = $0100;

const

{ Initialized variables }

  StartupMode: Word = $FFFF;
  CheckSnow: Boolean = False;   { not used }

var

{ Uninitialized variables }

  ScreenMode: Word;
  ScreenWidth: Byte;
  ScreenHeight: Byte;
  HiResScreen: Boolean;
  ScreenBuffer: Pointer;
  CursorLines: SmallWord;
  // ScreenMirror made larger to handle Win2000
  ScreenMirror: array[0..65535] of Byte;

{ Screen manager routines }

procedure InitVideo;
procedure DoneVideo;
procedure SetVideoMode(Mode: Word);
procedure ClearScreen;

{ Keyboard }

procedure InitKeyboard;

{ Initialized variables }

const
  CtrlBreakHit: Boolean = False;
  SaveCtrlBreak: Boolean = False;       { not used }
  SysErrActive: Boolean = False;
  FailSysErrors: Boolean = False;       { not used }

{ System error handler routines }

procedure InitSysError;
procedure DoneSysError;

{ ******** UTILITY ROUTINES ******** }

{ Keyboard support routines }

function GetAltChar(KeyCode: Word): Char;
function GetAltCode(Ch: Char): Word;
function GetCtrlChar(KeyCode: Word): Char;
function GetCtrlCode(Ch: Char): Word;
function CtrlToArrow(KeyCode: Word): Word;

{ String routines }

procedure FormatStr(var Result: String; const Format: String; var Params);
procedure PrintStr(const S: String);

{ Buffer move routines }

procedure MoveBuf(var Dest; var Source; Attr: Byte; Count: Word);
procedure MoveChar(var Dest; C: Char; Attr: Byte; Count: Word);
procedure MoveCStr(var Dest; const Str: String; Attrs: Word);
procedure MoveStr(var Dest; const Str: String; Attr: Byte);
function CStrLen(const S: String): Integer;

implementation

uses Dos, VpSysLow;

{ ******** EVENT MANAGER ******** }

var

{ Event manager variables }

  LastButtons: Byte;
  DownButtons: Byte;
  LastDouble: Boolean;
  DownWhere: TPoint;
  DownTicks: Word;
  AutoTicks: Word;
  AutoDelay: Word;
  StrtCurY1: Integer;
  StrtCurY2: Integer;
  StrtCurVisible: Boolean;

// Detects mouse driver, moves mouse pointer to the top left corner

procedure DetectMouse;
begin
  ButtonCount := SysTVDetectMouse;
end;

// Shows mouse pointer

procedure ShowMouse;
begin
  SysTVShowMouse;
end;

// Hides mouse pointer

procedure HideMouse;
begin
  SysTVHideMouse;
end;

// Initializes Turbo Vision's event manager by setting event mask and
// showing the mouse. Called automatically by TApplication.Init.

procedure InitEvents;
begin
  if ButtonCount <> 0 then
  begin
    DownButtons := 0;
    LastDouble := False;
    LastButtons := 0;       // Assume that no button is pressed
    SysTVInitMouse(MouseWhere.X, MouseWhere.Y);
    MouseEvents := True;
  end;
end;

// Terminates Turbo Vision's event manager and hides the mouse. Called
// automatically by TApplication.Done.

procedure DoneEvents;
begin
  if ButtonCount <> 0 then
  begin
    SysTVDoneMouse(False);
    MouseEvents := False;
  end;
end;

// Checks whether a mouse event is available by polling the mouse event
// queue maintained by OS/2. If a mouse event has occurred, Event.What
// is set to evMouseDown, evMouseUp,evMouseMove, or evMouseAuto;
// Event.Buttons is set to mbLeftButton or mbRightButton;
// Event.Double is set to True or False;
// Event.Where is set to the mouse position in global coordinates.
// If no mouse events are available, Event.What is set to evNothing.
// GetMouseEvent is called by TProgram.GetEvent.

procedure GetMouseEvent(var Event: TEvent);
var
  SysMouseEvent: TSysMouseEvent;
  CurTicks: Word;
  B: Byte;

procedure StoreEvent(MouWhat: Word);
begin
  LastButtons := MouseButtons;
  MouseWhere.X := SysMouseEvent.smePos.X;
  MouseWhere.Y := SysMouseEvent.smePos.Y;
  with Event do
  begin
    What := MouWhat;
    Buttons := MouseButtons;
    Double  := LastDouble;
    Where.X := SysMouseEvent.smePos.X;
    Where.Y := SysMouseEvent.smePos.Y;
  end;
end;

// GetMouseEvent body

begin
  if not MouseEvents then
    Event.What := evNothing
  else
    begin
      if not SysTVGetMouseEvent(SysMouseEvent) then
        begin
          MouseButtons := LastButtons;
          SysMouseEvent.smeTime := SysSysMsCount;
          SysMouseEvent.smePos.X := MouseWhere.X;
          SysMouseEvent.smePos.Y := MouseWhere.Y;
        end
      else
        begin
          if MouseReverse then
          begin
            B := 0;
            if (SysMouseEvent.smeButtons and $0001) <> 0 then
              Inc(B, $0002);
            if (SysMouseEvent.smeButtons and $0002) <> 0 then
              Inc(B, $0001);
            SysMouseEvent.smeButtons := B;
          end;
          MouseButtons := SysMouseEvent.smeButtons;
        end;
      // ms -> ticks: 1 DOS timer tick = 55ms
      CurTicks  := SysMouseEvent.smeTime div 55;
      // Process mouse event
      if (LastButtons <> 0) and (MouseButtons = 0) then
        StoreEvent(evMouseUp) // button is released
      else
        if LastButtons = MouseButtons then
          begin
            if (SysMouseEvent.smePos.Y <> MouseWhere.Y) or (SysMouseEvent.smePos.X <> MouseWhere.X) then
              StoreEvent(evMouseMove)
            else
              if (MouseButtons <> 0) and ((CurTicks - AutoTicks) >= AutoDelay) then
                begin
                  AutoTicks := CurTicks;
                  AutoDelay := 1;
                  StoreEvent(evMouseAuto);
                end
              else
                StoreEvent(evNothing);
          end
        else // CurButton <> 0, LastButton = 0
          begin
            LastDouble := False;
            if (MouseButtons = DownButtons) and (SysMouseEvent.smePos.Y = DownWhere.Y) and (SysMouseEvent.smePos.X = DownWhere.X)
              and ((CurTicks - DownTicks) < DoubleDelay) then
                LastDouble := True;
            DownButtons := MouseButtons;
            DownWhere.Y := SysMouseEvent.smePos.Y;
            DownWhere.X := SysMouseEvent.smePos.X;
            DownTicks   := CurTicks;
            AutoTicks   := CurTicks;
            AutoDelay   := RepeatDelay;
            StoreEvent(evMouseDown);
          end;
    end;
end;

procedure InitKeyboard;
begin
  SysTVKbdInit;
end;

procedure UpdateMouseWhere;
begin
  SysTVUpdateMouseWhere(MouseWhere.X, MouseWhere.Y);
end;

// Checks whether a keyboard event is available. If a key has been
// pressed, Event.What is set to evKeyDown and Event.KeyCode is set to
// the scan code of the key. Otherwise, Event.What is set to evNothing.
// GetKeyEvent is called by TProgram.GetEvent.

procedure GetKeyEvent(var Event: TEvent);
var
  I: Integer;
  SysKeyEvent: TSysKeyEvent;
// Keyboard scan codes
const
  scSpace    = $39;  scIns      = $52;  scDel      = $53;
  scBack     = $0E;  scUp       = $48;  scDown     = $50;
  scLeft     = $4B;  scRight    = $4D;  scHome     = $47;
  scEnd      = $4F;  scPgUp     = $49;  scPgDn     = $51;
  scCtrlIns  = $92;  scCtrlDel  = $93;  scCtrlUp   = $8D;
  scCtrlDown = $91;  kbShift    = kbLeftShift + kbRightShift;

type
  KeyTransEntry = record
    Scan:  Byte;
    Shift: Byte;
    Code:  SmallWord;
  end;

const
  KeyTranslateTable : array [1..15] of KeyTransEntry =
    (( Scan: scSpace   ; Shift: $08 ; Code: kbAltSpace    ), // Alt-Space
     ( Scan: scIns     ; Shift: $04 ; Code: kbCtrlIns     ), // Ctrl-Ins
     ( Scan: scCtrlIns ; Shift: $04 ; Code: kbCtrlIns     ), // Ctrl-Ins
     ( Scan: scIns     ; Shift: $01 ; Code: kbShiftIns    ), // Shift-Ins
     ( Scan: scIns     ; Shift: $02 ; Code: kbShiftIns    ), // Shift-Ins
     ( Scan: scIns     ; Shift: $03 ; Code: kbShiftIns    ), // Shift-Ins
     ( Scan: scDel     ; Shift: $04 ; Code: kbCtrlDel     ), // Ctrl-Del
     ( Scan: scCtrlDel ; Shift: $04 ; Code: kbCtrlDel     ), // Ctrl-Del
     ( Scan: scDel     ; Shift: $01 ; Code: kbShiftDel    ), // Shift-Del
     ( Scan: scDel     ; Shift: $02 ; Code: kbShiftDel    ), // Shift-Del
     ( Scan: scDel     ; Shift: $03 ; Code: kbShiftDel    ), // Shift-Del
     ( Scan: scBack    ; Shift: $09 ; Code: kbAltShiftBack), // Alt-Shift-Backspace
     ( Scan: scBack    ; Shift: $0A ; Code: kbAltShiftBack), // Alt-Shift-Backspace
     ( Scan: scBack    ; Shift: $0B ; Code: kbAltShiftBack), // Alt-Shift-Backspace
     ( Scan: scBack    ; Shift: $08 ; Code: kbAltBack    )); // Alt-Backspace
begin
  with Event do
    if not SysTVGetKeyEvent(SysKeyEvent) then
      What := evNothing
    else
      begin
        What       := KeyDownMask;
        KeyCode    := SysKeyEvent.skeKeyCode;
        ShiftState := SysKeyEvent.skeShiftState;
        for I := Low(KeyTranslateTable) to High(KeyTranslateTable) do
          with KeyTranslateTable[I] do
          begin
            if (Scan = ScanCode) and ((Shift and ShiftState) = Shift) then
            begin
              KeyCode := Code;
              Break;
            end;
          end;
        if (CharCode = #$E0) and (ScanCode in
          [scUp,scDown,scLeft,scRight,scIns,scDel,scHome,scEnd,scPgUp,scPgDn,
          Hi(kbCtrlHome), Hi(kbCtrlEnd)  , Hi(kbCtrlPgUp), Hi(kbCtrlPgDn),
          Hi(kbCtrlLeft), Hi(kbCtrlRight),    scCtrlUp,       scCtrlDown]) then
            CharCode := #0;      // Grey Keys
        if KeyCode = $E00D then  // Grey Enter
          KeyCode := kbEnter;
        InfoPtr := nil;
      end;
end;

// Returns a byte containing the current Shift key state, as reported by
// the system. The return value contains a combination of the kbXXXX constants
// for shift states.

function GetShiftState: Byte;
var
  Handled: Boolean;
begin
  Handled := False;
  if @GetShiftStateHandler <> nil then
    Handled := GetShiftStateHandler(Result);
  if not Handled then
    Result := SysTVGetShiftState;
end;

{ ******** SCREEN MANAGER ******** }

// Fixes the CRT mode if required

function FixCrtMode(Mode: Word): Word;
begin
  case Lo(Mode) of
    smMono,smCO80,smBW80:
      FixCrtMode := Mode;
    smNonStandard:
      if NonStandardModes then
        FixCrtMode := Mode
      else
        FixCrtMode := smCO80;
    else FixCrtMode := smCO80;
  end;
end;

// Updates the CRT-related variables

procedure SetCrtData;
var
  BufSize: SmallWord;
  Y1,Y2: Integer;
  Visible: Boolean;
  SrcSize: TSysPoint;
begin
  ScreenMode := SysTVGetScrMode(@SrcSize);
  ScreenHeight := SrcSize.Y;
  ScreenWidth := SrcSize.X;
  ShowMouse;
  HiResScreen := True;
  ScreenBuffer := SysTVGetSrcBuf;
  SysTVGetCurType(Y1, Y2, Visible);
  WordRec(CursorLines).Hi := Y1;
  WordRec(CursorLines).Lo := Y2;
  SysTVSetCurType(Y1, Y2, False);   // Hide cursor
end;

// Detects video modes

procedure DetectVideo;
begin
  ScreenMode := FixCrtMode(SysTVGetScrMode(nil));
end;

// Initializes Turbo Vision's video manager. Saves the current screen
// mode in StartupMode, and switches the screen to the mode indicated by
// ScreenMode. The ScreenWidth, ScreenHeight, HiResScreen, ScreenBuffer,
// and CursorLines variables are updated accordingly.InitVideo is called
// automatically by TApplication.Init.

procedure InitVideo;
begin
  SysTVGetCurType(StrtCurY1, StrtCurY2, StrtCurVisible);
  if StartupMode = $FFFF then
     StartupMode := SysTVGetScrMode(nil);
  if StartupMode <> ScreenMode then
    SysTVSetScrMode(ScreenMode);
  SetCrtData;
end;

// Terminates Turbo Vision's video manager by restoring the initial
// screen mode, clearing the screen, and restoring the cursor. Called
// automatically by TApplication.Done.

procedure DoneVideo;
begin
  if (StartupMode <> $FFFF) and (StartupMode <> ScreenMode) then
    SysTVSetScrMode(StartupMode);
  ClearScreen;
  SysTVSetCurType(StrtCurY1, StrtCurY2, StrtCurVisible);
  FillChar(ScreenMirror, SizeOf(ScreenMirror), 0);
end;

// Sets the video mode. Mode is one of the constants smCO80, smBW80, or smMono,
// optionally with smFont8x8 added to select 43- or 50-line mode on an EGA or
// VGA. SetVideoMode initializes the same variables as InitVideo (except for
// the StartupMode variable, which isn't affected).

procedure SetVideoMode(Mode: Word);
begin
  SysTVSetScrMode(FixCrtMode(Mode));
  SetCrtData;
end;

// Clears the screen, moves cursor to the top left corner

procedure ClearScreen;
begin
  SysTVClrScr;
end;

{ ********************* SYSTEM ERROR HANDLER ************************** }

// Initializes Turbo Vision's system error handler. Called automatically
// by TApplication.Init. Since no error handler is available,InitSysError
// sets SysErrActive to True and does nothing.

procedure InitSysError;
begin
  SysErrActive := True;
end;

// Terminates Turbo Vision's system error handler. Called automatically
// by TApplication.Done. Since no error handler is available,DoneSysError
// sets SysErrActive to False and does nothing.

procedure DoneSysError;
begin
  SysErrActive := False;
end;

// Ctrl-Break handler

function TVCtrlBreak: Boolean;
begin
  CtrlBreakHit := True;
  Result := True;
end;

{ ******** UTILITY ROUTINES ******** }

// Keyboard support routines

const

  AltCodes1: array[$10..$32] of Char =
    'QWERTYUIOP'#0#0#0#0'ASDFGHJKL'#0#0#0#0#0'ZXCVBNM';

  AltCodes2: array[$78..$83] of Char =
    '1234567890-=';

function GetAltChar(KeyCode: Word): Char;
begin
  GetAltChar := #0;
  if Lo(KeyCode) = 0 then
    case Hi(KeyCode) of
      $02: GetAltChar := #240;
      $10..$32: GetAltChar := AltCodes1[Hi(KeyCode)];
      $78..$83: GetAltChar := AltCodes2[Hi(KeyCode)];
    end;
end;

function GetAltCode(Ch: Char): Word;
var
  I: Word;
begin
  GetAltCode := 0;
  if Ch = #0 then Exit;
  Ch := UpCase(Ch);
  if Ch = #240 then
  begin
    GetAltCode := $0200;
    Exit;
  end;
  for I := $10 to $32 do
    if AltCodes1[I] = Ch then
    begin
      GetAltCode := I shl 8;
      Exit;
    end;
  for I := $78 to $83 do
    if AltCodes2[I] = Ch then
    begin
      GetAltCode := I shl 8;
      Exit;
    end;
end;

function GetCtrlChar(KeyCode: Word): Char;
begin
  GetCtrlChar := #0;
  if (Lo(KeyCode) <> 0) and (Lo(KeyCode) <= Byte('Z') - Byte('A') + 1) then
    GetCtrlChar := Char(Lo(KeyCode) + Byte('A') - 1);
end;

function GetCtrlCode(Ch: Char): Word;
begin
  GetCtrlCode := GetAltCode(Ch) or (Byte(UpCase(Ch)) - Byte('A') + 1);
end;

function CtrlToArrow(KeyCode: Word): Word;
const
  NumCodes = 11;
  CtrlCodes: array[0..NumCodes-1] of Char = ^S^D^E^X^A^F^G^V^R^C^H;
  ArrowCodes: array[0..NumCodes-1] of Word =
    (kbLeft, kbRight, kbUp, kbDown, kbHome, kbEnd, kbDel, kbIns,
     kbPgUp, kbPgDn, kbBack);
var
  I: Integer;
begin
  CtrlToArrow := KeyCode;
  for I := 0 to NumCodes - 1 do
    if WordRec(KeyCode).Lo = Byte(CtrlCodes[I]) then
    begin
      CtrlToArrow := ArrowCodes[I];
      Exit;
    end;
end;

// A generalized string formatting routine. Given a string in Format
// that includes format specifiers and a list of parameters in Params,
// FormatStr produces a formatted output string in Result.
// Format specifiers are of the form %[-][nnn]X, where
//   % indicates the beginning of a format specifier
//  [-] is an optional minus sign (-) indicating the parameter is to be
//      left-justified (by default, parameters are right-justified)
// [nnn] is an optional, decimal-number width specifier in the range
//      0..255 (0 indicates no width specified, and non-zero means to
//      display in a field of nnn characters)
//   X  is a format character:
//   's' means the parameter is a pointer to a string.
//   'd' means the parameter is a Longint to be displayed in decimal.
//   'c' means the low byte of the parameter is a character.
//   'x' means the parameter is a Longint to be displayed in hexadecimal.
//   '#' sets the parameter index to nnn.

procedure FormatStr(var Result: String; const Format: String; var Params);
  assembler; {&USES ebx,esi,edi} {&FRAME+}
var
  ParOfs: Longint;
  Filler,Justify: Byte;
  Buffer: array [1..12] of Byte;
const
  HexDigits: array [0..15] of Char = '0123456789ABCDEF';

// Convert next parameter to string
// EXPECTS:     al    = Conversion character
// RETURNS:     esi   = Pointer to string
//              ecx   = String length

procedure Convert; {&USES None} {&FRAME-}
asm
                mov     edx,eax
                mov     esi,Params
                lodsd
                mov     Params,esi
                xor     ecx,ecx
                lea     esi,Buffer[TYPE Buffer]
                and     dl,0DFh         // UpCase(ConversionChar)
                cmp     dl,'C'
                je      @@ConvertChar
                cmp     dl,'S'
                je      @@ConvertStr
                cmp     dl,'D'
                je      @@ConvertDec
                cmp     dl,'X'
                jne     @@Done
// ConvertHex
              @@1:
                mov     edx,eax
                and     edx,0Fh
                mov     dl,HexDigits.Byte[edx]
                dec     esi
                inc     ecx
                mov     [esi],dl
                shr     eax,4
                jnz     @@1
                jmp     @@Done
@@ConvertDec:
                push    esi
                mov     ebx,eax
                mov     ecx,10
                test    eax,eax
                jns     @@2
                neg     eax
              @@2:
                xor     edx,edx
                dec     esi
                div     ecx
                add     dl,'0'
                mov     [esi],dl
                test    eax,eax
                jnz     @@2
                pop     ecx
                sub     ecx,esi
                test    ebx,ebx
                jns     @@Done
                mov     al,'-'
@@ConvertChar:
                inc     ecx
                dec     esi
                mov     [esi],al
                jmp     @@Done
@@ConvertStr:
                test    eax,eax
                jz      @@Done
                mov     esi,eax
                lodsb
                mov     cl,al
              @@Done:
end;

// FormatStr body

asm
                mov     eax,Params
                mov     ParOfs,eax
                xor     eax,eax
                mov     esi,Format
                mov     edi,Result
                inc     edi
                cld
                lodsb
                mov     ecx,eax
                mov     ebx,255
              @@1:
                dec     ecx
                js      @@End
                lodsb
                cmp     al,'%'
                je      @@3
                dec     ebx
                js      @@End
              @@2:
                stosb
                jmp     @@1
              @@3:
                dec     ecx
                js      @@End
                lodsb
                cmp     al,'%'
                je      @@2
                mov     Justify,0       // Justify (0:right, 1:left)
                mov     Filler,' '
                xor     edx,edx         // edx = Field width (0:no width)
                cmp     al,'0'
                jne     @@4
                mov     Filler,al
              @@4:
                cmp     al,'-'
                jne     @@5
                inc     Justify
                dec     ecx
                js      @@End
                lodsb
              @@5:
                cmp     al,'0'
                jb      @@6
                cmp     al,'9'
                ja      @@6
                sub     al,'0'
                xchg    eax,edx
                mov     ah,10
                mul     ah
                add     al,dl
                xchg    eax,edx
                dec     ecx
                js      @@End
                lodsb
                jmp     @@5
              @@6:
                cmp     al,'#'
                jne     @@10
                shl     edx,2
                add     edx,ParOfs
                mov     Params,edx
                jmp     @@1
              @@End:
                mov     eax,Result
                mov     ecx,edi
                sub     ecx,eax
                dec     ecx
                mov     [eax],cl
                jmp     @@Done
              @@10:
                push    esi
                push    ecx
                push    edx
                push    ebx
                Call    Convert
                pop     ebx
                pop     edx
                test    edx,edx
                jz      @@12
                sub     edx,ecx
                jae     @@12
                cmp     Justify,0
                jnz     @@11
                sub     esi,edx
              @@11:
                add     ecx,edx
                xor     edx,edx
              @@12:
                cmp     Justify,0
                jz      @@14
                cmp     ecx,ebx
                jbe     @@13
                mov     ecx,ebx
              @@13:
                sub     ebx,ecx
                rep     movsb           // Copy formated parm (left-justified)
              @@14:
                xchg    ecx,edx
                mov     al,Filler
                cmp     ecx,ebx
                jbe     @@15
                mov     ecx,ebx
              @@15:
                sub     ebx,ecx
                rep     stosb           // Fill unused space
                xchg    ecx,edx
                cmp     ecx,ebx
                jbe     @@16
                mov     ecx,ebx
              @@16:
                sub     ebx,ecx
                rep     movsb           // Copy formated parm (right-justified)
                pop     ecx
                pop     esi
                jmp     @@1
              @@Done:
end;

// Prints the string on the screen

procedure PrintStr(const S: String);
var
  Count: Longint;
begin
  SysFileWrite(SysFileStdOut, S[1], Length(S), Count);
end;

// Buffer move routines

// Moves text and video attributes into a buffer. Count bytes are moved
// from Source into the low bytes of corresponding words in Dest. The
// high bytes of the words in Dest are set to Attr, or remain unchanged
// if Attr is zero.

procedure MoveBuf(var Dest; var Source; Attr: Byte; Count: Word); {&USES esi,edi} {&FRAME-}
asm
                mov     ecx,Count
                jecxz   @@4
                mov     edi,Dest
                mov     esi,Source
                mov     ah,Attr
                cld
                test    ah,ah
                jz      @@3
              @@1:
                lodsb
                stosw
                loop    @@1
                jmp     @@4
              @@2:
                inc     edi
              @@3:
                movsb
                loop    @@2
              @@4:
end;

// Moves characters into a buffer. The low bytes of the first Count
// words of Dest are set to C, or remain unchanged if C = #0. The high
// bytes of the words are set to Attr, or remain unchanged if Attr is
// zero.

procedure MoveChar(var Dest; C: Char; Attr: Byte; Count: Word); {&USES edi} {&FRAME-}
asm
                mov     ecx,Count
                jecxz   @@4
                mov     edi,Dest
                mov     al,C
                mov     ah,Attr
                cld
                test    al,al
                jz      @@1
                test    ah,ah
                jz      @@3
                mov     edx,eax
                shl     eax,16
                mov     ax,dx
                shr     ecx,1
                rep     stosd
                adc     ecx,ecx
                rep     stosw
                jmp     @@4
              @@1:
                mov     al,ah
              @@2:
                inc     edi
              @@3:
                stosb
                loop    @@2
              @@4:
end;

// Moves a two-colored string into a buffer. The characters in Str are
// moved into the low bytes of corresponding words in Dest. The high
// bytes of the words are set to Lo(Attr) or Hi(Attr). Tilde characters
// (~) in the string toggle between the two attribute bytes passed in
// the Attr word.

procedure MoveCStr(var Dest; const Str: String; Attrs: Word); {&USES esi,edi} {&FRAME-}
asm
                xor     ecx,ecx
                mov     esi,Str
                cld
                lodsb
                mov     cl,al
                jecxz   @@3
                mov     edi,Dest
                mov     edx,Attrs
                mov     ah,dl
              @@1:
                lodsb
                cmp     al,'~'
                je      @@2
                stosw
                loop    @@1
                jmp     @@3
              @@2:
                xchg    ah,dh
                loop    @@1
              @@3:
end;

// Moves a string into a buffer. The characters in Str are moved into
// the low bytes of corresponding words in Dest. The high bytes of the
// words are set to Attr, or remain unchanged if Attr is zero.

procedure MoveStr(var Dest; const Str: String; Attr: Byte); {&USES esi,edi} {&FRAME-}
asm
                xor     ecx,ecx
                mov     esi,Str
                cld
                lodsb
                mov     cl,al
                jecxz   @@4
                mov     edi,Dest
                mov     ah,Attr
                test    ah,ah
                jz      @@3
              @@1:
                lodsb
                stosw
                loop    @@1
                jmp     @@4
              @@2:
                inc     edi
              @@3:
                movsb
                loop    @@2
              @@4:
end;

// Returns the length of string S, where S is a control string using
// tilde characters ('~') to designate shortcut characters. The tildes
// are excluded from the length of the string, as they will not appear
// on the screen.

function CStrLen(const S: String): Integer; {&USES edi} {&FRAME-}
asm
                xor     ecx,ecx
                mov     edi,S
                mov     cl,[edi]
                inc     edi
                mov     edx,ecx
                jecxz   @@2
                mov     al,'~'
                cld
              @@1:
                repne   scasb
                jne     @@2
                dec     edx
                test    esp,esp
                jmp     @@1
              @@2:
                mov     eax,edx
end;

// Drivers unit initialization and shutdown

var
  SaveExit: Pointer;

procedure ExitDrivers;
begin
  DoneSysError;
  DoneEvents;
  SysTVDoneMouse(True);
  ExitProc := SaveExit;
end;

begin
  CodePage := SysGetCodePage;
  SysTVInitCursor;
  InitKeyboard;
  DetectMouse;
  DetectVideo;
  SaveExit := ExitProc;
  ExitProc := @ExitDrivers;
  CtrlBreakHandler := TVCtrlBreak;
  SysCtrlSetCBreakHandler;
end.
