home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 13.ddi / RTLTV.ZIP / DRIVERS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-28  |  20.9 KB  |  1,107 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. {$C FIXED PRELOAD PERMANENT}
  15.  
  16. interface
  17.  
  18. uses Objects;
  19.  
  20. { ******** EVENT MANAGER ******** }
  21.  
  22. const
  23.  
  24. { Event codes }
  25.  
  26.   evMouseDown = $0001;
  27.   evMouseUp   = $0002;
  28.   evMouseMove = $0004;
  29.   evMouseAuto = $0008;
  30.   evKeyDown   = $0010;
  31.   evCommand   = $0100;
  32.   evBroadcast = $0200;
  33.  
  34. { Event masks }
  35.  
  36.   evNothing   = $0000;
  37.   evMouse     = $000F;
  38.   evKeyboard  = $0010;
  39.   evMessage   = $FF00;
  40.  
  41. { Extended key codes }
  42.  
  43.   kbEsc       = $011B;  kbAltSpace  = $0200;  kbCtrlIns   = $0400;
  44.   kbShiftIns  = $0500;  kbCtrlDel   = $0600;  kbShiftDel  = $0700;
  45.   kbBack      = $0E08;  kbCtrlBack  = $0E7F;  kbShiftTab  = $0F00;
  46.   kbTab       = $0F09;  kbAltQ      = $1000;  kbAltW      = $1100;
  47.   kbAltE      = $1200;  kbAltR      = $1300;  kbAltT      = $1400;
  48.   kbAltY      = $1500;  kbAltU      = $1600;  kbAltI      = $1700;
  49.   kbAltO      = $1800;  kbAltP      = $1900;  kbCtrlEnter = $1C0A;
  50.   kbEnter     = $1C0D;  kbAltA      = $1E00;  kbAltS      = $1F00;
  51.   kbAltD      = $2000;  kbAltF      = $2100;  kbAltG      = $2200;
  52.   kbAltH      = $2300;  kbAltJ      = $2400;  kbAltK      = $2500;
  53.   kbAltL      = $2600;  kbAltZ      = $2C00;  kbAltX      = $2D00;
  54.   kbAltC      = $2E00;  kbAltV      = $2F00;  kbAltB      = $3000;
  55.   kbAltN      = $3100;  kbAltM      = $3200;  kbF1        = $3B00;
  56.   kbF2        = $3C00;  kbF3        = $3D00;  kbF4        = $3E00;
  57.   kbF5        = $3F00;  kbF6        = $4000;  kbF7        = $4100;
  58.   kbF8        = $4200;  kbF9        = $4300;  kbF10       = $4400;
  59.   kbHome      = $4700;  kbUp        = $4800;  kbPgUp      = $4900;
  60.   kbGrayMinus = $4A2D;  kbLeft      = $4B00;  kbRight     = $4D00;
  61.   kbGrayPlus  = $4E2B;  kbEnd       = $4F00;  kbDown      = $5000;
  62.   kbPgDn      = $5100;  kbIns       = $5200;  kbDel       = $5300;
  63.   kbShiftF1   = $5400;  kbShiftF2   = $5500;  kbShiftF3   = $5600;
  64.   kbShiftF4   = $5700;  kbShiftF5   = $5800;  kbShiftF6   = $5900;
  65.   kbShiftF7   = $5A00;  kbShiftF8   = $5B00;  kbShiftF9   = $5C00;
  66.   kbShiftF10  = $5D00;  kbCtrlF1    = $5E00;  kbCtrlF2    = $5F00;
  67.   kbCtrlF3    = $6000;  kbCtrlF4    = $6100;  kbCtrlF5    = $6200;
  68.   kbCtrlF6    = $6300;  kbCtrlF7    = $6400;  kbCtrlF8    = $6500;
  69.   kbCtrlF9    = $6600;  kbCtrlF10   = $6700;  kbAltF1     = $6800;
  70.   kbAltF2     = $6900;  kbAltF3     = $6A00;  kbAltF4     = $6B00;
  71.   kbAltF5     = $6C00;  kbAltF6     = $6D00;  kbAltF7     = $6E00;
  72.   kbAltF8     = $6F00;  kbAltF9     = $7000;  kbAltF10    = $7100;
  73.   kbCtrlPrtSc = $7200;  kbCtrlLeft  = $7300;  kbCtrlRight = $7400;
  74.   kbCtrlEnd   = $7500;  kbCtrlPgDn  = $7600;  kbCtrlHome  = $7700;
  75.   kbAlt1      = $7800;  kbAlt2      = $7900;  kbAlt3      = $7A00;
  76.   kbAlt4      = $7B00;  kbAlt5      = $7C00;  kbAlt6      = $7D00;
  77.   kbAlt7      = $7E00;  kbAlt8      = $7F00;  kbAlt9      = $8000;
  78.   kbAlt0      = $8100;  kbAltMinus  = $8200;  kbAltEqual  = $8300;
  79.   kbCtrlPgUp  = $8400;  kbAltBack   = $0800;  kbNoKey     = $0000;
  80.  
  81. { Keyboard state and shift masks }
  82.  
  83.   kbRightShift  = $0001;
  84.   kbLeftShift   = $0002;
  85.   kbCtrlShift   = $0004;
  86.   kbAltShift    = $0008;
  87.   kbScrollState = $0010;
  88.   kbNumState    = $0020;
  89.   kbCapsState   = $0040;
  90.   kbInsState    = $0080;
  91.  
  92. { Mouse button state masks }
  93.  
  94.   mbLeftButton  = $01;
  95.   mbRightButton = $02;
  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.   ButtonCount: Byte = 0;
  131.   MouseEvents: Boolean = False;
  132.   MouseReverse: Boolean = False;
  133.   DoubleDelay: Word = 8;
  134.   RepeatDelay: Word = 8;
  135.  
  136. var
  137.  
  138. { Uninitialized variables }
  139.  
  140.   MouseIntFlag: Byte;
  141.   MouseButtons: Byte;
  142.   MouseWhere: TPoint;
  143.  
  144. { Event manager routines }
  145.  
  146. procedure InitEvents;
  147. procedure DoneEvents;
  148. procedure ShowMouse;
  149. procedure HideMouse;
  150. procedure GetMouseEvent(var Event: TEvent);
  151. procedure GetKeyEvent(var Event: TEvent);
  152. function GetShiftState: Byte;
  153.  
  154. { ******** SCREEN MANAGER ******** }
  155.  
  156. const
  157.  
  158. { Screen modes }
  159.  
  160.   smBW80    = $0002;
  161.   smCO80    = $0003;
  162.   smMono    = $0007;
  163.   smFont8x8 = $0100;
  164.  
  165. const
  166.  
  167. { Initialized variables }
  168.  
  169.   StartupMode: Word = $FFFF;
  170.  
  171. var
  172.  
  173. { Uninitialized variables }
  174.  
  175.   ScreenMode: Word;
  176.   ScreenWidth: Byte;
  177.   ScreenHeight: Byte;
  178.   HiResScreen: Boolean;
  179.   CheckSnow: Boolean;
  180.   ScreenBuffer: Pointer;
  181.   CursorLines: Word;
  182.  
  183. { Screen manager routines }
  184.  
  185. procedure InitVideo;
  186. procedure DoneVideo;
  187. procedure SetVideoMode(Mode: Word);
  188. procedure ClearScreen;
  189.  
  190. { ******** SYSTEM ERROR HANDLER ******** }
  191.  
  192. type
  193.  
  194. { System error handler function type }
  195.  
  196.   TSysErrorFunc = function(ErrorCode: Integer; Drive: Byte): Integer;
  197.  
  198. { Default system error handler routine }
  199.  
  200. function SystemError(ErrorCode: Integer; Drive: Byte): Integer;
  201.  
  202. const
  203.  
  204. { Initialized variables }
  205.  
  206.   SaveInt09: Pointer = nil;
  207.   SysErrorFunc: TSysErrorFunc = SystemError;
  208.   SysColorAttr: Word = $4E4F;
  209.   SysMonoAttr: Word = $7070;
  210.   CtrlBreakHit: Boolean = False;
  211.   SaveCtrlBreak: Boolean = False;
  212.   SysErrActive: Boolean = False;
  213.   FailSysErrors: Boolean = False;
  214.  
  215. { System error handler routines }
  216.  
  217. procedure InitSysError;
  218. procedure DoneSysError;
  219.  
  220. { ******** UTILITY ROUTINES ******** }
  221.  
  222. { Keyboard support routines }
  223.  
  224. function GetAltChar(KeyCode: Word): Char;
  225. function GetAltCode(Ch: Char): Word;
  226. function GetCtrlChar(KeyCode: Word): Char;
  227. function GetCtrlCode(Ch: Char): Word;
  228. function CtrlToArrow(KeyCode: Word): Word;
  229.  
  230. { String routines }
  231.  
  232. procedure FormatStr(var Result: String; const Format: String; var Params);
  233. procedure PrintStr(const S: String);
  234.  
  235. { Buffer move routines }
  236.  
  237. procedure MoveBuf(var Dest; var Source; Attr: Byte; Count: Word);
  238. procedure MoveChar(var Dest; C: Char; Attr: Byte; Count: Word);
  239. procedure MoveCStr(var Dest; const Str: String; Attrs: Word);
  240. procedure MoveStr(var Dest; const Str: String; Attr: Byte);
  241. function CStrLen(const S: String): Integer;
  242.  
  243. implementation
  244.  
  245. { ******** EVENT MANAGER ******** }
  246.  
  247. const
  248.  
  249. { Event manager constants }
  250.  
  251.   EventQSize = 16;
  252.  
  253. var
  254.  
  255. { Event manager variables }
  256.  
  257.   LastButtons: Byte;
  258.   DownButtons: Byte;
  259.   LastDouble: Boolean;
  260.   LastWhere: TPoint;
  261.   DownWhere: TPoint;
  262.   DownTicks: Word;
  263.   AutoTicks: Word;
  264.   AutoDelay: Word;
  265.   EventCount: Word;
  266.   EventQHead: Word;
  267.   EventQTail: Word;
  268.   EventQueue: array[0..EventQSize - 1] of TEvent;
  269.   EventQLast: record end;
  270.  
  271. var
  272.   ShiftState: Byte absolute $40:$17;
  273.   Ticks: Word absolute $40:$6C;
  274.  
  275. { Detect mouse driver }
  276.  
  277. procedure DetectMouse; near; assembler;
  278. asm
  279.     MOV    AX,3533H
  280.     INT    21H
  281.     MOV    AX,ES
  282.     OR    AX,BX
  283.     JE    @@1
  284.     XOR    AX,AX
  285.     INT    33H
  286.     OR    AX,AX
  287.     JE    @@1
  288.     PUSH    BX
  289.     MOV    AX,4
  290.     XOR    CX,CX
  291.     XOR    DX,DX
  292.     INT    33H
  293.     POP    AX
  294. @@1:    MOV    ButtonCount,AL
  295. end;
  296.  
  297. { Store event in GetMouseEvent and GetKeyEvent }
  298.  
  299. procedure StoreEvent; near; assembler;
  300. asm
  301.     MOV    DI,SP
  302.     LES    DI,SS:[DI+8]
  303.     CLD
  304.     STOSW
  305.     XCHG    AX,BX
  306.     STOSW
  307.     XCHG    AX,CX
  308.     STOSW
  309.     XCHG    AX,DX
  310.     STOSW
  311. end;
  312.  
  313. { Get mouse state }
  314. { Out    BL = Button mask }
  315. {    CX = X coordinate }
  316. {    DX = Y coordinate }
  317. {    DI = Timer ticks }
  318.  
  319. procedure GetMouseState; near; assembler;
  320. asm
  321.     CLI
  322.     CMP    EventCount,0
  323.     JNE    @@1
  324.     MOV    BL,MouseButtons
  325.     MOV    CX,MouseWhere.Word[0]
  326.     MOV    DX,MouseWhere.Word[2]
  327.     MOV    ES,Seg0040
  328.     MOV    DI,ES:Ticks
  329.     JMP    @@3
  330. @@1:    MOV    SI,EventQHead
  331.     CLD
  332.     LODSW
  333.     XCHG    AX,DI
  334.     LODSW
  335.     XCHG    AX,BX
  336.     LODSW
  337.     XCHG    AX,CX
  338.     LODSW
  339.     XCHG    AX,DX
  340.     CMP    SI,OFFSET EventQLast
  341.     JNE    @@2
  342.     MOV    SI,OFFSET EventQueue
  343. @@2:    MOV    EventQHead,SI
  344.     DEC    EventCount
  345. @@3:    STI
  346.     CMP    MouseReverse,0
  347.     JE    @@4
  348.     MOV    BH,BL
  349.     AND    BH,3
  350.     JE    @@4
  351.     CMP    BH,3
  352.     JE    @@4
  353.     XOR    BL,3
  354. @@4:
  355. end;
  356.  
  357. procedure MouseInt; far; assembler;
  358. asm
  359.     MOV    SI,SEG @DATA
  360.     MOV    DS,SI
  361.     MOV    SI,CX
  362.     MOV    CL,3
  363.     SHR    SI,CL
  364.     SHR    DX,CL
  365.     MOV    MouseButtons,BL
  366.     MOV    MouseWhere.X,SI
  367.     MOV    MouseWhere.Y,DX
  368.     TEST    AX,11110B
  369.     JE    @@2
  370.     CMP    EventCount,EventQSize
  371.     JE    @@2
  372.     MOV    ES,Seg0040
  373.     MOV    AX,ES:Ticks
  374.     MOV    DI,EventQTail
  375.     PUSH    DS
  376.     POP    ES
  377.     CLD
  378.     STOSW
  379.     XCHG    AX,BX
  380.     STOSW
  381.     XCHG    AX,SI
  382.     STOSW
  383.     XCHG    AX,DX
  384.     STOSW
  385.     CMP    DI,OFFSET EventQLast
  386.     JNE    @@1
  387.     MOV    DI,OFFSET EventQueue
  388. @@1:    MOV    EventQTail,DI
  389.     INC    EventCount
  390. @@2:    MOV    MouseIntFlag,1
  391. end;
  392.  
  393. procedure InitEvents; assembler;
  394. asm
  395.     XOR    AX,AX
  396.     CMP    AL,ButtonCount
  397.     JE    @@1
  398.     MOV    DownButtons,AL
  399.     MOV    LastDouble,AL
  400.     MOV    EventCount,AX
  401.     MOV    AX,OFFSET DS:EventQueue
  402.     MOV    EventQHead,AX
  403.     MOV    EventQTail,AX
  404.     MOV    AX,3
  405.     INT    33H
  406.     XCHG    AX,CX
  407.     MOV    CL,3
  408.     SHR    AX,CL
  409.     SHR    DX,CL
  410.     MOV    MouseButtons,BL
  411.     MOV    MouseWhere.X,AX
  412.     MOV    MouseWhere.Y,DX
  413.     MOV    LastButtons,BL
  414.     MOV    LastWhere.X,AX
  415.     MOV    LastWhere.Y,DX
  416.     MOV    AX,12
  417.     MOV    CX,0FFFFH
  418.     MOV    DX,OFFSET CS:MouseInt
  419.     PUSH    CS
  420.     POP    ES
  421.     INT    33H
  422.         MOV     AX,1
  423.         INT     33H
  424.     MOV    MouseEvents,1
  425. @@1:
  426. end;
  427.  
  428. procedure DoneEvents; assembler;
  429. asm
  430.     CMP    ButtonCount,0
  431.     JE    @@1
  432.     CMP    MouseEvents,0
  433.     JE    @@1
  434.     MOV    MouseEvents,0
  435.         MOV     AX,2
  436.         INT     33H
  437.     MOV    AX,12
  438.     XOR    CX,CX
  439.     MOV    DX,CX
  440.     MOV    ES,CX
  441.     INT    33H
  442. @@1:
  443. end;
  444.  
  445. procedure ShowMouse; assembler;
  446. asm
  447.     CMP    ButtonCount,0
  448.     JE    @@1
  449.     PUSH    AX
  450.     MOV    AX,1
  451.     INT    33H
  452.     POP    AX
  453. @@1:
  454. end;
  455.  
  456. procedure HideMouse; assembler;
  457. asm
  458.     CMP    ButtonCount,0
  459.     JE    @@1
  460.     PUSH    AX
  461.     MOV    AX,2
  462.     INT    33H
  463.     POP    AX
  464. @@1:
  465. end;
  466.  
  467. procedure GetMouseEvent(var Event: TEvent); assembler;
  468. asm
  469.     CMP    MouseEvents,0
  470.     JE    @@2
  471.     CALL    GetMouseState
  472.     MOV    BH,LastDouble
  473.     MOV    AL,LastButtons
  474.     CMP    AL,BL
  475.     JE    @@1
  476.     OR    AL,AL
  477.     JE    @@3
  478.     OR    BL,BL
  479.     JE    @@5
  480.     MOV    BL,AL
  481. @@1:    CMP    CX,LastWhere.X
  482.     JNE    @@6
  483.     CMP    DX,LastWhere.Y
  484.     JNE    @@6
  485.     OR    BL,BL
  486.     JE    @@2
  487.     MOV    AX,DI
  488.     SUB    AX,AutoTicks
  489.     CMP    AX,AutoDelay
  490.     JAE    @@7
  491. @@2:    XOR    AX,AX
  492.     MOV    BX,AX
  493.     MOV    CX,AX
  494.     MOV    DX,AX
  495.     JMP    @@9
  496. @@3:    MOV    BH,0
  497.     CMP    BL,DownButtons
  498.     JNE    @@4
  499.     CMP    CX,DownWhere.X
  500.     JNE    @@4
  501.     CMP    DX,DownWhere.Y
  502.     JNE    @@4
  503.     MOV    AX,DI
  504.     SUB    AX,DownTicks
  505.     CMP    AX,DoubleDelay
  506.     JAE    @@4
  507.     MOV    BH,1
  508. @@4:    MOV    DownButtons,BL
  509.     MOV    DownWhere.X,CX
  510.     MOV    DownWhere.Y,DX
  511.     MOV    DownTicks,DI
  512.     MOV    AutoTicks,DI
  513.     MOV    AX,RepeatDelay
  514.     MOV    AutoDelay,AX
  515.     MOV    AX,evMouseDown
  516.     JMP    @@8
  517. @@5:    MOV    AX,evMouseUp
  518.     JMP    @@8
  519. @@6:    MOV    AX,evMouseMove
  520.     JMP    @@8
  521. @@7:    MOV    AutoTicks,DI
  522.     MOV    AutoDelay,1
  523.     MOV    AX,evMouseAuto
  524. @@8:    MOV    LastButtons,BL
  525.     MOV    LastDouble,BH
  526.     MOV    LastWhere.X,CX
  527.     MOV    LastWhere.Y,DX
  528. @@9:    CALL    StoreEvent
  529. end;
  530.  
  531. procedure GetKeyEvent(var Event: TEvent); assembler;
  532. asm
  533.     MOV    AH,1
  534.     INT    16H
  535.     MOV    AX,0
  536.     MOV    BX,AX
  537.     JE    @@1
  538.     MOV    AH,0
  539.     INT    16H
  540.     XCHG    AX,BX
  541.     MOV    AX,evKeyDown
  542. @@1:    XOR    CX,CX
  543.     MOV    DX,CX
  544.     CALL    StoreEvent
  545. end;
  546.  
  547. function GetShiftState: Byte; assembler;
  548. asm
  549.     MOV    ES,Seg0040
  550.     MOV    AL,ES:ShiftState
  551. end;
  552.  
  553. { ******** SCREEN MANAGER ******** }
  554.  
  555. var
  556.   Equipment: Word absolute $40:$10;
  557.   CrtRows: Byte absolute $40:$84;
  558.   CrtInfo: Byte absolute $40:$87;
  559.  
  560. { Save registers and call video interrupt }
  561.  
  562. procedure VideoInt; near; assembler;
  563. asm
  564.     PUSH    BP
  565.     PUSH    ES
  566.     INT    10H
  567.     POP    ES
  568.     POP    BP
  569. end;
  570.  
  571. { Return CRT mode in AX and dimensions in DX }
  572.  
  573. procedure GetCrtMode; near; assembler;
  574. asm
  575.     MOV    AH,0FH
  576.     CALL    VideoInt
  577.     PUSH    AX
  578.     MOV    AX,1130H
  579.     MOV    BH,0
  580.     MOV    DL,0
  581.     CALL    VideoInt
  582.     POP    AX
  583.     MOV    DH,AH
  584.     CMP    DL,25
  585.     SBB    AH,AH
  586.     INC    AH
  587. end;
  588.  
  589. { Set CRT mode to value in AX }
  590.  
  591. procedure SetCrtMode; near; assembler;
  592. asm
  593.     MOV    ES,Seg0040
  594.     MOV    BL,20H
  595.     CMP    AL,smMono
  596.     JNE    @@1
  597.     MOV    BL,30H
  598. @@1:    AND    ES:Equipment.Byte,0CFH
  599.     OR    ES:Equipment.Byte,BL
  600.     AND    ES:CrtInfo,0FEH
  601.     PUSH    AX
  602.     MOV    AH,0
  603.     CALL    VideoInt
  604.     POP    AX
  605.     OR    AH,AH
  606.     JE    @@2
  607.     MOV    AX,1112H
  608.     MOV    BL,0
  609.     CALL    VideoInt
  610.     MOV    AX,1130H
  611.     MOV    BH,0
  612.     MOV    DL,0
  613.     CALL    VideoInt
  614.     CMP    DL,42
  615.     JNE    @@2
  616.     OR    ES:CrtInfo,1
  617.     MOV    AH,1
  618.     MOV    CX,600H
  619.     CALL    VideoInt
  620.     MOV    AH,12H
  621.     MOV    BL,20H
  622.     CALL    VideoInt
  623. @@2:
  624. end;
  625.  
  626. { Fix CRT mode in AX if required }
  627.  
  628. procedure FixCrtMode; near; assembler;
  629. asm
  630.     CMP    AL,smMono
  631.     JE    @@1
  632.     CMP    AL,smCO80
  633.     JE    @@1
  634.     CMP    AL,smBW80
  635.     JE    @@1
  636.     MOV    AX,smCO80
  637. @@1:
  638. end;
  639.  
  640. { Set CRT data areas and mouse range }
  641.  
  642. procedure SetCrtData; near; assembler;
  643. asm
  644.     CALL    GetCrtMode
  645.     MOV    CL,1
  646.     OR    DL,DL
  647.     JNE    @@1
  648.     MOV    CL,0
  649.     MOV    DL,24
  650. @@1:    INC    DL
  651.     MOV    ScreenMode,AX
  652.     MOV    ScreenWidth,DH
  653.     MOV    ScreenHeight,DL
  654.     MOV    HiResScreen,CL
  655.     XOR    CL,1
  656.     MOV    BX,SegB800
  657.     CMP    AL,smMono
  658.     JNE    @@2
  659.     MOV    CL,0
  660.     MOV    BX,SegB000
  661. @@2:    MOV    CheckSnow,CL
  662.     XOR    AX,AX
  663.     MOV    ScreenBuffer.Word[0],AX
  664.     MOV    ScreenBuffer.Word[2],BX
  665.     MOV    AH,3
  666.     MOV    BH,0
  667.     CALL    VideoInt
  668.     MOV    CursorLines,CX
  669.     MOV    AH,1
  670.     MOV    CX,2000H
  671.     CALL    VideoInt
  672.     CMP    ButtonCount,0
  673.     JE    @@4
  674.     MOV    AX,7
  675.     MOV    DL,ScreenWidth
  676.     CALL    @@3
  677.     MOV    AX,8
  678.     MOV    DL,ScreenHeight
  679. @@3:    XOR    DH,DH
  680.     MOV    CL,3
  681.     SHL    DX,CL
  682.     DEC    DX
  683.     XOR    CX,CX
  684.     INT    33H
  685. @@4:
  686. end;
  687.  
  688. { Detect video modes }
  689.  
  690. procedure DetectVideo; assembler;
  691. asm
  692.     CALL    GetCrtMode
  693.     CALL    FixCrtMode
  694.     MOV    ScreenMode,AX
  695. end;
  696.  
  697. procedure InitVideo; assembler;
  698. asm
  699.     CALL    GetCrtMode
  700.     MOV    StartupMode,AX
  701.     CMP    AX,ScreenMode
  702.     JE    @@1
  703.     MOV    AX,ScreenMode
  704.     CALL    SetCrtMode
  705. @@1:    CALL    SetCrtData
  706. end;
  707.  
  708. procedure DoneVideo; assembler;
  709. asm
  710.     MOV    AX,StartupMode
  711.     CMP    AX,0FFFFH
  712.     JE    @@2
  713.     CMP    AX,ScreenMode
  714.     JE    @@1
  715.     CALL    SetCrtMode
  716.     JMP    @@2
  717. @@1:    CALL    ClearScreen
  718.     MOV    AH,1
  719.     MOV    CX,CursorLines
  720.     CALL    VideoInt
  721. @@2:
  722. end;
  723.  
  724. procedure SetVideoMode(Mode: Word); assembler;
  725. asm
  726.     MOV    AX,Mode
  727.     CALL    FixCrtMode
  728.     CALL    SetCrtMode
  729.     CALL    SetCrtData
  730. end;
  731.  
  732. procedure ClearScreen; assembler;
  733. asm
  734.     MOV    AX,600H
  735.     MOV    BH,07H
  736.     XOR    CX,CX
  737.     MOV    DL,ScreenWidth
  738.     DEC    DL
  739.     MOV    DH,ScreenHeight
  740.     DEC    DH
  741.     CALL    VideoInt
  742.     MOV    AH,2
  743.     MOV    BH,0
  744.     XOR    DX,DX
  745.     CALL    VideoInt
  746. end;
  747.  
  748. { ******** SYSTEM ERROR HANDLER ******** }
  749.  
  750. {$IFDEF DPMI}
  751. {$L SYSINT.OBP}
  752. {$ELSE}
  753. {$L SYSINT.OBJ}
  754. {$ENDIF}
  755.  
  756. const
  757.  
  758. { System error messages }
  759.  
  760.   SCriticalError:  string[31] = 'Critical disk error on drive %c';
  761.   SWriteProtected: string[35] = 'Disk is write-protected in drive %c';
  762.   SDiskNotReady:   string[29] = 'Disk is not ready in drive %c';
  763.   SDataIntegrity:  string[32] = 'Data integrity error on drive %c';
  764.   SSeekError:      string[22] = 'Seek error on drive %c';
  765.   SUnknownMedia:   string[30] = 'Unknown media type in drive %c';
  766.   SSectorNotFound: string[28] = 'Sector not found on drive %c';
  767.   SOutOfPaper:     string[20] = 'Printer out of paper';
  768.   SWriteFault:     string[23] = 'Write fault on drive %c';
  769.   SReadFault:      string[22] = 'Read fault on drive %c';
  770.   SGeneralFailure: string[28] = 'Hardware failure on drive %c';
  771.   SBadImageOfFAT:  string[32] = 'Bad memory image of FAT detected';
  772.   SDeviceError:    string[19] = 'Device access error';
  773.   SInsertDisk:     string[27] = 'Insert diskette in drive %c';
  774.   SRetryOrCancel:  string[27] = '~Enter~ Retry  ~Esc~ Cancel';
  775.  
  776. { Critical error message translation table }
  777.  
  778.   ErrorString: array[0..15] of Word = (
  779.     Ofs(SWriteProtected),
  780.     Ofs(SCriticalError),
  781.     Ofs(SDiskNotReady),
  782.     Ofs(SCriticalError),
  783.     Ofs(SDataIntegrity),
  784.     Ofs(SCriticalError),
  785.     Ofs(SSeekError),
  786.     Ofs(SUnknownMedia),
  787.     Ofs(SSectorNotFound),
  788.     Ofs(SOutOfPaper),
  789.     Ofs(SWriteFault),
  790.     Ofs(SReadFault),
  791.     Ofs(SGeneralFailure),
  792.     Ofs(SBadImageOfFAT),
  793.     Ofs(SDeviceError),
  794.     Ofs(SInsertDisk));
  795.  
  796. { System error handler routines }
  797.  
  798. procedure InitSysError; external;
  799. procedure DoneSysError; external;
  800.  
  801. procedure SwapStatusLine(var Buffer); near; assembler;
  802. asm
  803.     MOV    CL,ScreenWidth
  804.     XOR    CH,CH
  805.     MOV    AL,ScreenHeight
  806.     DEC    AL
  807.     MUL    CL
  808.     SHL    AX,1
  809.     LES    DI,ScreenBuffer
  810.     ADD    DI,AX
  811.     PUSH    DS
  812.     LDS    SI,Buffer
  813. @@1:    MOV    AX,ES:[DI]
  814.     MOVSW
  815.     MOV    DS:[SI-2],AX
  816.     LOOP    @@1
  817.     POP    DS
  818. end;
  819.  
  820. function SelectKey: Integer; near; assembler;
  821. asm
  822.     MOV    AH,3
  823.     MOV    BH,0
  824.     CALL    VideoInt
  825.     PUSH    CX
  826.     MOV    AH,1
  827.     MOV    CX,2000H
  828.     CALL    VideoInt
  829. @@1:    MOV    AH,1
  830.     INT    16H
  831.     PUSHF
  832.     MOV    AH,0
  833.     INT    16H
  834.     POPF
  835.     JNE    @@1
  836.     XOR    DX,DX
  837.     CMP    AL,13
  838.     JE    @@2
  839.     INC    DX
  840.     CMP    AL,27
  841.     JNE    @@1
  842. @@2:    POP    CX
  843.     PUSH    DX
  844.     MOV    AH,1
  845.     CALL    VideoInt
  846.     POP    AX
  847. end;
  848.  
  849. {$V-}
  850.  
  851. function SystemError(ErrorCode: Integer; Drive: Byte): Integer;
  852. var
  853.   C: Word;
  854.   P: Pointer;
  855.   S: string[63];
  856.   B: array[0..79] of Word;
  857. begin
  858.   if FailSysErrors then
  859.   begin
  860.     SystemError := 1;
  861.     Exit;
  862.   end;
  863.  
  864.   if Lo(ScreenMode) = smMono then
  865.     C := SysMonoAttr else
  866.     C := SysColorAttr;
  867.   P := Pointer(Drive + Ord('A'));
  868.   FormatStr(S, PString(Ptr(DSeg, ErrorString[ErrorCode]))^, P);
  869.   MoveChar(B, ' ', Byte(C), 80);
  870.   MoveCStr(B[1], S, C);
  871.   MoveCStr(B[79 - CStrLen(SRetryOrCancel)], SRetryOrCancel, C);
  872.   SwapStatusLine(B);
  873.   SystemError := SelectKey;
  874.   SwapStatusLine(B);
  875. end;
  876.  
  877. {$V+}
  878.  
  879. { ******** UTILITY ROUTINES ******** }
  880.  
  881. { Keyboard support routines }
  882.  
  883. const
  884.  
  885.   AltCodes1: array[$10..$32] of Char =
  886.     'QWERTYUIOP'#0#0#0#0'ASDFGHJKL'#0#0#0#0#0'ZXCVBNM';
  887.  
  888.   AltCodes2: array[$78..$83] of Char =
  889.     '1234567890-=';
  890.  
  891. function GetAltChar(KeyCode: Word): Char;
  892. begin
  893.   GetAltChar := #0;
  894.   if Lo(KeyCode) = 0 then
  895.     case Hi(KeyCode) of
  896.       $02: GetAltChar := #240;
  897.       $10..$32: GetAltChar := AltCodes1[Hi(KeyCode)];
  898.       $78..$83: GetAltChar := AltCodes2[Hi(KeyCode)];
  899.     end;
  900. end;
  901.  
  902. function GetAltCode(Ch: Char): Word;
  903. var
  904.   I: Word;
  905. begin
  906.   GetAltCode := 0;
  907.   if Ch = #0 then Exit;
  908.   Ch := UpCase(Ch);
  909.   if Ch = #240 then
  910.   begin
  911.     GetAltCode := $0200;
  912.     Exit;
  913.   end;
  914.   for I := $10 to $32 do
  915.     if AltCodes1[I] = Ch then
  916.     begin
  917.       GetAltCode := I shl 8;
  918.       Exit;
  919.     end;
  920.   for I := $78 to $83 do
  921.     if AltCodes2[I] = Ch then
  922.     begin
  923.       GetAltCode := I shl 8;
  924.       Exit;
  925.     end;
  926. end;
  927.  
  928. function GetCtrlChar(KeyCode: Word): Char;
  929. begin
  930.   GetCtrlChar := #0;
  931.   if (Lo(KeyCode) <> 0) and (Lo(KeyCode) <= Byte('Z') - Byte('A') + 1) then
  932.     GetCtrlChar := Char(Lo(KeyCode) + Byte('A') - 1);
  933. end;
  934.  
  935. function GetCtrlCode(Ch: Char): Word;
  936. begin
  937.   GetCtrlCode := GetAltCode(Ch) or (Byte(UpCase(Ch)) - Byte('A') + 1);
  938. end;
  939.  
  940. function CtrlToArrow(KeyCode: Word): Word;
  941. const
  942.   NumCodes = 11;
  943.   CtrlCodes: array[0..NumCodes-1] of Char = ^S^D^E^X^A^F^G^V^R^C^H;
  944.   ArrowCodes: array[0..NumCodes-1] of Word =
  945.     (kbLeft, kbRight, kbUp, kbDown, kbHome, kbEnd, kbDel, kbIns,
  946.      kbPgUp, kbPgDn, kbBack);
  947. var
  948.   I: Integer;
  949. begin
  950.   CtrlToArrow := KeyCode;
  951.   for I := 0 to NumCodes - 1 do
  952.     if WordRec(KeyCode).Lo = Byte(CtrlCodes[I]) then
  953.     begin
  954.       CtrlToArrow := ArrowCodes[I];
  955.       Exit;
  956.     end;
  957. end;
  958.  
  959. { String formatting routines }
  960.  
  961. {$L FORMAT.OBJ}
  962.  
  963. procedure FormatStr(var Result: String; const Format: String; var Params);
  964. external {FORMAT};
  965.  
  966. procedure PrintStr(const S: String); assembler;
  967. asm
  968.     PUSH    DS
  969.         LDS    SI,S
  970.     CLD
  971.     LODSB
  972.     XOR    AH,AH
  973.         XCHG    AX,CX
  974.         MOV    AH,40H
  975.         MOV    BX,1
  976.         MOV    DX,SI
  977.         INT    21H
  978.         POP    DS
  979. end;
  980.  
  981. { Buffer move routines }
  982.  
  983. procedure MoveBuf(var Dest; var Source; Attr: Byte; Count: Word); assembler;
  984. asm
  985.     MOV    CX,Count
  986.     JCXZ    @@5
  987.     MOV    DX,DS
  988.     LES    DI,Dest
  989.     LDS    SI,Source
  990.     MOV    AH,Attr
  991.     CLD
  992.     OR    AH,AH
  993.     JE    @@3
  994. @@1:    LODSB
  995.     STOSW
  996.     LOOP    @@1
  997.     JMP    @@4
  998. @@2:    INC    DI
  999. @@3:    MOVSB
  1000.     LOOP    @@2
  1001. @@4:    MOV    DS,DX
  1002. @@5:
  1003. end;
  1004.  
  1005. procedure MoveChar(var Dest; C: Char; Attr: Byte; Count: Word); assembler;
  1006. asm
  1007.     MOV    CX,Count
  1008.     JCXZ    @@4
  1009.     LES    DI,Dest
  1010.     MOV    AL,C
  1011.     MOV    AH,Attr
  1012.     CLD
  1013.     OR    AL,AL
  1014.     JE    @@1
  1015.     OR    AH,AH
  1016.     JE    @@3
  1017.     REP    STOSW
  1018.     JMP    @@4
  1019. @@1:    MOV    AL,AH
  1020. @@2:    INC    DI
  1021. @@3:    STOSB
  1022.     LOOP    @@2
  1023. @@4:
  1024. end;
  1025.  
  1026. procedure MoveCStr(var Dest; const Str: String; Attrs: Word); assembler;
  1027. asm
  1028.     MOV    DX,DS
  1029.     LDS    SI,Str
  1030.     CLD
  1031.     LODSB
  1032.     MOV    CL,AL
  1033.     XOR    CH,CH
  1034.     JCXZ    @@3
  1035.     LES    DI,Dest
  1036.     MOV    BX,Attrs
  1037.     MOV    AH,BL
  1038. @@1:    LODSB
  1039.     CMP    AL,'~'
  1040.     JE    @@2
  1041.     STOSW
  1042.     LOOP    @@1
  1043.     JMP    @@3
  1044. @@2:    XCHG    AH,BH
  1045.     LOOP    @@1
  1046. @@3:    MOV    DS,DX
  1047. end;
  1048.  
  1049. procedure MoveStr(var Dest; const Str: String; Attr: Byte); assembler;
  1050. asm
  1051.     MOV    DX,DS
  1052.     LDS    SI,Str
  1053.     CLD
  1054.     LODSB
  1055.     MOV    CL,AL
  1056.     XOR    CH,CH
  1057.     JCXZ    @@4
  1058.     LES    DI,Dest
  1059.     MOV    AH,Attr
  1060.     OR    AH,AH
  1061.     JE    @@3
  1062. @@1:    LODSB
  1063.     STOSW
  1064.     LOOP    @@1
  1065.     JMP    @@4
  1066. @@2:    INC    DI
  1067. @@3:    MOVSB
  1068.     LOOP    @@2
  1069. @@4:    MOV    DS,DX
  1070. end;
  1071.  
  1072. function CStrLen(const S: String): Integer; assembler;
  1073. asm
  1074.     LES    DI,S
  1075.     MOV    CL,ES:[DI]
  1076.     INC    DI
  1077.     XOR    CH,CH
  1078.     MOV    BX,CX
  1079.         JCXZ    @@2
  1080.     MOV    AL,'~'
  1081.         CLD
  1082. @@1:    REPNE    SCASB
  1083.     JNE    @@2
  1084.     DEC    BX
  1085.     JMP    @@1
  1086. @@2:    MOV    AX,BX
  1087. end;
  1088.  
  1089. { Drivers unit initialization and shutdown }
  1090.  
  1091. var
  1092.   SaveExit: Pointer;
  1093.  
  1094. procedure ExitDrivers; far;
  1095. begin
  1096.   DoneSysError;
  1097.   DoneEvents;
  1098.   ExitProc := SaveExit;
  1099. end;
  1100.  
  1101. begin
  1102.   DetectMouse;
  1103.   DetectVideo;
  1104.   SaveExit := ExitProc;
  1105.   ExitProc := @ExitDrivers;
  1106. end.
  1107.