{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
{                                                          }
{    System independent clone of DRIVERS.PAS               }
{                                                          }
{    Interface Copyright (c) 1992 Borland International    }
{                                                          }
{    Copyright (c) 1996, 1997, 1998, 1999, 2000            }
{    by Leon de Boer                                       }
{    ldeboer@attglobal.net  - primary e-mail addr          }
{    ldeboer@projectent.com.au - backup e-mail addr        }
{                                                          }
{    Original FormatStr kindly donated by Marco Schmidt    }
{                                                          }
{    Mouse callback hook under FPC with kind assistance of }
{    Pierre Muller, Gertjan Schouten & Florian Klaempfl.   }
{                                                          }
{****************[ THIS CODE IS FREEWARE ]*****************}
{                                                          }
{     This sourcecode is released for the purpose to       }
{   promote the pascal language on all platforms. You may  }
{   redistribute it and/or modify with the following       }
{   DISCLAIMER.                                            }
{                                                          }
{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
{                                                          }
{*****************[ SUPPORTED PLATFORMS ]******************}
{                                                          }
{ Only Free Pascal Compiler supported                      }
{                                                          }
{**********************************************************}

{$IFNDEF FPC_DOTTEDUNITS}
{$ifdef FV_UNICODE}
UNIT UDrivers;
{$else FV_UNICODE}
UNIT Drivers;
{$endif FV_UNICODE}
{$ENDIF FPC_DOTTEDUNITS}

{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                                  INTERFACE
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

{====Include file to sort compiler platform out =====================}
{$I platform.inc}
{====================================================================}

{==== Compiler directives ===========================================}

{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$IFNDEF OS_UNIX}
{$S-} { Disable Stack Checking }
{$ENDIF}
{$I-} { Disable IO Checking }
{$Q-} { Disable Overflow Checking }
{$V-} { Turn off strict VAR strings }
{====================================================================}

{$ifdef CPU68K}
  {$DEFINE ENDIAN_BIG}
{$endif CPU68K}

{$ifdef FPC}
  {$INLINE ON}
{$endif}

{$IFDEF FPC_DOTTEDUNITS}
USES
   {$IFDEF OS_WINDOWS}                                { WIN/NT CODE }
         WinApi.Windows,                                     { Standard unit }
   {$ENDIF}

   {$IFDEF OS_WIN16}                                  { WIN16 CODE }
         WinApi.WinProcs, WinApi.WinTypes,                          { Standard units }
         System.Console.Crt,                                         { used for Delay() }
   {$ENDIF}

   {$ifdef OS_DOS}
     TP.DOS,
   {$endif OS_DOS}

   {$IFDEF OS_OS2}                                    { OS2 CODE }
     {$IFDEF PPC_Virtual}                             { VIRTUAL PASCAL UNITS }
       OS2Api.os2def, OS2Base, OS2PMAPI,                     { Standard units }
     {$ENDIF}
     {$IFDEF PPC_Speed}                               { SPEED PASCAL UNITS }
       BseDos, Os2Def,                                { Standard units }
     {$ENDIF}
     {$IFDEF PPC_FPC}                                 { FPC UNITS }
       OS2Api.doscalls, Os2Def,                              { Standard units }
     {$ENDIF}
   {$ENDIF}

   {$IFDEF OS_UNIX}
       UnixApi.Types,UnixApi.Base,UnixApi.Unix,
   {$ENDIF}

   {$IFDEF OS_NETWARE_LIBC}
      Api.Libc,
   {$ENDIF}
   {$IFDEF OS_NETWARE_CLIB}
      NetWareApi.nwserv,
   {$ENDIF}

   {$IFDEF OS_AMIGA}
      dos, Amiga.Core.Amigados,
   {$ENDIF}

   System.Console.Video,
   FreeVision.Sysmsg,
{$ifdef FV_UNICODE}
   FreeVision.UfvCommon,
   System.Unicode.Graphemebreakproperty,
{$else FV_UNICODE}
   FreeVision.Fvcommon,
{$endif FV_UNICODE}
   System.Objects;                                 { GFV standard units }
{$ELSE FPC_DOTTEDUNITS}
USES
   {$IFDEF OS_WINDOWS}                                { WIN/NT CODE }
         Windows,                                     { Standard unit }
   {$ENDIF}

   {$IFDEF OS_WIN16}                                  { WIN16 CODE }
         WinProcs, WinTypes,                          { Standard units }
         Crt,                                         { used for Delay() }
   {$ENDIF}

   {$ifdef OS_DOS}
     Dos,
   {$endif OS_DOS}

   {$IFDEF OS_OS2}                                    { OS2 CODE }
     {$IFDEF PPC_Virtual}                             { VIRTUAL PASCAL UNITS }
       OS2Def, OS2Base, OS2PMAPI,                     { Standard units }
     {$ENDIF}
     {$IFDEF PPC_Speed}                               { SPEED PASCAL UNITS }
       BseDos, Os2Def,                                { Standard units }
     {$ENDIF}
     {$IFDEF PPC_FPC}                                 { FPC UNITS }
       DosCalls, Os2Def,                              { Standard units }
     {$ENDIF}
   {$ENDIF}

   {$IFDEF OS_UNIX}
       unixtype,baseunix,unix,
   {$ENDIF}

   {$IFDEF OS_NETWARE_LIBC}
      libc,
   {$ENDIF}
   {$IFDEF OS_NETWARE_CLIB}
      nwserv,
   {$ENDIF}

   {$IFDEF OS_AMIGA}
      dos, amigados,
   {$ENDIF}

   video,
   SysMsg,
{$ifdef FV_UNICODE}
   UFVCommon,
   GraphemeBreakProperty,
{$else FV_UNICODE}
   FVCommon,
{$endif FV_UNICODE}
   Objects;                                 { GFV standard units }
{$ENDIF FPC_DOTTEDUNITS}

{***************************************************************************}
{                              PUBLIC CONSTANTS                             }
{***************************************************************************}

{---------------------------------------------------------------------------}
{                              EVENT TYPE MASKS                             }
{---------------------------------------------------------------------------}
CONST
   evMouseDown = $0001;                               { Mouse down event }
   evMouseUp   = $0002;                               { Mouse up event }
   evMouseMove = $0004;                               { Mouse move event }
   evMouseAuto = $0008;                               { Mouse auto event }
   { Idea of evMouseWheel to be separate event type comes from https://github.com/magiblot/tvision }
   evMouseWheel= $0020;                               { Mouse wheel event }
   evKeyDown   = $0010;                               { Key down event }
   evCommand   = $0100;                               { Command event }
   evBroadcast = $0200;                               { Broadcast event }

{---------------------------------------------------------------------------}
{                             EVENT CODE MASKS                              }
{---------------------------------------------------------------------------}
CONST
   evNothing   = $0000;                               { Empty event }
   evMouse     = $002F;                               { Mouse event }
   evKeyboard  = $0010;                               { Keyboard event }
   evMessage   = $FF00;                               { Message event }

{---------------------------------------------------------------------------}
{                             EXTENDED KEY CODES                            }
{---------------------------------------------------------------------------}
CONST
   kbNoKey       = $0000;  kbAltEsc      = $0100;  kbEsc         = $011B;
   kbAltSpace    = $0200;  kbCtrlIns     = $0400;  kbShiftIns    = $0500;
   kbCtrlDel     = $0600;  kbShiftDel    = $0700;  kbAltBack     = $0800;
   kbAltShiftBack= $0900;  kbBack        = $0E08;  kbCtrlBack    = $0E7F;
   kbShiftTab    = $0F00;  kbTab         = $0F09;  kbAltQ        = $1000;
   kbCtrlQ       = $1011;  kbAltW        = $1100;  kbCtrlW       = $1117;
   kbAltE        = $1200;  kbCtrlE       = $1205;  kbAltR        = $1300;
   kbCtrlR       = $1312;  kbAltT        = $1400;  kbCtrlT       = $1414;
   kbAltY        = $1500;  kbCtrlY       = $1519;  kbAltU        = $1600;
   kbCtrlU       = $1615;  kbAltI        = $1700;  kbCtrlI       = $1709;
   kbAltO        = $1800;  kbCtrlO       = $180F;  kbAltP        = $1900;
   kbCtrlP       = $1910;  kbAltLftBrack = $1A00;  kbAltRgtBrack = $1B00;
   kbCtrlEnter   = $1C0A;  kbEnter       = $1C0D;  kbAltA        = $1E00;
   kbCtrlA       = $1E01;  kbAltS        = $1F00;  kbCtrlS       = $1F13;
   kbAltD        = $2000;  kbCtrlD       = $2004;  kbAltF        = $2100;
   kbCtrlF       = $2106;  kbAltG        = $2200;  kbCtrlG       = $2207;
   kbAltH        = $2300;  kbCtrlH       = $2308;  kbAltJ        = $2400;
   kbCtrlJ       = $240A;  kbAltK        = $2500;  kbCtrlK       = $250B;
   kbAltL        = $2600;  kbCtrlL       = $260C;  kbAltSemiCol  = $2700;
   kbAltQuote    = $2800;  kbAltOpQuote  = $2900;  kbAltBkSlash  = $2B00;
   kbAltZ        = $2C00;  kbCtrlZ       = $2C1A;  kbAltX        = $2D00;
   kbCtrlX       = $2D18;  kbAltC        = $2E00;  kbCtrlC       = $2E03;
   kbAltV        = $2F00;  kbCtrlV       = $2F16;  kbAltB        = $3000;
   kbCtrlB       = $3002;  kbAltN        = $3100;  kbCtrlN       = $310E;
   kbAltM        = $3200;  kbCtrlM       = $320D;  kbAltComma    = $3300;
   kbAltPeriod   = $3400;  kbAltSlash    = $3500;  kbAltGreyAst  = $3700;
   kbSpaceBar    = $3920;  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;  kbCenter      = $4C00;  kbRight       = $4D00;
   kbAltGrayPlus = $4E00;  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;  kbF11         = $8500;
   kbF12         = $8600;  kbShiftF11    = $8700;  kbShiftF12    = $8800;
   kbCtrlF11     = $8900;  kbCtrlF12     = $8A00;  kbAltF11      = $8B00;
   kbAltF12      = $8C00;  kbCtrlUp      = $8D00;  kbCtrlMinus   = $8E00;
   kbCtrlCenter  = $8F00;  kbCtrlGreyPlus= $9000;  kbCtrlDown    = $9100;
   kbCtrlTab     = $9400;  kbAltHome     = $9700;  kbAltUp       = $9800;
   kbAltPgUp     = $9900;  kbAltLeft     = $9B00;  kbAltRight    = $9D00;
   kbAltEnd      = $9F00;  kbAltDown     = $A000;  kbAltPgDn     = $A100;
   kbAltIns      = $A200;  kbAltDel      = $A300;  kbAltTab      = $A500;

{ ------------------------------- REMARK ------------------------------ }
{ New keys not initially defined by Borland in their unit interface.    }
{ ------------------------------ END REMARK --- Leon de Boer, 15May96 - }
   kbFullStop    = $342E;  kbComma       = $332C;  kbBackSlash   = $352F;
   kbApostrophe  = $2827;  kbSemiColon   = $273B;  kbEqual       = $0D3D;
   kbGreaterThan = $343E;  kbLessThan    = $333C;  kbQuestion    = $353F;
   kbQuote       = $2822;  kbColon       = $273A;  kbPlus        = $0D2B;
   kbPipe        = $2B7C;  kbSlash       = $2B5C;  kbExclaim     = $0221;
   kbAt          = $0340;  kbNumber      = $0423;  kbPercent     = $0625;
   kbCaret       = $075E;  kbAmpersand   = $0826;  kbAsterix     = $092A;
   kbLeftBracket = $0A28;  kbRightBracket= $0B29;  kbApprox      = $2960;
   kbTilde       = $297E;  kbDollar      = $0524;  kbMinus       = $0C2D;
   kbUnderline   = $0C5F;  kbLeftSqBr    = $1A5B;  kbRightSqBr   = $1B5D;
   kbLeftCurlyBr = $1A7B;  kbRightCurlyBr= $1B7D;

{---------------------------------------------------------------------------}
{                      KEYBOARD STATE AND SHIFT MASKS                       }
{---------------------------------------------------------------------------}
CONST
   kbRightShift  = $0001;                             { Right shift key }
   kbLeftShift   = $0002;                             { Left shift key }
   kbCtrlShift   = $0004;                             { Control key down }
   kbAltShift    = $0008;                             { Alt key down }
   kbScrollState = $0010;                             { Scroll lock on }
   kbNumState    = $0020;                             { Number lock on }
   kbCapsState   = $0040;                             { Caps lock on }
   kbInsState    = $0080;                             { Insert mode on }

   kbBothShifts  = kbRightShift + kbLeftShift;        { Right & Left shifts }

{---------------------------------------------------------------------------}
{                         MOUSE BUTTON STATE MASKS                          }
{---------------------------------------------------------------------------}
CONST
   mbLeftButton      = $01;                           { Left mouse button }
   mbRightButton     = $02;                           { Right mouse button }
   mbMiddleButton    = $04;                           { Middle mouse button }
   mbScrollWheelDown = $08 deprecated 'use evMouseWheel event and mwDown instead';
   mbScrollWheelUp   = $10 deprecated 'use evMouseWheel event and mwUp instead';
   mbXButton1        = $20;                           { 4th mouse button. Browser_Back }
   mbXButton2        = $40;                           { 5th mouse button. Browser_Forward }

{---------------------------------------------------------------------------}
{                         MOUSE WHEEL STATES                                }
{---------------------------------------------------------------------------}
CONST
   mwUp     = $01;      { Scroll up - turn the wheel upward (away from you) }
   mwDown   = $02;      { Scroll down - turn the wheel downward (toward you) }
   mwLeft   = $04;      { not implemented }
   mwRight  = $08;      { not implemented }

{---------------------------------------------------------------------------}
{                         SCREEN CRT MODE CONSTANTS                         }
{---------------------------------------------------------------------------}
CONST
   smBW80    = $0002;                                 { Black and white }
   smCO80    = $0003;                                 { Colour mode }
   smMono    = $0007;                                 { Monochrome mode }
   smFont8x8 = $0100;                                 { 8x8 font mode }

{***************************************************************************}
{                          PUBLIC TYPE DEFINITIONS                          }
{***************************************************************************}

{ ******************************* REMARK ****************************** }
{    The TEvent definition is completely compatable with all existing   }
{  code but adds two new fields ID and Data into the message record     }
{  which helps with WIN/NT and OS2 message processing.                  }
{ ****************************** END REMARK *** Leon de Boer, 11Sep97 * }

{---------------------------------------------------------------------------}
{                          EVENT RECORD DEFINITION                          }
{---------------------------------------------------------------------------}
TYPE
   TEvent =
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
   PACKED
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
   RECORD
      What: Sw_Word;                                     { Event type }
      Case Sw_Word Of
        evNothing: ();                                { ** NO EVENT ** }
        evMouse: (
          Buttons: Byte;                              { Mouse buttons }
          Wheel:   Byte;                              { Mouse wheel }
          Double: Boolean;                            { Double click state }
          Triple: Boolean;                            { Triple click state }
          Where: TPoint);                             { Mouse position }
        evKeyDown: (
        { ** KEY EVENT ** }
          Case Sw_Integer Of
            0: (KeyCode:  Word);                       { Full key code }
            1: (
{$ifdef ENDIAN_BIG}
                ScanCode: Byte;
                CharCode: AnsiChar;
{$else not ENDIAN_BIG}
                CharCode: AnsiChar;                       { AnsiChar code }
                ScanCode: Byte;                       { Scan code }
{$endif not ENDIAN_BIG}
                UnicodeChar: WideChar;                { Unicode AnsiChar code.
                          Code points from the Supplementary Planes (U+010000 to
                          U+10FFFF) are encoded as 2 consecutive key events,
                          forming an UTF-16 surrogate pair. }
                KeyShift: byte));                     { Shift states }
        evMessage: (                                  { ** MESSAGE EVENT ** }
          Command: Sw_Word;                              { Message command }
          Id     : Sw_Word;                              { Message id }
          Data   : Real;                              { Message data }
          Case Sw_Word Of
            0: (InfoPtr: Pointer);                    { Message pointer }
            1: (InfoLong: Longint);                   { Message longint }
            2: (InfoWord: Word);                      { Message Sw_Word }
            3: (InfoInt: SmallInt);                   { Message Sw_Integer }
            4: (InfoByte: Byte);                      { Message byte }
            5: (InfoChar: AnsiChar));                     { Message character }
   END;
   PEvent = ^TEvent;

   TVideoMode = {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.TVideoMode;                     { Screen mode }

{---------------------------------------------------------------------------}
{                    ERROR HANDLER FUNCTION DEFINITION                      }
{---------------------------------------------------------------------------}
TYPE
   TSysErrorFunc = FUNCTION (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;

{***************************************************************************}
{                            INTERFACE ROUTINES                             }
{***************************************************************************}

{ Get Dos counter ticks }
Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }


procedure GiveUpTimeSlice;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                          BUFFER MOVE ROUTINES                             }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}


{$ifdef FV_UNICODE}
{-EgcWidth-----------------------------------------------------------
Returns the number of display columns needed to display the extended
grapheme cluster EGC.
---------------------------------------------------------------------}
FUNCTION EgcWidth(Const EGC: Sw_String): Sw_Integer;
{$endif FV_UNICODE}

{-StrWidth-----------------------------------------------------------
Returns the number of display columns needed to display the string S.
---------------------------------------------------------------------}
FUNCTION StrWidth(Const S: Sw_String): Sw_Integer;

{-CStrLen------------------------------------------------------------
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. For example, given the string '~B~roccoli' as its
parameter, CStrLen returns 8.
25May96 LdB
---------------------------------------------------------------------}
FUNCTION CStrLen (Const S: Sw_String): Sw_Integer;

{-MoveStr------------------------------------------------------------
Moves a string into a buffer for use with a view's WriteBuf or WriteLine.
Dest must be a TDrawBuffer (or an equivalent array of Sw_Words). The
characters in Str are moved into the low bytes of corresponding Sw_Words
in Dest. The high bytes of the Sw_Words are set to Attr, or remain
unchanged if Attr is zero.
25May96 LdB
---------------------------------------------------------------------}
PROCEDURE MoveStr (Var Dest; Const Str: Sw_String; Attr: Byte);

{-MoveCStr-----------------------------------------------------------
The characters in Str are moved into the low bytes of corresponding
Sw_Words in Dest. The high bytes of the Sw_Words are set to Lo(Attr) or
Hi(Attr). Tilde characters (~) in the string toggle between the two
attribute bytes passed in the Attr Sw_Word.
25May96 LdB
---------------------------------------------------------------------}
PROCEDURE MoveCStr (Var Dest; Const Str: Sw_String; Attrs: Word);

{-MoveBuf------------------------------------------------------------
Count bytes are moved from Source into the low bytes of corresponding
Sw_Words in Dest. The high bytes of the Sw_Words in Dest are set to Attr,
or remain unchanged if Attr is zero.
25May96 LdB
---------------------------------------------------------------------}
PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Sw_Word); deprecated;
PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; DestWidth, SourceCount: SizeInt);

{-MoveChar------------------------------------------------------------
Moves characters into a buffer for use with a view's WriteBuf or
WriteLine. Dest must be a TDrawBuffer (or an equivalent array of Sw_Words).
The low bytes of the first Count Sw_Words of Dest are set to C, or
remain unchanged if Ord(C) is zero. The high bytes of the Sw_Words are
set to Attr, or remain unchanged if Attr is zero.
25May96 LdB
---------------------------------------------------------------------}
{$ifdef FV_UNICODE}
PROCEDURE MoveChar (Var Dest; C: UnicodeString; Attr: Byte; Count: Sw_Word);
{$else FV_UNICODE}
PROCEDURE MoveChar (Var Dest; C: AnsiChar; Attr: Byte; Count: Sw_Word);
{$endif FV_UNICODE}

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                        KEYBOARD SUPPORT ROUTINES                          }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{-GetAltCode---------------------------------------------------------
Returns the scancode corresponding to Alt+Ch key that is given.
25May96 LdB
---------------------------------------------------------------------}
FUNCTION GetAltCode (Ch: AnsiChar): Word;

