home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / bpos2tv.zip / DRIVERS.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-07  |  21KB  |  893 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 7.0                        }
  5. {       Turbo Vision Unit                               }
  6. {                                                       }
  7. {       Copyright (c) 1992 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit Drivers;
  12.  
  13. {$X+,I-,S-,P-}
  14.  
  15. interface
  16.  
  17. uses Objects, OS2Def, BSESub, BSEDos;
  18.  
  19. { ******** EVENT MANAGER ******** }
  20.  
  21. const
  22.  
  23. { Event codes }
  24.  
  25.   evMouseDown = $0001;
  26.   evMouseUp   = $0002;
  27.   evMouseMove = $0004;
  28.   evMouseAuto = $0008;
  29.   evKeyDown   = $0010;
  30.   evCommand   = $0100;
  31.   evBroadcast = $0200;
  32.  
  33. { Event masks }
  34.  
  35.   evNothing   = $0000;
  36.   evMouse     = $000F;
  37.   evKeyboard  = $0010;
  38.   evMessage   = $FF00;
  39.  
  40. { Extended key codes }
  41.  
  42.   kbEsc       = $011B;  kbAltSpace  = $0200;  kbCtrlIns   = $9200;
  43.   kbShiftIns  = $5230;  kbCtrlDel   = $9300;  kbShiftDel  = $532E;
  44.   kbBack      = $0E08;  kbCtrlBack  = $0E7F;  kbShiftTab  = $0F00;
  45.   kbTab       = $0F09;  kbAltQ      = $1000;  kbAltW      = $1100;
  46.   kbAltE      = $1200;  kbAltR      = $1300;  kbAltT      = $1400;
  47.   kbAltY      = $1500;  kbAltU      = $1600;  kbAltI      = $1700;
  48.   kbAltO      = $1800;  kbAltP      = $1900;  kbCtrlEnter = $1C0A;
  49.   kbEnter     = $1C0D;  kbAltA      = $1E00;  kbAltS      = $1F00;
  50.   kbAltD      = $2000;  kbAltF      = $2100;  kbAltG      = $2200;
  51.   kbAltH      = $2300;  kbAltJ      = $2400;  kbAltK      = $2500;
  52.   kbAltL      = $2600;  kbAltZ      = $2C00;  kbAltX      = $2D00;
  53.   kbAltC      = $2E00;  kbAltV      = $2F00;  kbAltB      = $3000;
  54.   kbAltN      = $3100;  kbAltM      = $3200;  kbF1        = $3B00;
  55.   kbF2        = $3C00;  kbF3        = $3D00;  kbF4        = $3E00;
  56.   kbF5        = $3F00;  kbF6        = $4000;  kbF7        = $4100;
  57.   kbF8        = $4200;  kbF9        = $4300;  kbF10       = $4400;
  58.   kbHome      = $4700;  kbUp        = $4800;  kbPgUp      = $4900;
  59.   kbGrayMinus = $4A2D;  kbLeft      = $4B00;  kbRight     = $4D00;
  60.   kbGrayPlus  = $4E2B;  kbEnd       = $4F00;  kbDown      = $5000;
  61.   kbPgDn      = $5100;  kbIns       = $5200;  kbDel       = $5300;
  62.   kbShiftF1   = $5400;  kbShiftF2   = $5500;  kbShiftF3   = $5600;
  63.   kbShiftF4   = $5700;  kbShiftF5   = $5800;  kbShiftF6   = $5900;
  64.   kbShiftF7   = $5A00;  kbShiftF8   = $5B00;  kbShiftF9   = $5C00;
  65.   kbShiftF10  = $5D00;  kbCtrlF1    = $5E00;  kbCtrlF2    = $5F00;
  66.   kbCtrlF3    = $6000;  kbCtrlF4    = $6100;  kbCtrlF5    = $6200;
  67.   kbCtrlF6    = $6300;  kbCtrlF7    = $6400;  kbCtrlF8    = $6500;
  68.   kbCtrlF9    = $6600;  kbCtrlF10   = $6700;  kbAltF1     = $6800;
  69.   kbAltF2     = $6900;  kbAltF3     = $6A00;  kbAltF4     = $6B00;
  70.   kbAltF5     = $6C00;  kbAltF6     = $6D00;  kbAltF7     = $6E00;
  71.   kbAltF8     = $6F00;  kbAltF9     = $7000;  kbAltF10    = $7100;
  72.   kbCtrlPrtSc = $7200;  kbCtrlLeft  = $7300;  kbCtrlRight = $7400;
  73.   kbCtrlEnd   = $7500;  kbCtrlPgDn  = $7600;  kbCtrlHome  = $7700;
  74.   kbAlt1      = $7800;  kbAlt2      = $7900;  kbAlt3      = $7A00;
  75.   kbAlt4      = $7B00;  kbAlt5      = $7C00;  kbAlt6      = $7D00;
  76.   kbAlt7      = $7E00;  kbAlt8      = $7F00;  kbAlt9      = $8000;
  77.   kbAlt0      = $8100;  kbAltMinus  = $8200;  kbAltEqual  = $8300;
  78.   kbCtrlPgUp  = $8400;  kbAltBack   = $0E00;  kbNoKey     = $0000;
  79.  
  80. { Keyboard state and shift masks }
  81.  
  82.   kbRightShift  = $0001;
  83.   kbLeftShift   = $0002;
  84.   kbCtrlShift   = $0004;
  85.   kbAltShift    = $0008;
  86.   kbScrollState = $0010;
  87.   kbNumState    = $0020;
  88.   kbCapsState   = $0040;
  89.   kbInsState    = $0080;
  90.  
  91. { Mouse button state masks }
  92.  
  93.   mbLeftButton   = $01;
  94.   mbRightButton  = $02;
  95.   mbMiddleButton = $04;
  96.  
  97. type
  98.  
  99. { Event record }
  100.  
  101.   PEvent = ^TEvent;
  102.   TEvent = record
  103.     What: Word;
  104.     case Word of
  105.       evNothing: ();
  106.       evMouse: (
  107.         Buttons: Byte;
  108.         Double: Boolean;
  109.         Where: TPoint);
  110.       evKeyDown: (
  111.         case Integer of
  112.       0: (KeyCode: Word);
  113.           1: (CharCode: Char;
  114.               ScanCode: Byte));
  115.       evMessage: (
  116.         Command: Word;
  117.         case Word of
  118.           0: (InfoPtr: Pointer);
  119.           1: (InfoLong: Longint);
  120.           2: (InfoWord: Word);
  121.           3: (InfoInt: Integer);
  122.           4: (InfoByte: Byte);
  123.           5: (InfoChar: Char));
  124.   end;
  125.  
  126. const
  127.  
  128. { Initialized variables }
  129.  
  130.   HMouse: HMOU = 0;
  131.   ButtonCount: Word = 0;
  132.   MouseEvents: Boolean = False;
  133.   MouseReverse: Boolean = False;
  134.   DoubleDelay: Word = 8;
  135.   RepeatDelay: Word = 8;
  136.   RepeatSpacing: Word = 55; { msecs between autoticks }
  137.  
  138. {var
  139.  
  140. { Uninitialized variables }
  141.  
  142. {  MouseIntFlag: Byte;
  143.   MouseButtons: Byte;
  144.   MouseWhere: TPoint;
  145.  
  146. { Event manager routines }
  147.  
  148. procedure InitEvents;
  149. procedure DoneEvents;
  150. procedure ShowMouse;
  151. procedure HideMouse;
  152. procedure GetMouseEvent(var Event: TEvent);
  153. procedure GetKeyEvent(var Event: TEvent);
  154. function GetShiftState: Word;
  155.  
  156. { ******** SCREEN MANAGER ******** }
  157.  
  158. const
  159.  
  160. { Screen modes }
  161.  
  162.   smBW80    = $0002;
  163.   smCO80    = $0003;
  164.   smMono    = $0007;
  165.   smFont8x8 = $0100;
  166.  
  167. const
  168.  
  169. { Initialized variables }
  170.  
  171.   StartupMode: Word = $FFFF;
  172.   CheckSnow : boolean = false;
  173.  
  174. var
  175.  
  176. { Uninitialized variables }
  177.  
  178.   ScreenMode: Word;
  179.   ScreenWidth: Byte;
  180.   ScreenHeight: Byte;
  181.   HiResScreen: Boolean;
  182.   ScreenBuffer: pointer;
  183.   ScreenLen: Word;
  184.   CursorLines: Word;
  185.  
  186. { Screen manager routines }
  187.  
  188. procedure InitVideo;
  189. procedure DoneVideo;
  190. procedure SetVideoMode(Mode: Word);
  191. function SetCrtMode(Cols, Rows, NumColors : byte) : boolean;
  192. procedure ClearScreen;
  193.  
  194. { ******** SYSTEM ERROR HANDLER ******** }
  195.  
  196. type
  197.  
  198. { System error handler function type }
  199.  
  200.   TSysErrorFunc = function(ErrorCode: Integer; Drive: Byte): Integer;
  201.  
  202. { Default system error handler routine }
  203.  
  204. function SystemError(ErrorCode: Integer; Drive: Byte): Integer;
  205.  
  206. const
  207.  
  208. { Initialized variables }
  209.  
  210.   SaveInt09: Pointer = nil;
  211.   SysErrorFunc: TSysErrorFunc = SystemError;
  212.   SysColorAttr: Word = $4E4F;
  213.   SysMonoAttr: Word = $7070;
  214.   CtrlBreakHit: Boolean = False;
  215.   SaveCtrlBreak: Boolean = False;
  216.   SysErrActive: Boolean = False;
  217.   FailSysErrors: Boolean = False;
  218.  
  219. { System error handler routines }
  220.  
  221. procedure InitSysError;
  222. procedure DoneSysError;
  223.  
  224. { ******** UTILITY ROUTINES ******** }
  225.  
  226. { Keyboard support routines }
  227.  
  228. function GetAltChar(KeyCode: Word): Char;
  229. function GetAltCode(Ch: Char): Word;
  230. function GetCtrlChar(KeyCode: Word): Char;
  231. function GetCtrlCode(Ch: Char): Word;
  232. function CtrlToArrow(KeyCode: Word): Word;
  233.  
  234. { String routines }
  235.  
  236. procedure FormatStr(var Result: String; const Format: String; var Params);
  237. procedure PrintStr(const S: String);
  238.  
  239. { Buffer move routines }
  240.  
  241. procedure MoveBuf(var Dest; var Source; Attr: Byte; Count: Word);
  242. procedure MoveChar(var Dest; C: Char; Attr: Byte; Count: Word);
  243. procedure MoveCStr(var Dest; const Str: String; Attrs: Word);
  244. procedure MoveStr(var Dest; const Str: String; Attr: Byte);
  245. function CStrLen(const S: String): Integer;
  246.  
  247. implementation
  248.  
  249. { ******** EVENT MANAGER ******** }
  250.  
  251. const
  252.  
  253. { Event manager constants }
  254.  
  255.   EventQSize = 16;
  256.  
  257. var
  258.  
  259. { Event manager variables }
  260.  
  261.   LastButtons: Byte;
  262.   DownButtons: Byte;
  263.   LastDouble: Boolean;
  264.   LastWhere: TPoint;
  265.   DownWhere: TPoint;
  266.   DownTicks: Word;
  267.   AutoTicks: Word;
  268.   AutoDelay: Word;
  269.   EventCount: Word;
  270.   EventQHead: Word;
  271.   EventQTail: Word;
  272.   EventQueue: array[0..EventQSize - 1] of TEvent;
  273.   EventQLast: record end;
  274.  
  275. { Detect mouse driver }
  276.  
  277. procedure DetectMouse; near;
  278. begin
  279.   if MouOpen(nil, @HMouse) = 0 then begin
  280.     MouGetNumButtons(@ButtonCount, HMouse);
  281.     MouClose(HMouse);
  282.   end;
  283.   HMouse := 0;
  284. end;
  285.  
  286. procedure InitEvents;
  287. var
  288.   ZeroPos : PtrLoc;
  289. begin
  290.   if MouOpen(nil, @HMouse) = 0 then begin
  291.     ZeroPos.col := 0;
  292.     ZeroPos.row := 0;
  293.     MouDrawPtr(HMouse);
  294.     MouSetPtrPos(@ZeroPos, HMouse);
  295.     MouseEvents := true;
  296.   end;
  297. end;
  298.  
  299. procedure DoneEvents;
  300. begin
  301.   MouClose(HMouse);
  302. end;
  303.  
  304. procedure ShowMouse;
  305. begin
  306.   if HMouse <> 0 then
  307.     MouDrawPtr(HMouse);
  308. end;
  309.  
  310. procedure HideMouse;
  311. var
  312.   Rect : NoPtrRect;
  313. begin
  314.   if HMouse <> 0 then begin
  315.     with Rect do begin
  316.       row := 0;
  317.       col := 0;
  318.       crow := ScreenHeight-1;
  319.       ccol := ScreenWidth-1;
  320.     end;
  321.     MouRemovePtr(@Rect, HMouse);
  322.   end;
  323. end;
  324.  
  325. function EvenBits(n : word) : byte; assembler;
  326. asm
  327.         XOR     AX,AX
  328.     MOV    BX,N
  329.         MOV     DX,1
  330. @@1:    OR      BX,BX
  331.         JE      @@2
  332.     TEST    BX,3
  333.         JZ      @@3
  334.         OR      AX,DX
  335. @@3:
  336.         SHL     DX,1
  337.         SHR    BX,1
  338.         SHR    BX,1
  339.         JMP     @@1
  340. @@2:
  341. end;
  342.  
  343. const
  344.   MouseButtons : byte = 0;
  345.   MouseDblClick : boolean = false;
  346.   MouseQEvent : TEvent = (What:evNothing);
  347. var
  348.   MouseLastClickTime : longint;
  349.  
  350. procedure GetMouseEvent(var Event: TEvent);
  351. const
  352.   Wait : word = 0;
  353. var
  354.   Info : MouEventInfo;
  355.   GlobInfo, LocalInfo : SEL;
  356.   gtime : longint;
  357. begin
  358.   if MouseQEvent.What <> evNothing then begin
  359.     Event := MouseQEvent;
  360.     MouseQEvent.What := evNothing;
  361.     Exit;
  362.   end; { use queued event if there is one }
  363.   MouseQEvent.What := evNothing;
  364.   Event.What := evNothing;
  365.   if (HMouse = 0) then Exit;
  366.   while (MouReadEventQue(@Info, @Wait, HMouse) = 0) and (Info.time <> 0) do
  367.   with Info do begin
  368.     MouseQEvent.Double := false;
  369.     MouseQEvent.Where.X := col;
  370.     MouseQEvent.Where.Y := row;
  371.     MouseQEvent.Buttons := EvenBits(fs shr 1);
  372.     if fs and $54 > 0 then begin { a button's down }
  373.       MouseQEvent.What := evMouseDown;
  374.       MouseButtons := MouseQEvent.Buttons;
  375.       MouseQEvent.Double := MouseDblClick and
  376.         (time-MouseLastClickTime < DoubleDelay*55);
  377.       MouseDblClick := not MouseQEvent.Double;
  378.       MouseLastClickTime := time;
  379.       AutoDelay := RepeatDelay*55;
  380.       Break;
  381.     end else begin
  382.       if MouseButtons xor MouseQEvent.Buttons <> 0 then begin { button changed }
  383.         MouseQEvent.What := evMouseUp;
  384.         MouseButtons := MouseQEvent.Buttons;
  385.         Break;
  386.       end else begin { just moved the mouse }
  387.         Event := MouseQEvent;
  388.         Event.What := evMouseMove;
  389.         MouseDblClick := false;
  390.       end;
  391.     end;
  392.   end;
  393.   if Event.What = evNothing then begin { if no mouse movement }
  394.     if MouseQEvent.What = evNothing then begin
  395.       DosGetInfoSeg(@GlobInfo, @LocalInfo);
  396.       with PGINFOSEG(Ptr(GlobInfo, 0))^ do begin
  397.         gtime := msecs;
  398.         while gtime <> msecs do gtime := msecs; { wait for it to stop changing }
  399.       end;
  400.       { no event at all, check for auto repeat }
  401.       if (MouseButtons > 0) and
  402.       (gtime-MouseLastClickTime >= AutoDelay) then
  403.       begin { auto repeat }
  404.         MouseLastClickTime := gtime;
  405.         MouseQEvent.What := evMouseAuto;
  406.         MouseButtons := MouseQEvent.Buttons;
  407.         AutoDelay := RepeatSpacing;
  408.       end;
  409.     end;
  410.     Event := MouseQEvent;
  411.     MouseQEvent.What := evNothing; { use the queued event }
  412.   end;
  413. end;
  414.  
  415. procedure GetKeyEvent(var Event: TEvent);
  416. var
  417.   Info : KbdKeyInfo;
  418. begin
  419.   Event.What := evNothing;
  420.   Event.ScanCode := 0;
  421.   Info.chScan := 0;
  422.   if (KbdCharIn(@Info, IO_NOWAIT, 0) = 0) and
  423.       (Info.fbStatus <> 0) then
  424.   begin
  425.     Event.What := evKeyDown;
  426.     if Info.chChar = 224 then
  427.       Event.CharCode := #0
  428.     else
  429.       Event.CharCode := chr(Info.chChar);
  430.     Event.ScanCode := byte(Info.chScan);
  431.     if Event.ScanCode = 224 then Event.ScanCode := 28;
  432.   end;
  433. end;
  434.  
  435. function GetShiftState: Word;
  436. var
  437.   Info : KbdInfo;
  438. begin
  439.   Info.cb := sizeof(KbdInfo);
  440.   if KbdGetStatus(@Info, 0) = 0 then begin
  441.     GetShiftState := Info.fsState;
  442.   end else
  443.     GetShiftState := 0;
  444. end;
  445.  
  446. { ******** SCREEN MANAGER ******** }
  447.  
  448. { Save registers and call video interrupt }
  449.  
  450. procedure VideoInt; near; assembler;
  451. asm
  452.     PUSH    BP
  453.     PUSH    ES
  454.     INT    10H
  455.     POP    ES
  456.     POP    BP
  457. end;
  458.  
  459. { Set CRT data areas and mouse range }
  460.  
  461. procedure SetCrtData; near;
  462. var
  463.   Info : VioModeInfo;
  464. begin
  465.   Info.cb := sizeof(Info);
  466.   VioGetMode(@Info, 0);
  467.   with Info do begin
  468.     ScreenWidth := col;
  469.     ScreenHeight := row;
  470.   end;
  471. end;
  472.  
  473. var
  474.   DefVioMode : VioModeInfo;
  475.  
  476. procedure DetectVideo;
  477. begin
  478.   DefVioMode.cb := sizeof(DefVioMode);
  479.   VioGetMode(@DefVioMode, 0);
  480. end;
  481.  
  482. function SetCrtMode(Cols, Rows, NumColors : byte) : boolean;
  483. var
  484.   info : VIOMODEINFO;
  485.   cursinfo : VIOCURSORINFO;
  486. begin
  487.   SetCrtMode := true;
  488.   VioGetBuf(@ScreenBuffer, @ScreenLen, 0);
  489.   info.cb := sizeof(info);
  490.   if (VioGetMode(@info, 0) <> 0) then begin
  491.     SetCrtMode := false;
  492.     Exit;
  493.   end;
  494.   with info do begin
  495.     if (col <> cols) or (row <> rows) or (color <> numcolors) then begin
  496.       info.col := cols;
  497.       info.row := rows;
  498.       info.color := numcolors;
  499.       if VioSetMode(@info, 0) <> 0 then
  500.         SetCrtMode := false;
  501.     end;
  502.   end;
  503.   ScreenWidth := info.col;
  504.   ScreenHeight := info.row;
  505.   VioGetCurType(@cursinfo, 0);
  506.   with cursinfo do
  507.     CursorLines := cEnd+yStart shl 8;
  508.   cursinfo.attr := $FFFF;
  509.   VioSetCurType(@cursinfo, 0);
  510. end;
  511.  
  512. procedure SetVideoMode(Mode: Word);
  513. var
  514.   Cols, Rows, Colors : byte;
  515. begin
  516.   if (Mode = smBW80) or (Mode = smMono) then Colors := 1 else Colors := 4;
  517.   if Mode >= smFont8x8 then Rows := 43 else Rows := 25;
  518.   Cols := 80;
  519.   SetCrtMode(Cols, Rows, Colors);
  520.   ScreenMode := Mode;
  521. end;
  522.  
  523. procedure InitVideo;
  524. begin
  525.   SetVideoMode(ScreenMode);
  526. end;
  527.  
  528. procedure DoneVideo;
  529. begin
  530.   ClearScreen;
  531.   VioSetMode(@DefVioMode, 0);
  532. end;
  533.  
  534. procedure ClearScreen;
  535. const
  536.   Cell : word = $0720;
  537. begin
  538.   VioScrollUp(0, 0, $FFFF, $FFFF, $FFFF, PByte(@Cell), 0);
  539. end;
  540.  
  541. { ******** SYSTEM ERROR HANDLER ******** }
  542. (*
  543. {$L SYSINT.OBO}
  544. *)
  545. const
  546.  
  547. { System error messages }
  548.  
  549.   SCriticalError:  string[31] = 'Critical disk error on drive %c';
  550.   SWriteProtected: string[35] = 'Disk is write-protected in drive %c';
  551.   SDiskNotReady:   string[29] = 'Disk is not ready in drive %c';
  552.   SDataIntegrity:  string[32] = 'Data integrity error on drive %c';
  553.   SSeekError:      string[22] = 'Seek error on drive %c';
  554.   SUnknownMedia:   string[30] = 'Unknown media type in drive %c';
  555.   SSectorNotFound: string[28] = 'Sector not found on drive %c';
  556.   SOutOfPaper:     string[20] = 'Printer out of paper';
  557.   SWriteFault:     string[23] = 'Write fault on drive %c';
  558.   SReadFault:      string[22] = 'Read fault on drive %c';
  559.   SGeneralFailure: string[28] = 'Hardware failure on drive %c';
  560.   SBadImageOfFAT:  string[32] = 'Bad memory image of FAT detected';
  561.   SDeviceError:    string[19] = 'Device access error';
  562.   SInsertDisk:     string[27] = 'Insert diskette in drive %c';
  563.   SRetryOrCancel:  string[27] = '~Enter~ Retry  ~Esc~ Cancel';
  564.  
  565. { Critical error message translation table }
  566.  
  567.   ErrorString: array[0..15] of Word = (
  568.     Ofs(SWriteProtected),
  569.     Ofs(SCriticalError),
  570.     Ofs(SDiskNotReady),
  571.     Ofs(SCriticalError),
  572.     Ofs(SDataIntegrity),
  573.     Ofs(SCriticalError),
  574.     Ofs(SSeekError),
  575.     Ofs(SUnknownMedia),
  576.     Ofs(SSectorNotFound),
  577.     Ofs(SOutOfPaper),
  578.     Ofs(SWriteFault),
  579.     Ofs(SReadFault),
  580.     Ofs(SGeneralFailure),
  581.     Ofs(SBadImageOfFAT),
  582.     Ofs(SDeviceError),
  583.     Ofs(SInsertDisk));
  584.  
  585. { System error handler routines }
  586.  
  587. procedure InitSysError;
  588. begin
  589. end;
  590.  
  591. procedure DoneSysError;
  592. begin
  593. end;
  594.  
  595. procedure SwapStatusLine(var Buffer); near; assembler;
  596. asm
  597.     MOV    CL,ScreenWidth
  598.     XOR    CH,CH
  599.     MOV    AL,ScreenHeight
  600.     DEC    AL
  601.     MUL    CL
  602.     SHL    AX,1
  603.     LES    DI,ScreenBuffer
  604.     ADD    DI,AX
  605.     PUSH    DS
  606.     LDS    SI,Buffer
  607. @@1:    MOV    AX,ES:[DI]
  608.     MOVSW
  609.     MOV    DS:[SI-2],AX
  610.     LOOP    @@1
  611.     POP    DS
  612. end;
  613.  
  614. function SelectKey: Integer; near; assembler;
  615. asm
  616.     MOV    AH,3
  617.     MOV    BH,0
  618.     CALL    VideoInt
  619.     PUSH    CX
  620.     MOV    AH,1
  621.     MOV    CX,2000H
  622.     CALL    VideoInt
  623. @@1:    MOV    AH,1
  624.     INT    16H
  625.     PUSHF
  626.     MOV    AH,0
  627.     INT    16H
  628.     POPF
  629.     JNE    @@1
  630.     XOR    DX,DX
  631.     CMP    AL,13
  632.     JE    @@2
  633.     INC    DX
  634.     CMP    AL,27
  635.     JNE    @@1
  636. @@2:    POP    CX
  637.     PUSH    DX
  638.     MOV    AH,1
  639.     CALL    VideoInt
  640.     POP    AX
  641. end;
  642.  
  643. {$V-}
  644.  
  645. function SystemError(ErrorCode: Integer; Drive: Byte): Integer;
  646. var
  647.   C: Word;
  648.   P: Pointer;
  649.   S: string[63];
  650.   B: array[0..79] of Word;
  651. begin
  652.   if FailSysErrors then
  653.   begin
  654.     SystemError := 1;
  655.     Exit;
  656.   end;
  657.  
  658.   if Lo(ScreenMode) = smMono then
  659.     C := SysMonoAttr else
  660.     C := SysColorAttr;
  661.   P := Pointer(Drive + Ord('A'));
  662.   FormatStr(S, PString(Ptr(DSeg, ErrorString[ErrorCode]))^, P);
  663.   MoveChar(B, ' ', Byte(C), 80);
  664.   MoveCStr(B[1], S, C);
  665.   MoveCStr(B[79 - CStrLen(SRetryOrCancel)], SRetryOrCancel, C);
  666.   SwapStatusLine(B);
  667.   SystemError := SelectKey;
  668.   SwapStatusLine(B);
  669. end;
  670.  
  671. {$V+}
  672.  
  673. { ******** UTILITY ROUTINES ******** }
  674.  
  675. { Keyboard support routines }
  676.  
  677. const
  678.  
  679.   AltCodes1: array[$10..$32] of Char =
  680.     'QWERTYUIOP'#0#0#0#0'ASDFGHJKL'#0#0#0#0#0'ZXCVBNM';
  681.  
  682.   AltCodes2: array[$78..$83] of Char =
  683.     '1234567890-=';
  684.  
  685. function GetAltChar(KeyCode: Word): Char;
  686. begin
  687.   GetAltChar := #0;
  688.   if Lo(KeyCode) = 0 then
  689.     case Hi(KeyCode) of
  690.       $02: GetAltChar := #240;
  691.       $10..$32: GetAltChar := AltCodes1[Hi(KeyCode)];
  692.       $78..$83: GetAltChar := AltCodes2[Hi(KeyCode)];
  693.     end;
  694. end;
  695.  
  696. function GetAltCode(Ch: Char): Word;
  697. var
  698.   I: Word;
  699. begin
  700.   GetAltCode := 0;
  701.   if Ch = #0 then Exit;
  702.   Ch := UpCase(Ch);
  703.   if Ch = #240 then
  704.   begin
  705.     GetAltCode := $0200;
  706.     Exit;
  707.   end;
  708.   for I := $10 to $32 do
  709.     if AltCodes1[I] = Ch then
  710.     begin
  711.       GetAltCode := I shl 8;
  712.       Exit;
  713.     end;
  714.   for I := $78 to $83 do
  715.     if AltCodes2[I] = Ch then
  716.     begin
  717.       GetAltCode := I shl 8;
  718.       Exit;
  719.     end;
  720. end;
  721.  
  722. function GetCtrlChar(KeyCode: Word): Char;
  723. begin
  724.   GetCtrlChar := #0;
  725.   if (Lo(KeyCode) <> 0) and (Lo(KeyCode) <= Byte('Z') - Byte('A') + 1) then
  726.     GetCtrlChar := Char(Lo(KeyCode) + Byte('A') - 1);
  727. end;
  728.  
  729. function GetCtrlCode(Ch: Char): Word;
  730. begin
  731.   GetCtrlCode := GetAltCode(Ch) or (Byte(UpCase(Ch)) - Byte('A') + 1);
  732. end;
  733.  
  734. function CtrlToArrow(KeyCode: Word): Word;
  735. const
  736.   NumCodes = 11;
  737.   CtrlCodes: array[0..NumCodes-1] of Char = ^S^D^E^X^A^F^G^V^R^C^H;
  738.   ArrowCodes: array[0..NumCodes-1] of Word =
  739.     (kbLeft, kbRight, kbUp, kbDown, kbHome, kbEnd, kbDel, kbIns,
  740.      kbPgUp, kbPgDn, kbBack);
  741. var
  742.   I: Integer;
  743. begin
  744.   CtrlToArrow := KeyCode;
  745.   for I := 0 to NumCodes - 1 do
  746.     if WordRec(KeyCode).Lo = Byte(CtrlCodes[I]) then
  747.     begin
  748.       CtrlToArrow := ArrowCodes[I];
  749.       Exit;
  750.     end;
  751. end;
  752.  
  753. { String formatting routines }
  754.  
  755. {$L FORMAT.OBJ}
  756.  
  757. procedure FormatStr(var Result: String; const Format: String; var Params);
  758. external {FORMAT};
  759.  
  760. procedure PrintStr(const S: String);
  761. var
  762.   Result : word;
  763. begin
  764.   DosWrite(1 {STDOUT}, (PChar(@S)+1), length(S), @Result);
  765. end;
  766.  
  767. { Buffer move routines }
  768.  
  769. procedure MoveBuf(var Dest; var Source; Attr: Byte; Count: Word); assembler;
  770. asm
  771.     MOV    CX,Count
  772.     JCXZ    @@5
  773.     MOV    DX,DS
  774.     LES    DI,Dest
  775.     LDS    SI,Source
  776.     MOV    AH,Attr
  777.     CLD
  778.     OR    AH,AH
  779.     JE    @@3
  780. @@1:    LODSB
  781.     STOSW
  782.     LOOP    @@1
  783.     JMP    @@4
  784. @@2:    INC    DI
  785. @@3:    MOVSB
  786.     LOOP    @@2
  787. @@4:    MOV    DS,DX
  788. @@5:
  789. end;
  790.  
  791. procedure MoveChar(var Dest; C: Char; Attr: Byte; Count: Word); assembler;
  792. asm
  793.     MOV    CX,Count
  794.     JCXZ    @@4
  795.     LES    DI,Dest
  796.     MOV    AL,C
  797.     MOV    AH,Attr
  798.     CLD
  799.     OR    AL,AL
  800.     JE    @@1
  801.     OR    AH,AH
  802.     JE    @@3
  803.     REP    STOSW
  804.     JMP    @@4
  805. @@1:    MOV    AL,AH
  806. @@2:    INC    DI
  807. @@3:    STOSB
  808.     LOOP    @@2
  809. @@4:
  810. end;
  811.  
  812. procedure MoveCStr(var Dest; const Str: String; Attrs: Word); assembler;
  813. asm
  814.     MOV    DX,DS
  815.     LDS    SI,Str
  816.     CLD
  817.     LODSB
  818.     MOV    CL,AL
  819.     XOR    CH,CH
  820.     JCXZ    @@3
  821.     LES    DI,Dest
  822.     MOV    BX,Attrs
  823.     MOV    AH,BL
  824. @@1:    LODSB
  825.     CMP    AL,'~'
  826.     JE    @@2
  827.     STOSW
  828.     LOOP    @@1
  829.     JMP    @@3
  830. @@2:    XCHG    AH,BH
  831.     LOOP    @@1
  832. @@3:    MOV    DS,DX
  833. end;
  834.  
  835. procedure MoveStr(var Dest; const Str: String; Attr: Byte); assembler;
  836. asm
  837.     MOV    DX,DS
  838.     LDS    SI,Str
  839.     CLD
  840.     LODSB
  841.     MOV    CL,AL
  842.     XOR    CH,CH
  843.     JCXZ    @@4
  844.     LES    DI,Dest
  845.     MOV    AH,Attr
  846.     OR    AH,AH
  847.     JE    @@3
  848. @@1:    LODSB
  849.     STOSW
  850.     LOOP    @@1
  851.     JMP    @@4
  852. @@2:    INC    DI
  853. @@3:    MOVSB
  854.     LOOP    @@2
  855. @@4:    MOV    DS,DX
  856. end;
  857.  
  858. function CStrLen(const S: String): Integer; assembler;
  859. asm
  860.     LES    DI,S
  861.     MOV    CL,ES:[DI]
  862.     INC    DI
  863.     XOR    CH,CH
  864.     MOV    BX,CX
  865.         JCXZ    @@2
  866.     MOV    AL,'~'
  867.         CLD
  868. @@1:    REPNE    SCASB
  869.     JNE    @@2
  870.     DEC    BX
  871.     JMP    @@1
  872. @@2:    MOV    AX,BX
  873. end;
  874.  
  875. { Drivers unit initialization and shutdown }
  876.  
  877. var
  878.   SaveExit: Pointer;
  879.  
  880. procedure ExitDrivers; far;
  881. begin
  882.   DoneSysError;
  883.   DoneEvents;
  884.   ExitProc := SaveExit;
  885. end;
  886.  
  887. begin
  888.   DetectMouse;
  889.   DetectVideo;
  890.   SaveExit := ExitProc;
  891.   ExitProc := @ExitDrivers;
  892. end.
  893.