home *** CD-ROM | disk | FTP | other *** search
/ BBS 1 / BBS#1.iso / for-dos / newtvsrc.arj / DRIVERS.PAS < prev    next >
Pascal/Delphi Source File  |  1994-04-04  |  25KB  |  1,242 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 7.0                        }
  5. {       Turbo Vision Unit                               }
  6. {                                                       }
  7. {       Copyright (c) 1992 Borland International        }
  8. {       Copyright (c) 1993 ACD Group                    }
  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.   MPointerState: Word = 0;
  215.  
  216. { System error handler routines }
  217.  
  218. procedure InitSysError;
  219. procedure DoneSysError;
  220.  
  221. { ******** UTILITY ROUTINES ******** }
  222.  
  223. { Keyboard support routines }
  224.  
  225. function GetAltChar(KeyCode: Word): Char;
  226. function GetAltCode(Ch: Char): Word;
  227. function GetCtrlChar(KeyCode: Word): Char;
  228. function GetCtrlCode(Ch: Char): Word;
  229. function CtrlToArrow(KeyCode: Word): Word;
  230.  
  231. { String routines }
  232.  
  233. procedure FormatStr(var Result: String; const Format: String; var Params);
  234. procedure PrintStr(const S: String);
  235.  
  236. { Buffer move routines }
  237.  
  238. procedure MoveBuf(var Dest; var Source; Attr: Byte; Count: Word);
  239. procedure MoveChar(var Dest; C: Char; Attr: Byte; Count: Word);
  240. procedure MoveCStr(var Dest; const Str: String; Attrs: Word);
  241. procedure MoveStr(var Dest; const Str: String; Attr: Byte);
  242. function CStrLen(const S: String): Integer;
  243.  
  244. implementation
  245.  
  246. uses
  247.   Font;
  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. var
  276.   ShiftState: Byte absolute $40:$17;
  277.   Ticks: Word absolute $40:$6C;
  278.  
  279. const
  280.   TextMX: Integer = 0;
  281.   TextMY: Integer = 0;
  282.   OTextMX: Integer = 0;
  283.   OTextMY: Integer = 0;
  284.  
  285. procedure MShow; far; external;
  286. procedure MHide; far; external;
  287. {$L MOUSE}
  288.  
  289. { Detect mouse driver }
  290.  
  291. procedure DetectMouse; near; assembler;
  292. asm
  293.     MOV    AX,3533H
  294.     INT    21H
  295.     MOV    AX,ES
  296.     OR    AX,BX
  297.     JE    @@1
  298.     XOR    AX,AX
  299.     INT    33H
  300.     OR    AX,AX
  301.     JE    @@1
  302.     PUSH    BX
  303.     MOV    AX,4
  304.     XOR    CX,CX
  305.     XOR    DX,DX
  306.     INT    33H
  307.     POP    AX
  308. @@1:    MOV    ButtonCount,AL
  309. end;
  310.  
  311. { Store event in GetMouseEvent and GetKeyEvent }
  312.  
  313. procedure StoreEvent; near; assembler;
  314. asm
  315.     MOV    DI,SP
  316.     LES    DI,SS:[DI+8]
  317.     CLD
  318.     STOSW
  319.     XCHG    AX,BX
  320.     STOSW
  321.     XCHG    AX,CX
  322.     STOSW
  323.     XCHG    AX,DX
  324.     STOSW
  325. end;
  326.  
  327. { Get mouse state }
  328. { Out    BL = Button mask }
  329. {    CX = X coordinate }
  330. {    DX = Y coordinate }
  331. {    DI = Timer ticks }
  332.  
  333. procedure GetMouseState; near; assembler;
  334. asm
  335.     CLI
  336.     CMP    EventCount,0
  337.     JNE    @@1
  338.     MOV    BL,MouseButtons
  339.     MOV    CX,MouseWhere.Word[0]
  340.     MOV    DX,MouseWhere.Word[2]
  341.     MOV    ES,Seg0040
  342.     MOV    DI,ES:Ticks
  343.     JMP    @@3
  344. @@1:    MOV    SI,EventQHead
  345.     CLD
  346.     LODSW
  347.     XCHG    AX,DI
  348.     LODSW
  349.     XCHG    AX,BX
  350.     LODSW
  351.     XCHG    AX,CX
  352.     LODSW
  353.     XCHG    AX,DX
  354.     CMP    SI,OFFSET EventQLast
  355.     JNE    @@2
  356.     MOV    SI,OFFSET EventQueue
  357. @@2:    MOV    EventQHead,SI
  358.     DEC    EventCount
  359. @@3:    STI
  360.     CMP    MouseReverse,0
  361.     JE    @@4
  362.     MOV    BH,BL
  363.     AND    BH,3
  364.     JE    @@4
  365.     CMP    BH,3
  366.     JE    @@4
  367.     XOR    BL,3
  368. @@4:
  369. end;
  370.  
  371. procedure MouseInt; far;
  372. const
  373.   _SI: Integer = 0;
  374.   _DI: Integer = 0;
  375.   _LX: Integer = 0;
  376.   _LY: Integer = 0;
  377.   _CX: Integer = 0;
  378.   _CY: Integer = 0;
  379. var
  380.   _SBX: Word;
  381.   OX, OY: Integer;
  382. label
  383.   L2;
  384. begin
  385.   asm
  386.         PUSH    SI
  387.     MOV    SI,SEG @DATA
  388.     MOV    DS,SI
  389.         POP     SI
  390.         MOV     _SI,SI
  391.         MOV     _DI,DI
  392.     MOV    MouseButtons,BL
  393. {    TEST    AX,11110B
  394.     JE    L2}
  395.     CMP    EventCount,EventQSize
  396.     JE    L2
  397.         MOV     _SBX,BX
  398.   end;
  399.   OX := _SI - _LX;
  400.   OY := _DI - _LY;
  401.   Inc(_CX, OX);
  402.   Inc(_CY, OY);
  403.   _LX := _SI;
  404.   _LY := _DI;
  405.   if _CX < 0 then _CX := 0 else
  406.     if _CX > 637 then _CX := 637;
  407.   if _CY < 0 then _CY := 0 else
  408.     if _CY > 397 then _CY := 397;
  409.   TextMX := _CX div 8;
  410.   OTextMX := _CX mod 8;
  411.   TextMY := _CY div 16;
  412.   OTextMY := _CY mod 16;
  413.   MouseWhere.X := TextMX;
  414.   MouseWhere.Y := TextMY;
  415.   asm
  416.         MOV     BX,_SBX
  417.     MOV    CX,MouseWhere.X
  418.     MOV    DX,MouseWhere.Y
  419.     MOV    ES,Seg0040
  420.     MOV    AX,ES:Ticks
  421.     MOV    DI,EventQTail
  422.     PUSH    DS
  423.     POP    ES
  424.     CLD
  425.     STOSW
  426.     XCHG    AX,BX
  427.     STOSW
  428.     XCHG    AX,CX
  429.     STOSW
  430.     XCHG    AX,DX
  431.     STOSW
  432.     CMP    DI,OFFSET EventQLast
  433.     JNE    @@1
  434.     MOV    DI,OFFSET EventQueue
  435. @@1:    MOV    EventQTail,DI
  436.     INC    EventCount
  437. L2:    MOV    MouseIntFlag,1
  438.  
  439.         MOV     DX,3DAH
  440. @@2:    IN      AL,DX
  441.         TEST    AL,1
  442.         JNZ     @@2
  443. @@3:    IN      AL,DX
  444.         TEST    AL,1
  445.         JZ      @@3
  446.         CALL    MHide
  447.         CALL    MShow
  448.   end;
  449. end;
  450.  
  451. procedure InitEvents; assembler;
  452. asm
  453.         XOR     CX,CX
  454.         XOR     DX,DX
  455.         MOV     AX,4
  456.         INT     33H
  457.     XOR    AX,AX
  458.     CMP    AL,ButtonCount
  459.     JE    @@1
  460.     MOV    DownButtons,AL
  461.     MOV    LastDouble,AL
  462.     MOV    EventCount,AX
  463.     MOV    AX,OFFSET DS:EventQueue
  464.     MOV    EventQHead,AX
  465.     MOV    EventQTail,AX
  466.     MOV    AX,3
  467.     INT    33H
  468.     XCHG    AX,CX
  469.     MOV    CL,3
  470.     SHR    AX,CL
  471.     SHR    DX,CL
  472.     MOV    MouseButtons,BL
  473.     MOV    MouseWhere.X,AX
  474.     MOV    MouseWhere.Y,DX
  475.     MOV    LastButtons,BL
  476.     MOV    LastWhere.X,AX
  477.     MOV    LastWhere.Y,DX
  478.     MOV    AX,12
  479.     MOV    CX,0FFFFH
  480.     MOV    DX,OFFSET CS:MouseInt
  481.     PUSH    CS
  482.     POP    ES
  483.     INT    33H
  484.         CALL    MSHOW
  485.     MOV    MouseEvents,1
  486. @@1:
  487. end;
  488.  
  489. procedure DoneEvents; assembler;
  490. asm
  491.     CMP    ButtonCount,0
  492.     JE    @@1
  493.     CMP    MouseEvents,0
  494.     JE    @@1
  495.     MOV    MouseEvents,0
  496.         CALL    MHIDE
  497.     MOV    AX,12
  498.     XOR    CX,CX
  499.     MOV    DX,CX
  500.     MOV    ES,CX
  501.     INT    33H
  502. @@1:
  503. end;
  504.  
  505. procedure ShowMouse; assembler;
  506. asm
  507.         PUSH    ES
  508.         PUSH    DS
  509.         PUSH    DI
  510.         PUSH    SI
  511.         PUSH    DX
  512.         PUSH    CX
  513.         PUSH    BX
  514.         PUSH    AX
  515.         CALL    MShow
  516.         POP     AX
  517.         POP     BX
  518.         POP     CX
  519.         POP     DX
  520.         POP     SI
  521.         POP     DI
  522.         POP     DS
  523.         POP     ES
  524. end;
  525.  
  526. procedure HideMouse; assembler;
  527. asm
  528.         PUSH    ES
  529.         PUSH    DS
  530.         PUSH    DI
  531.         PUSH    SI
  532.         PUSH    DX
  533.         PUSH    CX
  534.         PUSH    BX
  535.         PUSH    AX
  536.         CALL    MHide
  537.         POP     AX
  538.         POP     BX
  539.         POP     CX
  540.         POP     DX
  541.         POP     SI
  542.         POP     DI
  543.         POP     DS
  544.         POP     ES
  545. end;
  546.  
  547. procedure GetMouseEvent(var Event: TEvent); assembler;
  548. asm
  549.     CMP    MouseEvents,0
  550.     JE    @@2
  551.     CALL    GetMouseState
  552.     MOV    BH,LastDouble
  553.     MOV    AL,LastButtons
  554.     CMP    AL,BL
  555.     JE    @@1
  556.     OR    AL,AL
  557.     JE    @@3
  558.     OR    BL,BL
  559.     JE    @@5
  560.     MOV    BL,AL
  561. @@1:    CMP    CX,LastWhere.X
  562.     JNE    @@6
  563.     CMP    DX,LastWhere.Y
  564.     JNE    @@6
  565.     OR    BL,BL
  566.     JE    @@2
  567.     MOV    AX,DI
  568.     SUB    AX,AutoTicks
  569.     CMP    AX,AutoDelay
  570.     JAE    @@7
  571. @@2:    XOR    AX,AX
  572.     MOV    BX,AX
  573.     MOV    CX,AX
  574.     MOV    DX,AX
  575.     JMP    @@9
  576. @@3:    MOV    BH,0
  577.     CMP    BL,DownButtons
  578.     JNE    @@4
  579.     CMP    CX,DownWhere.X
  580.     JNE    @@4
  581.     CMP    DX,DownWhere.Y
  582.     JNE    @@4
  583.     MOV    AX,DI
  584.     SUB    AX,DownTicks
  585.     CMP    AX,DoubleDelay
  586.     JAE    @@4
  587.     MOV    BH,1
  588. @@4:    MOV    DownButtons,BL
  589.     MOV    DownWhere.X,CX
  590.     MOV    DownWhere.Y,DX
  591.     MOV    DownTicks,DI
  592.     MOV    AutoTicks,DI
  593.     MOV    AX,RepeatDelay
  594.     MOV    AutoDelay,AX
  595.     MOV    AX,evMouseDown
  596.     JMP    @@8
  597. @@5:    MOV    AX,evMouseUp
  598.     JMP    @@8
  599. @@6:    MOV    AX,evMouseMove
  600.     JMP    @@8
  601. @@7:    MOV    AutoTicks,DI
  602.     MOV    AutoDelay,1
  603.     MOV    AX,evMouseAuto
  604. @@8:    MOV    LastButtons,BL
  605.     MOV    LastDouble,BH
  606.     MOV    LastWhere.X,CX
  607.     MOV    LastWhere.Y,DX
  608. @@9:    CALL    StoreEvent
  609. end;
  610.  
  611. procedure GetKeyEvent(var Event: TEvent); assembler;
  612. asm
  613.     MOV    AH,1
  614.     INT    16H
  615.     MOV    AX,0
  616.     MOV    BX,AX
  617.     JE    @@1
  618.     MOV    AH,0
  619.     INT    16H
  620.     XCHG    AX,BX
  621.     MOV    AX,evKeyDown
  622. @@1:    XOR    CX,CX
  623.     MOV    DX,CX
  624.     CALL    StoreEvent
  625. end;
  626.  
  627. function GetShiftState: Byte; assembler;
  628. asm
  629.     MOV    ES,Seg0040
  630.     MOV    AL,ES:ShiftState
  631. end;
  632.  
  633. { ******** SCREEN MANAGER ******** }
  634.  
  635. var
  636.   Equipment: Word absolute $40:$10;
  637.   CrtRows: Byte absolute $40:$84;
  638.   CrtInfo: Byte absolute $40:$87;
  639.  
  640. { Save registers and call video interrupt }
  641.  
  642. procedure VideoInt; near; assembler;
  643. asm
  644.     PUSH    BP
  645.     PUSH    ES
  646.     INT    10H
  647.     POP    ES
  648.     POP    BP
  649. end;
  650.  
  651. { Return CRT mode in AX and dimensions in DX }
  652.  
  653. procedure GetCrtMode; near; assembler;
  654. asm
  655.     MOV    AH,0FH
  656.     CALL    VideoInt
  657.     PUSH    AX
  658.     MOV    AX,1130H
  659.     MOV    BH,0
  660.     MOV    DL,0
  661.     CALL    VideoInt
  662.     POP    AX
  663.     MOV    DH,AH
  664.     CMP    DL,25
  665.     SBB    AH,AH
  666.     INC    AH
  667. end;
  668.  
  669. { Set CRT mode to value in AX }
  670.  
  671. procedure SetCrtMode; near; assembler;
  672. asm
  673.     MOV    ES,Seg0040
  674.     MOV    BL,20H
  675.     CMP    AL,smMono
  676.     JNE    @@1
  677.     MOV    BL,30H
  678. @@1:    AND    ES:Equipment.Byte,0CFH
  679.     OR    ES:Equipment.Byte,BL
  680.     AND    ES:CrtInfo,0FEH
  681.     PUSH    AX
  682.     MOV    AH,0
  683.     CALL    VideoInt
  684.     POP    AX
  685.     OR    AH,AH
  686.     JE    @@2
  687.     MOV    AX,1112H
  688.     MOV    BL,0
  689.     CALL    VideoInt
  690.     MOV    AX,1130H
  691.     MOV    BH,0
  692.     MOV    DL,0
  693.     CALL    VideoInt
  694.     CMP    DL,42
  695.     JNE    @@2
  696.     OR    ES:CrtInfo,1
  697.     MOV    AH,1
  698.     MOV    CX,600H
  699.     CALL    VideoInt
  700.     MOV    AH,12H
  701.     MOV    BL,20H
  702.     CALL    VideoInt
  703. @@2:
  704. end;
  705.  
  706. { Fix CRT mode in AX if required }
  707.  
  708. procedure FixCrtMode; near; assembler;
  709. asm
  710.     CMP    AL,smMono
  711.     JE    @@1
  712.     CMP    AL,smCO80
  713.     JE    @@1
  714.     CMP    AL,smBW80
  715.     JE    @@1
  716.     MOV    AX,smCO80
  717. @@1:
  718. end;
  719.  
  720. { Set CRT data areas and mouse range }
  721.  
  722. procedure SetCrtData; near; assembler;
  723. asm
  724.     CALL    GetCrtMode
  725.     MOV    CL,1
  726.     OR    DL,DL
  727.     JNE    @@1
  728.     MOV    CL,0
  729.     MOV    DL,24
  730. @@1:    INC    DL
  731.     MOV    ScreenMode,AX
  732.     MOV    ScreenWidth,DH
  733.     MOV    ScreenHeight,DL
  734.     MOV    HiResScreen,CL
  735.     XOR    CL,1
  736.     MOV    BX,SegB800
  737.     CMP    AL,smMono
  738.     JNE    @@2
  739.     MOV    CL,0
  740.     MOV    BX,SegB000
  741. @@2:    MOV    CheckSnow,CL
  742.     XOR    AX,AX
  743.     MOV    ScreenBuffer.Word[0],AX
  744.     MOV    ScreenBuffer.Word[2],BX
  745.     MOV    AH,3
  746.     MOV    BH,0
  747.     CALL    VideoInt
  748.     MOV    CursorLines,CX
  749.     MOV    AH,1
  750.     MOV    CX,2000H
  751.     CALL    VideoInt
  752.     CMP    ButtonCount,0
  753.     JE    @@4
  754.     MOV    AX,7
  755.     MOV    DL,ScreenWidth
  756.     CALL    @@3
  757.     MOV    AX,8
  758.     MOV    DL,ScreenHeight
  759. @@3:    XOR    DH,DH
  760.     MOV    CL,3
  761.     SHL    DX,CL
  762.     DEC    DX
  763.     XOR    CX,CX
  764.     INT    33H
  765. @@4:
  766. end;
  767.  
  768. { Detect video modes }
  769.  
  770. procedure DetectVideo; assembler;
  771. asm
  772.     CALL    GetCrtMode
  773.     CALL    FixCrtMode
  774.     MOV    ScreenMode,AX
  775. end;
  776.  
  777. procedure NB; assembler;
  778. asm
  779.       MOV     AX,$1003
  780.       XOR     BL,BL
  781.       INT     $10
  782.       mov     dx,3C4h
  783.       mov     al,1
  784.       out     dx,al
  785.  
  786.       cli
  787.       mov     ax,101h
  788.       out     dx,ax
  789.       inc     dx
  790.       in      al,dx
  791.       dec     dx
  792.       or      al,1
  793.       mov     ah,al
  794.       mov     al,1
  795.       out     dx,ax
  796.  
  797.       mov     dl,0CCh
  798.       in      al,dx
  799.       and     al,0F3h
  800.       mov     dl,0C2h
  801.       out     dx,al
  802.       mov     dl,0DAh
  803.       in      al,dx
  804.  
  805.       mov     dl,0C0h
  806.       mov     al,13h
  807.       out     dx,al
  808.  
  809.       xor     al,al
  810.       out     dx,al
  811.       mov     dl,0DAh
  812.       in      al,dx
  813.       mov     dl,0C0h
  814.       mov     al,20h
  815.       out     dx,al
  816.       mov     dl,0C4h
  817.       mov     ax,300h
  818.       out     dx,ax
  819.  
  820.       sti
  821. end;
  822.  
  823. procedure InitVideo; assembler;
  824. asm
  825.     CALL    GetCrtMode
  826.     MOV    StartupMode,AX
  827.     CMP    AX,ScreenMode
  828.     JE    @@1
  829.     MOV    AX,ScreenMode
  830.     CALL    SetCrtMode
  831. @@1:    CALL    SetCrtData
  832. {        CALL    HideMouse}
  833.         CALL    NB
  834.         CALL    LoadFont
  835. {        CALL    ShowMouse}
  836. end;
  837.  
  838. procedure DoneVideo; assembler;
  839. asm
  840.     MOV    AX,StartupMode
  841.     CMP    AX,0FFFFH
  842.     JE    @@2
  843. {
  844.     CMP    AX,ScreenMode
  845.     JE    @@1
  846. }
  847.     CALL    SetCrtMode
  848. {
  849.     JMP    @@2
  850. @@1:    CALL    ClearScreen
  851.     MOV    AH,1
  852.     MOV    CX,CursorLines
  853.     CALL    VideoInt
  854. }
  855. @@2:
  856. end;
  857.  
  858. procedure SetVideoMode(Mode: Word); assembler;
  859. asm
  860.     MOV    AX,Mode
  861.     CALL    FixCrtMode
  862.     CALL    SetCrtMode
  863.     CALL    SetCrtData
  864. end;
  865.  
  866. procedure ClearScreen; assembler;
  867. asm
  868.     MOV    AX,600H
  869.     MOV    BH,07H
  870.     XOR    CX,CX
  871.     MOV    DL,ScreenWidth
  872.     DEC    DL
  873.     MOV    DH,ScreenHeight
  874.     DEC    DH
  875.     CALL    VideoInt
  876.     MOV    AH,2
  877.     MOV    BH,0
  878.     XOR    DX,DX
  879.     CALL    VideoInt
  880. end;
  881.  
  882. { ******** SYSTEM ERROR HANDLER ******** }
  883.  
  884. {$IFDEF DPMI}
  885. {$L SYSINT.OBP}
  886. {$ELSE}
  887. {$L SYSINT.OBJ}
  888. {$ENDIF}
  889.  
  890. const
  891.  
  892. { System error messages }
  893.  
  894.   SCriticalError:  string[35] = 'èα¿Γ¿τÑ߬á∩ «Φ¿í¬á ¡á πßΓα«⌐ßΓóÑ %c'; {31 Critical disk error on drive %c}
  895.   SWriteProtected: string[38] = 'ä¿ß¬ ºáΘ¿ΘÑ¡ «Γ ºá»¿ß¿ ó πßΓα«⌐ßΓóÑ %c'; {35 Disk is write-protected in drive %c}
  896.   SDiskNotReady:   string[29] = 'ä¿ß¬ ¡Ñ ú«Γ«ó ó πßΓα«⌐ßΓóÑ %c'; {29 Disk is not ready in drive %c}
  897.   SDataIntegrity:  string[42] = 'ÄΦ¿í¬á µÑ½«ßΓ¡«ßΓ¿ ñá¡¡δσ ¡á πßΓα«⌐ßΓóÑ %c'; {32 Data integrity error on drive %c}
  898.   SSeekError:      string[30] = 'ÄΦ¿í¬á »«¿ß¬á ¡á πßΓα«⌐ßΓóÑ %c'; {22 Seek error on drive %c}
  899.   SUnknownMedia:   string[39] = 'ìÑ¿ºóÑßΓ¡δ⌐ Γ¿» ¡«ß¿Γѽ∩ ó πßΓα«⌐ßΓóÑ %c'; {30 Unknown media type in drive %c}
  900.   SSectorNotFound: string[33] = 'æÑ¬Γ«α ¡Ñ ¡á⌐ñÑ¡ ¡á πßΓα«⌐ßΓóÑ %c'; {28 Sector not found on drive %c}
  901.   SOutOfPaper:     string[21] = 'ìÑΓ íπ¼áú¿ ó »α¿¡ΓÑαÑ'; {20 Printer out of paper}
  902.   SWriteFault:     string[30] = 'ÄΦ¿í¬á ºá»¿ß¿ ¡á πßΓα«⌐ßΓóÑ %c'; {23 Write fault on drive %c}
  903.   SReadFault:      string[30] = 'ÄΦ¿í¬á τΓÑ¡¿∩ ¡á πßΓα«⌐ßΓóÑ %c'; {22 Read fault on drive %c}
  904.   SGeneralFailure: string[31] = 'Ç»»áαáΓ¡á∩ «Φ¿í¬á πßΓα«⌐ßΓóá %c'; {28 Hardware failure on drive %c}
  905.   SBadImageOfFAT:  string[25] = 'Ž«σá∩ ¬«»¿∩ FAT ó »á¼∩Γ¿'; {32 Bad memory image of FAT detected}
  906.   SDeviceError:    string[27] = 'ÄΦ¿í¬á ñ«ßΓπ»á ¬ πßΓα«⌐ßΓóπ'; {19 Device access error}
  907.   SInsertDisk:     string[29] = 'éßΓáó∞ΓÑ ñ¿ß¬ ó πßΓα«⌐ßΓó« %c'; {27 Insert diskette in drive %c}
  908.   SRetryOrCancel:  string[32] = '~Enter~ Å«óΓ«α¿Γ∞  ~Esc~ ÄΓ¼Ñ¡¿Γ∞'; {27 ~Enter~ Retry  ~Esc~ Cancel}
  909.  
  910. { Critical error message translation table }
  911.  
  912.   ErrorString: array[0..15] of Word = (
  913.     Ofs(SWriteProtected),
  914.     Ofs(SCriticalError),
  915.     Ofs(SDiskNotReady),
  916.     Ofs(SCriticalError),
  917.     Ofs(SDataIntegrity),
  918.     Ofs(SCriticalError),
  919.     Ofs(SSeekError),
  920.     Ofs(SUnknownMedia),
  921.     Ofs(SSectorNotFound),
  922.     Ofs(SOutOfPaper),
  923.     Ofs(SWriteFault),
  924.     Ofs(SReadFault),
  925.     Ofs(SGeneralFailure),
  926.     Ofs(SBadImageOfFAT),
  927.     Ofs(SDeviceError),
  928.     Ofs(SInsertDisk));
  929.  
  930. { System error handler routines }
  931.  
  932. procedure InitSysError; external;
  933. procedure DoneSysError; external;
  934.  
  935. procedure SwapStatusLine(var Buffer); near; assembler;
  936. asm
  937.     MOV    CL,ScreenWidth
  938.     XOR    CH,CH
  939.     MOV    AL,ScreenHeight
  940.     DEC    AL
  941.     MUL    CL
  942.     SHL    AX,1
  943.     LES    DI,ScreenBuffer
  944.     ADD    DI,AX
  945.     PUSH    DS
  946.     LDS    SI,Buffer
  947. @@1:    MOV    AX,ES:[DI]
  948.     MOVSW
  949.     MOV    DS:[SI-2],AX
  950.     LOOP    @@1
  951.     POP    DS
  952. end;
  953.  
  954. function SelectKey: Integer; near; assembler;
  955. asm
  956.     MOV    AH,3
  957.     MOV    BH,0
  958.     CALL    VideoInt
  959.     PUSH    CX
  960.     MOV    AH,1
  961.     MOV    CX,2000H
  962.     CALL    VideoInt
  963. @@1:    MOV    AH,1
  964.     INT    16H
  965.     PUSHF
  966.     MOV    AH,0
  967.     INT    16H
  968.     POPF
  969.     JNE    @@1
  970.     XOR    DX,DX
  971.     CMP    AL,13
  972.     JE    @@2
  973.     INC    DX
  974.     CMP    AL,27
  975.     JNE    @@1
  976. @@2:    POP    CX
  977.     PUSH    DX
  978.     MOV    AH,1
  979.     CALL    VideoInt
  980.     POP    AX
  981. end;
  982.  
  983. {$V-}
  984.  
  985. function SystemError(ErrorCode: Integer; Drive: Byte): Integer;
  986. var
  987.   C: Word;
  988.   P: Pointer;
  989.   S: string[63];
  990.   B: array[0..79] of Word;
  991. begin
  992.   if FailSysErrors then
  993.   begin
  994.     SystemError := 1;
  995.     Exit;
  996.   end;
  997.  
  998.   if Lo(ScreenMode) = smMono then
  999.     C := SysMonoAttr else
  1000.     C := SysColorAttr;
  1001.   P := Pointer(Drive + Ord('A'));
  1002.   FormatStr(S, PString(Ptr(DSeg, ErrorString[ErrorCode]))^, P);
  1003.   MoveChar(B, ' ', Byte(C), 80);
  1004.   MoveCStr(B[1], S, C);
  1005.   MoveCStr(B[79 - CStrLen(SRetryOrCancel)], SRetryOrCancel, C);
  1006.   SwapStatusLine(B);
  1007.   SystemError := SelectKey;
  1008.   SwapStatusLine(B);
  1009. end;
  1010.  
  1011. {$V+}
  1012.  
  1013. { ******** UTILITY ROUTINES ******** }
  1014.  
  1015. { Keyboard support routines }
  1016.  
  1017. const
  1018.  
  1019.   AltCodes1: array[$10..$34] of Char =
  1020.     'ëûôèàìâÿÖçòÜ'#0#0'ö¢éÇÅÉÄïäå¥'#0#0#0'ƒùæîêÆ£ü₧';
  1021. {   'QWERTYUIOP'#0#0#0#0'ASDFGHJKL'#0#0#0#0#0'ZXCVBNM';}
  1022.  
  1023.   AltCodes2: array[$78..$83] of Char =
  1024.     '1234567890-=';
  1025.  
  1026. function GetAltChar(KeyCode: Word): Char;
  1027. begin
  1028.   GetAltChar := #0;
  1029.   if Lo(KeyCode) = 0 then
  1030.     case Hi(KeyCode) of
  1031.       $02: GetAltChar := #240;
  1032.       $10..$34: GetAltChar := AltCodes1[Hi(KeyCode)];
  1033.       $78..$83: GetAltChar := AltCodes2[Hi(KeyCode)];
  1034.     end;
  1035. end;
  1036.  
  1037. function GetAltCode(Ch: Char): Word;
  1038. var
  1039.   I: Word;
  1040. begin
  1041.   GetAltCode := 0;
  1042.   if Ch = #0 then Exit;
  1043.   Ch := UpCase(Ch);
  1044.   if Ch = #240 then
  1045.   begin
  1046.     GetAltCode := $0200;
  1047.     Exit;
  1048.   end;
  1049.   for I := $10 to $34 do
  1050.     if AltCodes1[I] = Ch then
  1051.     begin
  1052.       GetAltCode := I shl 8;
  1053.       Exit;
  1054.     end;
  1055.   for I := $78 to $83 do
  1056.     if AltCodes2[I] = Ch then
  1057.     begin
  1058.       GetAltCode := I shl 8;
  1059.       Exit;
  1060.     end;
  1061. end;
  1062.  
  1063. function GetCtrlChar(KeyCode: Word): Char;
  1064. begin
  1065.   GetCtrlChar := #0;
  1066.   if (Lo(KeyCode) <> 0) and (Lo(KeyCode) <= Byte('Z') - Byte('A') + 1) then
  1067.     GetCtrlChar := Char(Lo(KeyCode) + Byte('A') - 1);
  1068. end;
  1069.  
  1070. function GetCtrlCode(Ch: Char): Word;
  1071. begin
  1072.   GetCtrlCode := GetAltCode(Ch) or (Byte(UpCase(Ch)) - Byte('A') + 1);
  1073. end;
  1074.  
  1075. function CtrlToArrow(KeyCode: Word): Word;
  1076. const
  1077.   NumCodes = 11;
  1078.   CtrlCodes: array[0..NumCodes-1] of Char = ^S^D^E^X^A^F^G^V^R^C^H;
  1079.   ArrowCodes: array[0..NumCodes-1] of Word =
  1080.     (kbLeft, kbRight, kbUp, kbDown, kbHome, kbEnd, kbDel, kbIns,
  1081.      kbPgUp, kbPgDn, kbBack);
  1082. var
  1083.   I: Integer;
  1084. begin
  1085.   CtrlToArrow := KeyCode;
  1086.   for I := 0 to NumCodes - 1 do
  1087.     if WordRec(KeyCode).Lo = Byte(CtrlCodes[I]) then
  1088.     begin
  1089.       CtrlToArrow := ArrowCodes[I];
  1090.       Exit;
  1091.     end;
  1092. end;
  1093.  
  1094. { String formatting routines }
  1095.  
  1096. {$L FORMAT.OBJ}
  1097.  
  1098. procedure FormatStr(var Result: String; const Format: String; var Params);
  1099. external {FORMAT};
  1100.  
  1101. procedure PrintStr(const S: String); assembler;
  1102. asm
  1103.     PUSH    DS
  1104.         LDS    SI,S
  1105.     CLD
  1106.     LODSB
  1107.     XOR    AH,AH
  1108.         XCHG    AX,CX
  1109.         MOV    AH,40H
  1110.         MOV    BX,1
  1111.         MOV    DX,SI
  1112.         INT    21H
  1113.         POP    DS
  1114. end;
  1115.  
  1116. { Buffer move routines }
  1117.  
  1118. procedure MoveBuf(var Dest; var Source; Attr: Byte; Count: Word); assembler;
  1119. asm
  1120.     MOV    CX,Count
  1121.     JCXZ    @@5
  1122.     MOV    DX,DS
  1123.     LES    DI,Dest
  1124.     LDS    SI,Source
  1125.     MOV    AH,Attr
  1126.     CLD
  1127.     OR    AH,AH
  1128.     JE    @@3
  1129. @@1:    LODSB
  1130.     STOSW
  1131.     LOOP    @@1
  1132.     JMP    @@4
  1133. @@2:    INC    DI
  1134. @@3:    MOVSB
  1135.     LOOP    @@2
  1136. @@4:    MOV    DS,DX
  1137. @@5:
  1138. end;
  1139.  
  1140. procedure MoveChar(var Dest; C: Char; Attr: Byte; Count: Word); assembler;
  1141. asm
  1142.     MOV    CX,Count
  1143.     JCXZ    @@4
  1144.     LES    DI,Dest
  1145.     MOV    AL,C
  1146.     MOV    AH,Attr
  1147.     CLD
  1148.     OR    AL,AL
  1149.     JE    @@1
  1150.     OR    AH,AH
  1151.     JE    @@3
  1152.     REP    STOSW
  1153.     JMP    @@4
  1154. @@1:    MOV    AL,AH
  1155. @@2:    INC    DI
  1156. @@3:    STOSB
  1157.     LOOP    @@2
  1158. @@4:
  1159. end;
  1160.  
  1161. procedure MoveCStr(var Dest; const Str: String; Attrs: Word); assembler;
  1162. asm
  1163.     MOV    DX,DS
  1164.     LDS    SI,Str
  1165.     CLD
  1166.     LODSB
  1167.     MOV    CL,AL
  1168.     XOR    CH,CH
  1169.     JCXZ    @@3
  1170.     LES    DI,Dest
  1171.     MOV    BX,Attrs
  1172.     MOV    AH,BL
  1173. @@1:    LODSB
  1174.     CMP    AL,'~'
  1175.     JE    @@2
  1176.     STOSW
  1177.     LOOP    @@1
  1178.     JMP    @@3
  1179. @@2:    XCHG    AH,BH
  1180.     LOOP    @@1
  1181. @@3:    MOV    DS,DX
  1182. end;
  1183.  
  1184. procedure MoveStr(var Dest; const Str: String; Attr: Byte); assembler;
  1185. asm
  1186.     MOV    DX,DS
  1187.     LDS    SI,Str
  1188.     CLD
  1189.     LODSB
  1190.     MOV    CL,AL
  1191.     XOR    CH,CH
  1192.     JCXZ    @@4
  1193.     LES    DI,Dest
  1194.     MOV    AH,Attr
  1195.     OR    AH,AH
  1196.     JE    @@3
  1197. @@1:    LODSB
  1198.     STOSW
  1199.     LOOP    @@1
  1200.     JMP    @@4
  1201. @@2:    INC    DI
  1202. @@3:    MOVSB
  1203.     LOOP    @@2
  1204. @@4:    MOV    DS,DX
  1205. end;
  1206.  
  1207. function CStrLen(const S: String): Integer; assembler;
  1208. asm
  1209.     LES    DI,S
  1210.     MOV    CL,ES:[DI]
  1211.     INC    DI
  1212.     XOR    CH,CH
  1213.     MOV    BX,CX
  1214.         JCXZ    @@2
  1215.     MOV    AL,'~'
  1216.         CLD
  1217. @@1:    REPNE    SCASB
  1218.     JNE    @@2
  1219.     DEC    BX
  1220.     JMP    @@1
  1221. @@2:    MOV    AX,BX
  1222. end;
  1223.  
  1224. { Drivers unit initialization and shutdown }
  1225.  
  1226. var
  1227.   SaveExit: Pointer;
  1228.  
  1229. procedure ExitDrivers; far;
  1230. begin
  1231.   DoneSysError;
  1232.   DoneEvents;
  1233.   ExitProc := SaveExit;
  1234. end;
  1235.  
  1236. begin
  1237.   DetectMouse;
  1238.   DetectVideo;
  1239.   SaveExit := ExitProc;
  1240.   ExitProc := @ExitDrivers;
  1241. end.
  1242.