{-GetCtrlCode--------------------------------------------------------
Returns the scancode corresponding to Alt+Ch key that is given.
25May96 LdB
---------------------------------------------------------------------}
FUNCTION GetCtrlCode (Ch: AnsiChar): Word;

{-GetAltChar---------------------------------------------------------
Returns the ascii character for the Alt+Key scancode that was given.
25May96 LdB
---------------------------------------------------------------------}
FUNCTION GetAltChar (KeyCode: Word): AnsiChar;

{-GetCtrlChar--------------------------------------------------------
Returns the ascii character for the Ctrl+Key scancode that was given.
25May96 LdB
---------------------------------------------------------------------}
FUNCTION GetCtrlChar (KeyCode: Word): AnsiChar;

{-CtrlToArrow--------------------------------------------------------
Converts a WordStar-compatible control key code to the corresponding
cursor key code.
25May96 LdB
---------------------------------------------------------------------}
FUNCTION CtrlToArrow (KeyCode: Word): Word;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                        KEYBOARD CONTROL ROUTINES                          }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{-GetShiftState------------------------------------------------------
Returns a byte containing the current Shift key state. The return
value contains a combination of the kbXXXX constants for shift states.
08Jul96 LdB
---------------------------------------------------------------------}
FUNCTION GetShiftState: Byte;

{-GetKeyEvent--------------------------------------------------------
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.
19May98 LdB
---------------------------------------------------------------------}
PROCEDURE GetKeyEvent (Var Event: TEvent);

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                          MOUSE CONTROL ROUTINES                           }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{-ShowMouse----------------------------------------------------------
Decrements the hide counter and if zero the mouse is shown on screen.
30Jun98 LdB
---------------------------------------------------------------------}
PROCEDURE ShowMouse;

{-HideMouse----------------------------------------------------------
If mouse hide counter is zero it removes the cursor from the screen.
The hide counter is then incremented by one count.
30Jun98 LdB
---------------------------------------------------------------------}
PROCEDURE HideMouse;

{-GetMouseEvent------------------------------------------------------
Checks whether a mouse event is available. If a mouse event has occurred,
Event.What is set to evMouseDown, evMouseUp, evMouseMove, or evMouseAuto
and the button and double click variables are set appropriately.
06Jan97 LdB
---------------------------------------------------------------------}
PROCEDURE GetMouseEvent (Var Event: TEvent);

{-GetSystemEvent------------------------------------------------------
Checks whether a system event is available. If a system event has occurred,
Event.What is set to evCommand appropriately
10Oct2000 PM
---------------------------------------------------------------------}
procedure GetSystemEvent (Var Event: TEvent);

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                      EVENT HANDLER CONTROL ROUTINES                       }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{-InitEvents---------------------------------------------------------
Initializes the event manager, enabling the mouse handler routine and
under DOS/DPMI shows the mouse on screen. It is called automatically
by TApplication.Init.
02May98 LdB
---------------------------------------------------------------------}
PROCEDURE InitEvents;

{-DoneEvents---------------------------------------------------------
Terminates event manager and disables the mouse and under DOS hides
the mouse. It is called automatically by TApplication.Done.
02May98 LdB
---------------------------------------------------------------------}
PROCEDURE DoneEvents;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                           VIDEO CONTROL ROUTINES                          }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{-Initkeyboard-------------------------------------------------------
Initializes the keyboard. Before it is called read(ln)/write(ln)
are functional, after it is called FV's keyboard routines are
functional.
---------------------------------------------------------------------}

procedure initkeyboard;

{-Donekeyboard-------------------------------------------------------
Restores keyboard to original state. FV's keyboard routines may not
be used after a call to this. Read(ln)/write(ln) can be used again.
---------------------------------------------------------------------}

procedure donekeyboard;

{-DetectVideo---------------------------------------------------------
Detects the current video mode without initializing or otherwise
changing the current screen.
---------------------------------------------------------------------}
procedure DetectVideo;

{-InitVideo---------------------------------------------------------
Initializes the video manager, Saves the current screen mode in
StartupMode, and switches to the mode indicated by ScreenMode.
19May98 LdB
---------------------------------------------------------------------}
function InitVideo:boolean;

{-DoneVideo---------------------------------------------------------
Terminates the video manager by restoring the initial screen mode
(given by StartupMode), clearing the screen, and restoring the cursor.
Called automatically by TApplication.Done.
03Jan97 LdB
---------------------------------------------------------------------}
PROCEDURE DoneVideo;

{-ClearScreen--------------------------------------------------------
Does nothing provided for compatability purposes only.
04Jan97 LdB
---------------------------------------------------------------------}
PROCEDURE ClearScreen;

{-SetVideoMode-------------------------------------------------------
Does nothing provided for compatability purposes only.
04Jan97 LdB
---------------------------------------------------------------------}
PROCEDURE SetVideoMode (Mode: Sw_Word);

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                           ERROR CONTROL ROUTINES                          }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{-InitSysError-------------------------------------------------------
Error handling is not yet implemented so this simply sets
SysErrActive=True (ie it lies) and exits.
20May98 LdB
---------------------------------------------------------------------}
PROCEDURE InitSysError;

{-DoneSysError-------------------------------------------------------
Error handling is not yet implemented so this simply sets
SysErrActive=False and exits.
20May98 LdB
---------------------------------------------------------------------}
PROCEDURE DoneSysError;

{-SystemError---------------------------------------------------------
Error handling is not yet implemented so this simply drops through.
20May98 LdB
---------------------------------------------------------------------}
FUNCTION SystemError (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                           STRING FORMAT ROUTINES                          }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{-PrintStr-----------------------------------------------------------
Does nothing provided for compatability purposes only.
30Jun98 LdB
---------------------------------------------------------------------}
PROCEDURE PrintStr (CONST S: String);

{-FormatStr----------------------------------------------------------
A string formatting routine that given a string that includes format
specifiers and a list of parameters in Params, FormatStr produces a
formatted output string in Result.
18Feb99 LdB
---------------------------------------------------------------------}
PROCEDURE FormatStr (Var Result: Sw_String; CONST Format: Sw_String; Var Params);

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                 >> NEW QUEUED EVENT HANDLER ROUTINES <<                   }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{-PutEventInQueue-----------------------------------------------------
If there is room in the queue the event is placed in the next vacant
position in the queue manager.
17Mar98 LdB
---------------------------------------------------------------------}
FUNCTION PutEventInQueue (Var Event: TEvent): Boolean;

{-NextQueuedEvent----------------------------------------------------
If there are queued events the next event is loaded into event else
evNothing is returned.
17Mar98 LdB
---------------------------------------------------------------------}
PROCEDURE NextQueuedEvent(Var Event: TEvent);

{***************************************************************************}
{                        INITIALIZED PUBLIC VARIABLES                       }
{***************************************************************************}

PROCEDURE HideMouseCursor;
PROCEDURE ShowMouseCursor;


{---------------------------------------------------------------------------}
{                INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                  }
{---------------------------------------------------------------------------}
CONST
   CheckSnow    : Boolean = False;                    { Compatability only }
   MouseEvents  : Boolean = False;                    { Mouse event state }
   MouseReverse : Boolean = False;                    { Mouse reversed }
   HiResScreen  : Boolean = False;                    { Compatability only }
   CtrlBreakHit : Boolean = False;                    { Compatability only }
   SaveCtrlBreak: Boolean = False;                    { Compatability only }
   SysErrActive : Boolean = False;                    { Compatability only }
   FailSysErrors: Boolean = False;                    { Compatability only }
   ButtonCount  : Byte = 0;                           { Mouse button count }
   DoubleDelay  : Sw_Word = 8;                           { Double click delay }
   RepeatDelay  : Sw_Word = 8;                           { Auto mouse delay }
   SysColorAttr : Sw_Word = $4E4F;                       { System colour attr }
   SysMonoAttr  : Sw_Word = $7070;                       { System mono attr }
   StartupMode  : Sw_Word = $FFFF;                       { Compatability only }
   CursorLines  : Sw_Word = $FFFF;                       { Compatability only }
   ScreenBuffer : Pointer = Nil;                      { Compatability only }
   SaveInt09    : Pointer = Nil;                      { Compatability only }
   SysErrorFunc : TSysErrorFunc = {$ifdef FPC}@{$endif}SystemError; { System error ptr }


{***************************************************************************}
{                      UNINITIALIZED PUBLIC VARIABLES                       }
{***************************************************************************}

{---------------------------------------------------------------------------}
{                UNINITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                }
{---------------------------------------------------------------------------}
VAR
   MouseIntFlag: Byte;                                { Mouse in int flag }
   MouseButtons: Byte;                                { Mouse button state }
   ScreenWidth : Sw_Word;                             { Screen text width }
   ScreenHeight: Sw_Word;                             { Screen text height }
   ScreenMode  : TVideoMode;                         { Screen mode }
   MouseWhere  : TPoint;                              { Mouse position }

{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                               IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{$IFDEF FPC_DOTTEDUNITS}
{ API Units }
  USES
  FreeVision.Fvconsts,
  System.Console.Keyboard,System.Console.Mouse;
{$ELSE FPC_DOTTEDUNITS}
{ API Units }
  USES
  FVConsts,
  Keyboard,Mouse;
{$ENDIF FPC_DOTTEDUNITS}

{***************************************************************************}
{                        PRIVATE INTERNAL CONSTANTS                         }
{***************************************************************************}

{---------------------------------------------------------------------------}
{                 DOS/DPMI MOUSE INTERRUPT EVENT QUEUE SIZE                 }
{---------------------------------------------------------------------------}
CONST EventQSize = 16;                                { Default int bufsize }

{---------------------------------------------------------------------------}
{                DOS/DPMI/WIN/NT/OS2 NEW EVENT QUEUE MAX SIZE               }
{---------------------------------------------------------------------------}
CONST QueueMax = 64;                                  { Max new queue size }

{***************************************************************************}
{                          PRIVATE INTERNAL TYPES                           }
{***************************************************************************}

{***************************************************************************}
{                  PRIVATE INTERNAL INITIALIZED VARIABLES                   }
{***************************************************************************}

{---------------------------------------------------------------------------}
{          DOS/DPMI/WIN/NT/OS2 ALT KEY SCANCODES FROM KEYS (0-127)          }
{---------------------------------------------------------------------------}
CONST AltCodes: Array [0..127] Of Byte = (
      $00, $00, $00, $00, $00, $00, $00, $00,         { $00 - $07 }
      $00, $00, $00, $00, $00, $00, $00, $00,         { $08 - $0F }
      $00, $00, $00, $00, $00, $00, $00, $00,         { $10 - $17 }
      $00, $00, $00, $00, $00, $00, $00, $00,         { $18 - $1F }
      $00, $00, $00, $00, $00, $00, $00, $00,         { $20 - $27 }
      $00, $00, $00, $00, $00, $82, $00, $00,         { $28 - $2F }
      $81, $78, $79, $7A, $7B, $7C, $7D, $7E,         { $30 - $37 }
      $7F, $80, $00, $00, $00, $83, $00, $00,         { $38 - $3F }
      $00, $1E, $30, $2E, $20, $12, $21, $22,         { $40 - $47 }
      $23, $17, $24, $25, $26, $32, $31, $18,         { $48 - $4F }
      $19, $10, $13, $1F, $14, $16, $2F, $11,         { $50 - $57 }
      $2D, $15, $2C, $00, $00, $00, $00, $00,         { $58 - $5F }
      $00, $00, $00, $00, $00, $00, $00, $00,         { $60 - $67 }
      $00, $00, $00, $00, $00, $00, $00, $00,         { $68 - $6F }
      $00, $00, $00, $00, $00, $00, $00, $00,         { $70 - $77 }
      $00, $00, $00, $00, $00, $00, $00, $00);        { $78 - $7F }

{***************************************************************************}
{                  PRIVATE INTERNAL INITIALIZED VARIABLES                   }
{***************************************************************************}

{---------------------------------------------------------------------------}
{                           NEW CONTROL VARIABLES                           }
{---------------------------------------------------------------------------}
CONST
   HideCount : Sw_Integer = 0;                           { Cursor hide count }
   QueueCount: Sw_Word = 0;                              { Queued message count }
   QueueHead : Sw_Word = 0;                              { Queue head pointer }
   QueueTail : Sw_Word = 0;                              { Queue tail pointer }

{***************************************************************************}
{                 PRIVATE INTERNAL UNINITIALIZED VARIABLES                  }
{***************************************************************************}

{---------------------------------------------------------------------------}
{                     UNINITIALIZED DOS/DPMI/API VARIABLES                      }
{---------------------------------------------------------------------------}
VAR
   LastDouble : Boolean;                              { Last double buttons }
   LastButtons: Word;                                 { Last button state }
   DownButtons: Word;                                 { Last down buttons }
   EventCount : Sw_Word;                                 { Events in queue }
   AutoDelay  : Sw_Word;                                 { Delay time count }
   DownTicks  : Sw_Word;                                 { Down key tick count }
   AutoTicks  : Sw_Word;                                 { Held key tick count }
   LastWhereX : Sw_Word;                                 { Last x position }
   LastWhereY : Sw_Word;                                 { Last y position }
   DownWhereX : Sw_Word;                                 { Last x position }
   DownWhereY : Sw_Word;                                 { Last y position }
   LastWhere  : TPoint;                               { Last mouse position }
   DownWhere  : TPoint;                               { Last down position }
   EventQHead : Pointer;                              { Head of queue }
   EventQTail : Pointer;                              { Tail of queue }
   EventQueue : Array [0..EventQSize - 1] Of TEvent;  { Event queue }
   EventQLast : RECORD END;                           { Simple end marker }
   StartupScreenMode : TVideoMode;
   {$ifdef OS_AMIGA}
   StartupTicks: Int64; // ticks at Startup for GetDOSTicks
   {$endif}
{---------------------------------------------------------------------------}
{  GetDosTicks (18.2 Hz)                                                    }
{---------------------------------------------------------------------------}

Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
{$IFDEF OS_OS2}
  const
    QSV_MS_COUNT = 14;
  var
    L: longint;
  begin
    DosQuerySysInfo (QSV_MS_COUNT, QSV_MS_COUNT, L, 4);
    GetDosTicks := L div 55;
  end;
{$ENDIF}
{$IFDEF OS_UNIX}
  var
     tv : TimeVal;
  {  tz : TimeZone;}
  begin
    FPGetTimeOfDay(@tv,nil{,tz});
    GetDosTicks:=((tv.tv_Sec mod 86400) div 60)*1092+((tv.tv_Sec mod 60)*1000000+tv.tv_USec) div 54945;
  end;
{$ENDIF OS_UNIX}
{$IFDEF OS_WINDOWS}
  begin
     GetDosTicks:=GetTickCount div 55;
  end;
{$ENDIF OS_WINDOWS}
{$IFDEF OS_WIN16}
  begin
     GetDosTicks:=GetTickCount div 55;
  end;
{$ENDIF OS_WIN16}
{$IFDEF OS_DOS}
  begin
    GetDosTicks:=MemL[$40:$6c];
  end;
{$ENDIF OS_DOS}
{$IFDEF OS_NETWARE_LIBC}
var
  tv : TTimeVal;
  tz : TTimeZone;
  begin
    fpGetTimeOfDay(tv,tz);
    GetDosTicks:=((tv.tv_sec mod 86400) div 60)*1092+((tv.tv_Sec mod 60)*1000000+tv.tv_USec) div 549
  end;
{$ENDIF}
{$IFDEF OS_NETWARE_CLIB}
  begin
    GetDosTicks := Nwserv.GetCurrentTicks;
  end;
{$ENDIF}
{$IFDEF OS_AMIGA}
  begin
    GetDosTicks:= ((dos.GetMsCount div 55) - StartupTicks) and $7FFFFFFF;
  end;
{$ENDIF OS_AMIGA}


procedure GiveUpTimeSlice;
{$IFDEF OS_DOS}
var r: registers;
begin
  Intr ($28, R); (* This is supported everywhere. *)
  r.ax:=$1680;
  intr($2f,r);
end;
{$ENDIF}
{$IFDEF OS_UNIX}
  var
    req,rem : timespec;
begin
  req.tv_sec:=0;
  req.tv_nsec:=10000000;{ 10 ms }
  fpnanosleep(@req,@rem);
end;
{$ENDIF}
{$IFDEF OS_OS2}
begin
 DosSleep (5);
end;
{$ENDIF}
{$IFDEF OS_WINDOWS}
begin
  { if the return value of this call is non zero then
    it means that a ReadFileEx or WriteFileEx have completed
    unused for now ! }
  { wait for 10 ms }
  if SleepEx(10,true)=WAIT_IO_COMPLETION then
    begin
      { here we should handle the completion of the routines
        if we use them }
    end;
end;
{$ENDIF}
{$IFDEF OS_WIN16}
  begin
    Delay (10);
  end;
{$ENDIF}
{$IFDEF OS_NETWARE_LIBC}
  begin
    Delay (10);
  end;
{$ENDIF}
{$IFDEF OS_NETWARE_CLIB}
  begin
    Delay (10);
  end;
{$ENDIF}
{$IFDEF OS_AMIGA}
  begin
    { AmigaOS Delay() wait's argument in 1/50 seconds }
    { DOSDelay(2); // the old solution... }
    Keyboard.WaitForSystemEvent(150);
  end;
{$ENDIF OS_AMIGA}


{---------------------------------------------------------------------------}
{                UNINITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                }
{---------------------------------------------------------------------------}
VAR
   SaveExit: CodePointer;                             { Saved exit pointer }
   Queue   : Array [0..QueueMax-1] Of TEvent;         { New message queue }

{***************************************************************************}
{                         PRIVATE INTERNAL ROUTINES                         }
{***************************************************************************}

PROCEDURE ShowMouseCursor;inline;
BEGIN
  ShowMouse;
END;

PROCEDURE HideMouseCursor;inline;
BEGIN
  HideMouse;
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{               DOS/DPMI/WIN/NT/OS2 PRIVATE INTERNAL ROUTINES               }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{---------------------------------------------------------------------------}
{  ExitDrivers -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jun98 LdB       }
{---------------------------------------------------------------------------}
PROCEDURE ExitDrivers; {$IFNDEF PPC_FPC}{$IFNDEF OS_UNIX} FAR; {$ENDIF}{$ENDIF}
BEGIN
   DoneSysError;                                      { Relase error trap }
   DoneEvents;                                        { Close event driver }
{   DoneKeyboard;}
   DoneVideo;
   ExitProc := SaveExit;                              { Restore old exit }
END;

{---------------------------------------------------------------------------}
{  DetectVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB       }
{---------------------------------------------------------------------------}

procedure DetectVideo;
VAR
  CurrMode : TVideoMode;
begin
  { {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.InitVideo; Incompatible with BP
    and forces a screen clear which is often a bad thing PM }
  GetVideoMode(CurrMode);
  ScreenMode:=CurrMode;
end;

{---------------------------------------------------------------------------}
{  DetectMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB       }
FUNCTION DetectMouse: Byte;inline;
begin
  DetectMouse:={$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Mouse.DetectMouse;
end;

{***************************************************************************}
{                            INTERFACE ROUTINES                             }
{***************************************************************************}

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                           BUFFER MOVE ROUTINES                            }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{$ifdef FV_UNICODE}
FUNCTION EgcWidth(Const EGC: Sw_String): Sw_Integer;
BEGIN
   Result := {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.ExtendedGraphemeClusterDisplayWidth(EGC);
END;
{$endif FV_UNICODE}

{$ifdef FV_UNICODE}
FUNCTION StrWidth(Const S: Sw_String): Sw_Integer;
BEGIN
   Result := {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.StringDisplayWidth(S);
END;
{$else FV_UNICODE}
FUNCTION StrWidth(Const S: Sw_String): Sw_Integer;
BEGIN
   StrWidth := Length(S);
END;
{$endif FV_UNICODE}

{---------------------------------------------------------------------------}
{  CStrLen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB           }
{---------------------------------------------------------------------------}
{$ifdef FV_UNICODE}
FUNCTION CStrLen (Const S: UnicodeString): Sw_Integer;
VAR EGC: Sw_String;
BEGIN
   { todo: handle wide (CJK, emoji) characters as double width }
   Result := 0;
   for EGC in TUnicodeStringExtendedGraphemeClustersEnumerator.Create(S) do
     if EGC <> '~' then
       Inc(Result, {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.ExtendedGraphemeClusterDisplayWidth(EGC));
END;
{$else FV_UNICODE}
FUNCTION CStrLen (Const S: String): Sw_Integer;
VAR I, J: Sw_Integer;
BEGIN
   J := 0;                                            { Set result to zero }
   For I := 1 To Length(S) Do
     If (S[I] <> '~') Then Inc(J);                    { Inc count if not ~ }
   CStrLen := J;                                      { Return length }
END;
{$endif FV_UNICODE}

{---------------------------------------------------------------------------}
{  MoveStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB           }
{---------------------------------------------------------------------------}
{$ifdef FV_UNICODE}
PROCEDURE MoveStr (Var Dest; Const Str: UnicodeString; Attr: Byte);
VAR EGC: Sw_String; P: PEnhancedVideoCell;
BEGIN
   { todo: handle wide (CJK, emoji) characters as double width }
   P := PEnhancedVideoCell(@Dest);                      { Pointer to TEnhancedVideoCell }
   for EGC in TUnicodeStringExtendedGraphemeClustersEnumerator.Create(Str) do
     begin
       If (Attr <> 0) Then P^.Attribute := Attr;        { Copy attribute }
       P^.ExtendedGraphemeCluster := EGC;               { Copy string AnsiChar }
       Inc(P, {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.ExtendedGraphemeClusterDisplayWidth(EGC));
     end;
END;
{$else FV_UNICODE}
PROCEDURE MoveStr (Var Dest; Const Str: String; Attr: Byte);
VAR I: Word; P: PWord;
BEGIN
   For I := 1 To Length(Str) Do Begin                 { For each character }
     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
     If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
     WordRec(P^).Lo := Byte(Str[I]);                  { Copy string AnsiChar }
   End;
END;
{$endif FV_UNICODE}

{---------------------------------------------------------------------------}
{  MoveCStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
{---------------------------------------------------------------------------}
{$ifdef FV_UNICODE}
PROCEDURE MoveCStr (Var Dest; Const Str: UnicodeString; Attrs: Word);
VAR EGC: Sw_String; B: Byte; P: PEnhancedVideoCell;
BEGIN
   { todo: handle wide (CJK, emoji) characters as double width }
   P := PEnhancedVideoCell(@Dest);                      { Pointer to TEnhancedVideoCell }
   for EGC in TUnicodeStringExtendedGraphemeClustersEnumerator.Create(Str) do
     begin
       if EGC <> '~' then
         begin
           If (Lo(Attrs) <> 0) Then
             P^.Attribute := Lo(Attrs);                   { Copy attribute }
           P^.ExtendedGraphemeCluster:=EGC;               { Copy string AnsiChar }
           Inc(P, {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.ExtendedGraphemeClusterDisplayWidth(EGC));  { Next position }
         end
       else
         begin
           B := Hi(Attrs);                                { Hold attribute }
           WordRec(Attrs).Hi := Lo(Attrs);                { Copy low to high }
           WordRec(Attrs).Lo := B;                        { Complete exchange }
         end;
     end;
END;
{$else FV_UNICODE}
PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
VAR B: Byte; I, J: Sw_Word; P: PWord;
BEGIN
   J := 0;                                            { Start position }
   For I := 1 To Length(Str) Do Begin                 { For each character }
     If (Str[I] <> '~') Then Begin                    { Not tilde character }
       P := @TWordArray(Dest)[J];                     { Pointer to Sw_Word }
       If (Lo(Attrs) <> 0) Then
         WordRec(P^).Hi := Lo(Attrs);                 { Copy attribute }
       WordRec(P^).Lo := Byte(Str[I]);                { Copy string AnsiChar }
       Inc(J);                                        { Next position }
     End Else Begin
       B := Hi(Attrs);                                { Hold attribute }
       WordRec(Attrs).Hi := Lo(Attrs);                { Copy low to high }
       WordRec(Attrs).Lo := B;                        { Complete exchange }
     End;
   End;
END;
{$endif FV_UNICODE}

{---------------------------------------------------------------------------}
{  MoveBuf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB           }
{---------------------------------------------------------------------------}
{$ifdef FV_UNICODE}
PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Sw_Word); deprecated;
VAR I: Word; P: PEnhancedVideoCell;
BEGIN
   { todo: split string into extended grapheme clusters properly, handle non-BMP characters,
     handle wide (CJK) characters, etc. }
   For I := 1 To Count Do Begin
     P := @(PEnhancedVideoCell(@Dest)[I-1]);          { Pointer to TEnhancedVideoCell }
     If (Attr <> 0) Then P^.Attribute := Attr;        { Copy attribute }
     P^.ExtendedGraphemeCluster := WideChar(TWordArray(Source)[I-1]); { Copy source data }
   End;
END;
PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; DestWidth, SourceCount: SizeInt);
VAR
  S, EGC: UnicodeString;
  P: PEnhancedVideoCell;
BEGIN
  SetLength(S, SourceCount);
  Move(Source, S[1], SourceCount * SizeOf(WideChar));
  P := PEnhancedVideoCell(@Dest);                      { Pointer to TEnhancedVideoCell }
  for EGC in TUnicodeStringExtendedGraphemeClustersEnumerator.Create(S) do
    begin
      if DestWidth <= 0 then
        exit;
      Dec(DestWidth, {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.ExtendedGraphemeClusterDisplayWidth(EGC));
      if DestWidth < 0 then
        begin
          If (Attr <> 0) Then P^.Attribute := Attr;
          P^.ExtendedGraphemeCluster := ' ';
          exit;
        end;
      If (Attr <> 0) Then P^.Attribute := Attr;        { Copy attribute }
      P^.ExtendedGraphemeCluster := EGC;               { Copy string AnsiChar }
      Inc(P, {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.ExtendedGraphemeClusterDisplayWidth(EGC));
    end;
END;
{$else FV_UNICODE}
PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Sw_Word); deprecated;
VAR I: Word; P: PWord;
BEGIN
   For I := 1 To Count Do Begin
     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
     If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
     WordRec(P^).Lo := TByteArray(Source)[I-1];       { Copy source data }
   End;
END;
PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; DestWidth, SourceCount: SizeInt);
BEGIN
  MoveBuf(Dest, Source, Attr, DestWidth);
END;
{$endif FV_UNICODE}

{---------------------------------------------------------------------------}
{  MoveChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
{---------------------------------------------------------------------------}
{$ifdef FV_UNICODE}
PROCEDURE MoveChar (Var Dest; C: UnicodeString; Attr: Byte; Count: Sw_Word);
VAR I: Word; P: PEnhancedVideoCell;
BEGIN
   For I := 1 To Count Do Begin
     P := @(PEnhancedVideoCell(@Dest)[I-1]);          { Pointer to TEnhancedVideoCell }
     If (Attr <> 0) Then P^.Attribute := Attr;        { Copy attribute }
     If (C<>'') and (C<>#$0000) Then P^.ExtendedGraphemeCluster := C; { Copy character }
   End;
END;
{$else FV_UNICODE}
PROCEDURE MoveChar (Var Dest; C: AnsiChar; Attr: Byte; Count: Sw_Word);
VAR I: Word; P: PWord;
BEGIN
   For I := 1 To Count Do Begin
     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
     If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
     If (Ord(C) <> 0) Then WordRec(P^).Lo := Byte(C); { Copy character }
   End;
END;
{$endif FV_UNICODE}

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                        KEYBOARD SUPPORT ROUTINES                          }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{---------------------------------------------------------------------------}
{  GetAltCode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB        }
{---------------------------------------------------------------------------}
FUNCTION GetAltCode (Ch: AnsiChar): Word;
BEGIN
   GetAltCode := 0;                                   { Preset zero return }
   Ch := UpCase(Ch);                                  { Convert upper case }
   If (Ch < #128) Then
     GetAltCode := AltCodes[Ord(Ch)] SHL 8            { Return code }
     Else If (Ch = #240) Then GetAltCode := $0200     { Return code }
       Else GetAltCode := 0;                          { Return zero }
END;

{---------------------------------------------------------------------------}
{  GetCtrlCode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB       }
{---------------------------------------------------------------------------}
FUNCTION GetCtrlCode (Ch: AnsiChar): Word;
BEGIN
   GetCtrlCode := GetAltCode(Ch) OR (Ord(Ch) - $40);  { Ctrl+key code }
END;

{---------------------------------------------------------------------------}
{  GetAltChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB        }
{---------------------------------------------------------------------------}
FUNCTION GetAltChar (KeyCode: Word): AnsiChar;
VAR I: Sw_Integer;
BEGIN
   GetAltChar := #0;                                  { Preset fail return }
   If (Lo(KeyCode) = 0) Then Begin                    { Extended key }
     If (Hi(KeyCode) <= $83) Then Begin               { Highest value in list }
       I := 0;                                        { Start at first }
       While (I < 128) AND (Hi(KeyCode) <> AltCodes[I])
         Do Inc(I);                                   { Search for match }
       If (I < 128) Then GetAltChar := Chr(I);        { Return character }
     End Else
       If (Hi(KeyCode)=$02) Then GetAltChar := #240;  { Return AnsiChar }
   End;
END;

{---------------------------------------------------------------------------}
{  GetCtrlChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB       }
{---------------------------------------------------------------------------}
FUNCTION GetCtrlChar (KeyCode: Word): AnsiChar;
VAR C: AnsiChar;
BEGIN
  C := #0;                                            { Preset #0 return }
  If (Lo(KeyCode) > 0) AND (Lo(KeyCode) <= 26) Then   { Between 1-26 }
    C := Chr(Lo(KeyCode) + $40);                      { Return AnsiChar A-Z }
  GetCtrlChar := C;                                   { Return result }
END;

{---------------------------------------------------------------------------}
{  CtrlToArrow -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB       }
{---------------------------------------------------------------------------}
FUNCTION CtrlToArrow (KeyCode: Word): Word;
CONST NumCodes = 11;
      CtrlCodes : Array [0..NumCodes-1] Of AnsiChar =
        (#19, #4, #5, #24, #1, #6, #7, #22, #18, #3, #8);
      ArrowCodes: Array [0..NumCodes-1] Of Sw_Word =
       (kbLeft, kbRight, kbUp, kbDown, kbHome, kbEnd, kbDel, kbIns,
        kbPgUp, kbPgDn, kbBack);
VAR I: Sw_Integer;
BEGIN
   CtrlToArrow := KeyCode;                            { Preset key return }
   For I := 0 To NumCodes - 1 Do
     If WordRec(KeyCode).Lo = Byte(CtrlCodes[I])      { Matches a code }
     Then Begin
       CtrlToArrow := ArrowCodes[I];                  { Return key stroke }
       Exit;                                          { Now exit }
     End;
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                        KEYBOARD CONTROL ROUTINES                          }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{---------------------------------------------------------------------------}
{  GetShiftState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jul96 LdB     }
{---------------------------------------------------------------------------}
FUNCTION GetShiftState: Byte;
begin
  GetShiftState:={$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Keyboard.GetKeyEventShiftState({$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Keyboard.PollShiftStateEvent);
end;

{---------------------------------------------------------------------------}
{  GetKeyEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB       }
{---------------------------------------------------------------------------}
procedure GetKeyEvent (Var Event: TEvent);
var
  key      : TEnhancedKeyEvent;
  keycode  : Word;
begin
  if {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Keyboard.PollEnhancedKeyEvent<>NilEnhancedKeyEvent then
   begin
     key:={$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Keyboard.GetEnhancedKeyEvent;
     keycode:=key.VirtualScanCode;
     // some kbds still honour old XT E0 prefix. (org IBM ps/2, win98?) bug #8978
     if (keycode and $FF = $E0) and
        (byte(keycode shr 8) in
              [$1C,$1D,$2A,$35..$38,$46..$49,$4b,$4d,$4f,$50..$53]) Then
          keycode := keycode and $FF00;

     { fixup shift-keys }
     if essShift in key.ShiftState then
       begin
         case keycode of
           $5200 : keycode:=kbShiftIns;
           $5300 : keycode:=kbShiftDel;
           $8500 : keycode:=kbShiftF1;
           $8600 : keycode:=kbShiftF2;
         end;
       end
     { fixup ctrl-keys }
     else if essCtrl in key.ShiftState then
       begin
         case keycode of
           $5200,
           $9200 : keycode:=kbCtrlIns;
           $5300,
           $9300 : keycode:=kbCtrlDel;
         end;
       end
     { fixup alt-keys }
     else if essAlt in key.ShiftState then
       begin
         case keycode of
           $0e08,
           $0e00 : keycode:=kbAltBack;
         end;
       end
     { fixup normal keys }
     else
       begin
         case keycode of
           $e00d : keycode:=kbEnter;
         end;
       end;
     Event.What:=evKeyDown;
     Event.KeyCode:=keycode;
     Event.CharCode:=chr(keycode and $ff);
     Event.ScanCode:=keycode shr 8;
     Event.UnicodeChar:=key.UnicodeChar;
     Event.KeyShift:=ConvertEnhancedToLegacyShiftState(key.ShiftState);
   end
  else
   Event.What:=evNothing;
end;


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                          MOUSE CONTROL ROUTINES                           }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{---------------------------------------------------------------------------}
{  HideMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jun98 LdB         }
{---------------------------------------------------------------------------}
procedure HideMouse;
begin
{ Is mouse hidden yet?
  If (HideCount = 0) Then}
    {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Mouse.HideMouse;
{  Inc(HideCount);}
end;

{---------------------------------------------------------------------------}
{  ShowMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jun98 LdB         }
{---------------------------------------------------------------------------}
procedure ShowMouse;
begin
{  if HideCount>0 then
    dec(HideCount);
  if (HideCount=0) then}
   {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Mouse.ShowMouse;
end;

{---------------------------------------------------------------------------}
{  GetMouseEvent -> Platforms DOS/DPMI/WINDOWS/OS2 - Updated 30Jun98 LdB    }
{---------------------------------------------------------------------------}
procedure GetMouseEvent (Var Event: TEvent);
var
  e : {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Mouse.TMouseEvent;
begin
  if {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Mouse.PollMouseEvent(e) then
   begin
     {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Mouse.GetMouseEvent(e);
     MouseWhere.X:=e.x;
     MouseWhere.Y:=e.y;
     Event.Double:=false;
     Event.Triple:=false;
     case e.Action of
       MouseActionMove :
         Event.What:=evMouseMove;
       MouseActionDown :
         begin
           Event.What:=evMouseDown;
           if (DownButtons=e.Buttons) and (DownWhere.X=MouseWhere.X) and (DownWhere.Y=MouseWhere.Y) and
              (GetDosTicks-DownTicks<=DoubleDelay) then
           begin
             Event.Double:=true;
             if LastDouble and ((e.Buttons and( MouseButton4 or MouseButton5)) = 0) then
             begin              {only "normal" buttons can produce triple click}
               Event.Double:=false;
               Event.Triple:=true;
             end;
           end;
           LastDouble:=Event.Double;
           DownButtons:=e.Buttons;
           DownWhere.X:=MouseWhere.x;
           DownWhere.Y:=MouseWhere.y;
           DownTicks:=GetDosTicks;
           if Event.Triple then
             dec(DownTicks,DoubleDelay); {after triple click can follow only single click}
           AutoTicks:=GetDosTicks;
           if AutoTicks=0 then
             AutoTicks:=1;
           AutoDelay:=RepeatDelay;
           if (e.Buttons and (MouseButton4 or MouseButton5))<>0 then
           begin
             Event.What:=evMouseWheel; { Mouse wheel event not mouse down }
             case e.Buttons and (MouseButton4 or MouseButton5) of
               MouseButton4: Event.Wheel:=mwUp;
               MouseButton5: Event.Wheel:=mwDown;
             end;
             e.Buttons:=e.Buttons and( not word( MouseButton4 or MouseButton5)); {remove wheel buttons for Buttons}
             AutoTicks:=0;  {there is no "holding down" mouse wheel }
           end;
         end;
       MouseActionUp :
         begin
           AutoTicks:=0;
           Event.What:=evMouseUp;
           AutoTicks:=0;
         end;
     end;
     Event.Buttons:=e.Buttons;
     Event.Where.X:=MouseWhere.x;
     Event.Where.Y:=MouseWhere.y;
     LastButtons:=Event.Buttons;
     LastWhere.x:=Event.Where.x;
     LastWhere.y:=Event.Where.y;
   end
  else if (AutoTicks <> 0) and (GetDosTicks >= AutoTicks + AutoDelay) then
   begin
     Event.What:=evMouseAuto;
     Event.Buttons:=LastButtons;
     Event.Where.X:=LastWhere.x;
     Event.Where.Y:=LastWhere.y;
     AutoTicks:=GetDosTicks;
     AutoDelay:=1;
   end
  else
   FillChar(Event,sizeof(TEvent),0);
  if MouseReverse and ((Event.Buttons and 3) in [1,2]) then
    Event.Buttons := Event.Buttons xor 3;
end;

{---------------------------------------------------------------------------}
{  GetSystemEvent                                                           }
{---------------------------------------------------------------------------}
procedure GetSystemEvent (Var Event: TEvent);
var
  SysEvent : TsystemEvent;
begin
  if PollSystemEvent(SysEvent) then
    begin
      {$IFDEF FPC_DOTTEDUNITS}FreeVision.{$ENDIF}Sysmsg.GetSystemEvent(SysEvent);
      case SysEvent.typ of
      SysNothing :
        Event.What:=evNothing;
      SysSetFocus :
        begin
          Event.What:=evBroadcast;
          Event.Command:=cmReceivedFocus;
        end;
      SysReleaseFocus :
        begin
          Event.What:=evBroadcast;
          Event.Command:=cmReleasedFocus;
        end;
      SysClose :
        begin
          Event.What:=evCommand;
          Event.Command:=cmQuitApp;
        end;
      SysResize :
        begin
          Event.What:=evCommand;
          Event.Command:=cmResizeApp;
          Event.Id:=SysEvent.x;
          Event.InfoWord:=SysEvent.y;
        end;
      else
        Event.What:=evNothing;
      end;
    end
  else
    Event.What:=evNothing;
end;


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                      EVENT HANDLER CONTROL ROUTINES                       }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{---------------------------------------------------------------------------}
{  InitEvents -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 07Sep99 LdB        }
{---------------------------------------------------------------------------}
PROCEDURE InitEvents;
BEGIN
  If (ButtonCount <> 0) Then
    begin                   { Mouse is available }
     {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Mouse.InitMouse;                                 { Hook the mouse }
     { this is required by the use of HideCount variable }
     {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Mouse.ShowMouse;                                 { visible by default }
     { HideCount:=0;  }
     LastButtons := 0;                                { Clear last buttons }
     DownButtons := 0;                                { Clear down buttons }
     MouseWhere.X:={$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Mouse.GetMouseX;
     MouseWhere.Y:={$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Mouse.GetMouseY;                   { Get mouse position }
     LastWhere.x:=MouseWhere.x;
     LastWhereX:=MouseWhere.x;
     LastWhere.y:=MouseWhere.y;
     LastWhereY:=MouseWhere.y;
     MouseEvents := True;                             { Set initialized flag }
    end;
  InitSystemMsg;
END;

{---------------------------------------------------------------------------}
{  DoneEvents -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB        }
{---------------------------------------------------------------------------}
PROCEDURE DoneEvents;
BEGIN
  DoneSystemMsg;
  {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Mouse.DoneMouse;
  MouseEvents:=false;
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                           VIDEO CONTROL ROUTINES                          }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

const
  VideoInitialized : boolean = false;

{---------------------------------------------------------------------------}
{  InitKeyboard -> Platforms ALL - 07May06 DM                               }
{---------------------------------------------------------------------------}

procedure initkeyboard;inline;

begin
  {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Keyboard.initkeyboard;
end;

{---------------------------------------------------------------------------}
{  DoneKeyboard -> Platforms ALL - 07May06 DM                               }
{---------------------------------------------------------------------------}

procedure donekeyboard;inline;

begin
  {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Keyboard.donekeyboard;
end;

{---------------------------------------------------------------------------}
{  InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB         }
{---------------------------------------------------------------------------}
function InitVideo:boolean;

var StoreScreenMode : TVideoMode;

begin
  initvideo:=false;
  if VideoInitialized then
    begin
      StoreScreenMode:=ScreenMode;
      DoneVideo;
    end
  else
    StoreScreenMode.Col:=0;

{$ifdef FV_UNICODE}
  {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.InitEnhancedVideo;
{$else FV_UNICODE}
  {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.InitVideo;
{$endif FV_UNICODE}
  if {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.errorcode<>viook then
    exit;
  GetVideoMode(StartupScreenMode);
  GetVideoMode(ScreenMode);
{$ifdef OS_WINDOWS}
  { Force the console to the current screen mode }
  {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.SetVideoMode(ScreenMode);
{$endif OS_WINDOWS}

  If (StoreScreenMode.Col<>0) and
     ((StoreScreenMode.color<>ScreenMode.color) or
     (StoreScreenMode.row<>ScreenMode.row) or
     (StoreScreenMode.col<>ScreenMode.col)) then
    begin
      {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.SetVideoMode(StoreScreenMode);
      GetVideoMode(ScreenMode);
    end;
  ScreenWidth:={$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.ScreenWidth;
  ScreenHeight:={$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.ScreenHeight;
  VideoInitialized:=true;
  initvideo:=true;
end;

{---------------------------------------------------------------------------}
{  DoneVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB         }
{---------------------------------------------------------------------------}
PROCEDURE DoneVideo;
BEGIN
  if not VideoInitialized then
    exit;
  {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.SetVideoMode(StartupScreenMode);
  {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.ClearScreen;
  {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.SetCursorPos(0,0);
{$ifdef FV_UNICODE}
  {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.DoneEnhancedVideo;
{$else FV_UNICODE}
   {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.DoneVideo;
{$endif FV_UNICODE}
  VideoInitialized:=false;
END;

{---------------------------------------------------------------------------}
{  ClearScreen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Jan97 LdB       }
{---------------------------------------------------------------------------}
PROCEDURE ClearScreen;
BEGIN
  {$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}Video.ClearScreen;
END;

{---------------------------------------------------------------------------}
{  SetVideoMode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Nov99 LdB      }
{---------------------------------------------------------------------------}
PROCEDURE SetVideoMode (Mode: Sw_Word);
BEGIN
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                           ERROR CONTROL ROUTINES                          }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{---------------------------------------------------------------------------}
{  InitSysError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB      }
{---------------------------------------------------------------------------}
PROCEDURE InitSysError;
BEGIN
   SysErrActive := True;                              { Set active flag }
END;

{---------------------------------------------------------------------------}
{  DoneSysError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB      }
{---------------------------------------------------------------------------}
PROCEDURE DoneSysError;
BEGIN
   SysErrActive := False;                             { Clear active flag }
END;

{---------------------------------------------------------------------------}
{  SystemError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB       }
{---------------------------------------------------------------------------}
FUNCTION SystemError (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
BEGIN
   If (FailSysErrors = False) Then Begin              { Check error ignore }

   End Else SystemError := 1;                         { Return 1 for ignored }
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                           STRING FORMAT ROUTINES                          }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{---------------------------------------------------------------------------}
{  PrintStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 18Feb99 LdB          }
{---------------------------------------------------------------------------}
PROCEDURE PrintStr (CONST S: String);
BEGIN
   Write(S);                                          { Write to screen }
END;

{---------------------------------------------------------------------------}
{  FormatStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 13Jul99 LdB         }
{---------------------------------------------------------------------------}
procedure FormatStr (Var Result: Sw_String; CONST Format: Sw_String; Var Params);
TYPE TLongArray = Array[0..0] Of PtrInt;
VAR W, ResultLength : SmallInt;
    FormatIndex, Justify, Wth: Byte;
    Fill: AnsiChar; S: Sw_String;

   FUNCTION LongToStr (L: Longint; Radix: Byte): Sw_String;
   CONST HexChars: Array[0..15] Of AnsiChar =
    ('0', '1', '2', '3', '4', '5', '6', '7',
     '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
   VAR I: LongInt; S: Sw_String; Sign: String[1];
   begin
     LongToStr := '';                                 { Preset empty return }
     If (L < 0) Then begin                            { If L is negative }
       Sign := '-';                                   { Sign is negative }
       L := Abs(L);                                   { Convert to positive }
     end Else Sign := '';                             { Sign is empty }
     S := '';                                         { Preset empty string }
     Repeat
       I := L MOD Radix;                              { Radix mod of value }
       S := HexChars[I] + S;                          { Add AnsiChar to string }
       L := L DIV Radix;                              { Divid by radix }
     Until (L = 0);                                   { Until no remainder }
     LongToStr := Sign + S;                           { Return result }
   end;

   procedure HandleParameter (I : LongInt);
   begin
     While (FormatIndex <= Length(Format)) Do begin   { While length valid }
{$ifndef FV_UNICODE}
       if ResultLength>=High(Result) then
         exit;
{$endif FV_UNICODE}
       While (FormatIndex <= Length(Format)) and
             (Format[FormatIndex] <> '%')          { Param AnsiChar not found }
        Do begin
{$ifdef FV_UNICODE}
         SetLength(Result,ResultLength+1);
{$endif FV_UNICODE}
         Result[ResultLength+1] := Format[FormatIndex]; { Transfer character }
         Inc(ResultLength);                           { One character added }
         Inc(FormatIndex);                            { Next param AnsiChar }
       end;
       If (FormatIndex < Length(Format)) and          { Not last AnsiChar and }
       (Format[FormatIndex] = '%') Then begin         { '%' AnsiChar found }
         Fill := ' ';                                 { Default fill AnsiChar }
         Justify := 0;                                { Default justify }
         Wth := 0;                                    { Default 0=no width }
         Inc(FormatIndex);                            { Next character }
         If (Format[FormatIndex] = '0') Then
           Fill := '0';                               { Fill AnsiChar to zero }
         If (Format[FormatIndex] = '-') Then begin    { Optional just AnsiChar }
           Justify := 1;                              { Right justify }
           Inc(FormatIndex);                          { Next character }
         end;
         While ((FormatIndex <= Length(Format)) and   { Length still valid }
         (Format[FormatIndex] >= '0') and
         (Format[FormatIndex] <= '9')) Do begin       { Numeric character }
           Wth := Wth * 10;                           { Multiply x10 }
           Wth := Wth + Ord(Format[FormatIndex])-$30; { Add numeric value }
           Inc(FormatIndex);                          { Next character }
         end;
         If ((FormatIndex <= Length(Format)) and      { Length still valid }
         (Format[FormatIndex] = '#')) Then begin      { Parameter marker }
           Inc(FormatIndex);                          { Next character }
           HandleParameter(Wth);                      { Width is param idx }
         end;
         If (FormatIndex <= Length(Format)) Then begin{ Length still valid }
           Case Format[FormatIndex] Of
           '%': begin                               { Literal % }
             S := '%';
             Inc(FormatIndex);
{$ifdef FV_UNICODE}
             SetLength(Result,ResultLength+Length(S));
             Move(S[1], Result[ResultLength+1], 2);
{$else FV_UNICODE}
             Move(S[1], Result[ResultLength+1], 1);
{$endif FV_UNICODE}
             Inc(ResultLength,Length(S));
             Continue;
           end;
           'c': S := AnsiChar(TLongArray(Params)[I]);  { Character parameter }
             'd': S := LongToStr(TLongArray(Params)[I],
               10);                                   { Decimal parameter }
             's': S := PString(TLongArray(Params)[I])^;{ String parameter }
             'x': S := LongToStr(TLongArray(Params)[I],
               16);                                   { Hex parameter }
           end;
           Inc(FormatIndex);                          { Next character }
           If (Wth > 0) Then begin                    { Width control active }
             If (Length(S) > Wth) Then begin          { We must shorten S }
               If (Justify=1) Then                    { Check right justify }
                 S := Copy(S, Length(S)-Wth+1, Wth)   { Take right side data }
                 Else S := Copy(S, 1, Wth);           { Take left side data }
             end Else begin                           { We must pad out S }
               If (Justify=1) Then                    { Right justify }
                 While (Length(S) < Wth) Do
                   S := S+Fill Else                   { Right justify fill }
                 While (Length(S) < Wth) Do
                   S := Fill + S;                     { Left justify fill }
             end;
           end;
           W:=Length(S);
{$ifdef FV_UNICODE}
           SetLength(Result,ResultLength+W);
           Move(S[1], Result[ResultLength+1],
             2*W);                                    { Move data to result }
{$else FV_UNICODE}
           if W+ResultLength+1>High(Result) then
             W:=High(Result)-ResultLength;
           Move(S[1], Result[ResultLength+1],
             W);                                      { Move data to result }
{$endif FV_UNICODE}
           Inc(ResultLength,W);                       { Adj result length }
           Inc(I);
         end;
       end;
     end;
   end;

begin
   ResultLength := 0;                                 { Zero result length }
   FormatIndex := 1;                                  { Format index to 1 }
   HandleParameter(0);                                { Handle parameter }
{$ifndef FV_UNICODE}
   Result[0] := Chr(ResultLength);                    { Set string length }
{$endif FV_UNICODE}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                    NEW QUEUED EVENT HANDLER ROUTINES                      }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{---------------------------------------------------------------------------}
{  PutEventInQueue -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Mar98 LdB   }
{---------------------------------------------------------------------------}
FUNCTION PutEventInQueue (Var Event: TEvent): Boolean;
BEGIN
   If (QueueCount < QueueMax) Then Begin              { Check room in queue }
     Queue[QueueHead] := Event;                       { Store event }
     Inc(QueueHead);                                  { Inc head position }
     If (QueueHead = QueueMax) Then QueueHead := 0;   { Roll to start check }
     Inc(QueueCount);                                 { Inc queue count }
     PutEventInQueue := True;                         { Return successful }
   End Else PutEventInQueue := False;                 { Return failure }
END;

{---------------------------------------------------------------------------}
{  NextQueuedEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Mar98 LdB   }
{---------------------------------------------------------------------------}
PROCEDURE NextQueuedEvent(Var Event: TEvent);
BEGIN
   If (QueueCount > 0) Then Begin                     { Check queued event }
     Event := Queue[QueueTail];                       { Fetch next event }
     Inc(QueueTail);                                  { Inc tail position }
     If (QueueTail = QueueMax) Then QueueTail := 0;   { Roll to start check }
     Dec(QueueCount);                                 { Dec queue count }
   End Else Event.What := evNothing;                  { Return empty event }
END;

{***************************************************************************}
{                      UNIT INITIALIZATION ROUTINE                          }
{***************************************************************************}
BEGIN
{$IFDEF OS_AMIGA}
  StartupTicks := (dos.GetMsCount div 55);
{$ENDIF}
   ButtonCount := DetectMouse;                        { Detect mouse }
   DetectVideo;                                       { Detect video }
{   InitKeyboard;}
   InitSystemMsg;
{$ifdef OS_WINDOWS}
   SetFileApisToOEM;
{$endif}

   SaveExit := ExitProc;                              { Save old exit }
   ExitProc := @ExitDrivers;                          { Set new exit }
END.
