← Back to branch summary

~ubuntu-branches/ubuntu/lucid/fpc/lucid-proposed

« back to all changes in this revision

Viewing changes to fpcsrc/packages/fv/src/drivers.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-10-09 23:29:00 UTC
  • mfrom: (4.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20081009232900-553f61m37jkp6upv
Tags: 2.2.2-4
http://bugs.debian.org/498882
[ Torsten Werner ]
* Update ABI version in fpc-depends automatically.
* Remove empty directories from binary package fpc-source.

[ Mazen Neifer ]
* Removed leading path when calling update-alternatives to remove a Linitian
  error.
* Fixed clean target.
* Improved description of packages. (Closes: #498882)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/fv/src/drivers.pas
 
1
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
 
2
{                                                          }
 
3
{    System independent clone of DRIVERS.PAS               }
 
4
{                                                          }
 
5
{    Interface Copyright (c) 1992 Borland International    }
 
6
{                                                          }
 
7
{    Copyright (c) 1996, 1997, 1998, 1999, 2000            }
 
8
{    by Leon de Boer                                       }
 
9
{    ldeboer@attglobal.net  - primary e-mail addr          }
 
10
{    ldeboer@projectent.com.au - backup e-mail addr        }
 
11
{                                                          }
 
12
{    Original FormatStr kindly donated by Marco Schmidt    }
 
13
{                                                          }
 
14
{    Mouse callback hook under FPC with kind assistance of }
 
15
{    Pierre Muller, Gertjan Schouten & Florian Klaempfl.   }
 
16
{                                                          }
 
17
{****************[ THIS CODE IS FREEWARE ]*****************}
 
18
{                                                          }
 
19
{     This sourcecode is released for the purpose to       }
 
20
{   promote the pascal language on all platforms. You may  }
 
21
{   redistribute it and/or modify with the following       }
 
22
{   DISCLAIMER.                                            }
 
23
{                                                          }
 
24
{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
 
25
{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
 
26
{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
 
27
{                                                          }
 
28
{*****************[ SUPPORTED PLATFORMS ]******************}
 
29
{                                                          }
 
30
{ Only Free Pascal Compiler supported                      }
 
31
{                                                          }
 
32
{**********************************************************}
 
33
 
 
34
UNIT Drivers;
 
35
 
 
36
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 
37
                                  INTERFACE
 
38
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 
39
 
 
40
{====Include file to sort compiler platform out =====================}
 
41
{$I Platform.inc}
 
42
{====================================================================}
 
43
 
 
44
{==== Compiler directives ===========================================}
 
45
 
 
46
{$X+} { Extended syntax is ok }
 
47
{$R-} { Disable range checking }
 
48
{$IFNDEF OS_UNIX}
 
49
{$S-} { Disable Stack Checking }
 
50
{$ENDIF}
 
51
{$I-} { Disable IO Checking }
 
52
{$Q-} { Disable Overflow Checking }
 
53
{$V-} { Turn off strict VAR strings }
 
54
{====================================================================}
 
55
 
 
56
{$ifdef CPU68K}
 
57
  {$DEFINE ENDIAN_BIG}
 
58
{$endif CPU68K}
 
59
 
 
60
{$ifdef FPC}
 
61
  {$INLINE ON}
 
62
{$endif}
 
63
 
 
64
USES
 
65
   {$IFDEF OS_WINDOWS}                                { WIN/NT CODE }
 
66
         Windows,                                     { Standard unit }
 
67
   {$ENDIF}
 
68
 
 
69
   {$ifdef OS_DOS}
 
70
     Dos,
 
71
   {$endif OS_DOS}
 
72
 
 
73
   {$IFDEF OS_OS2}                                    { OS2 CODE }
 
74
     {$IFDEF PPC_Virtual}                             { VIRTUAL PASCAL UNITS }
 
75
       OS2Def, OS2Base, OS2PMAPI,                     { Standard units }
 
76
     {$ENDIF}
 
77
     {$IFDEF PPC_Speed}                               { SPEED PASCAL UNITS }
 
78
       BseDos, Os2Def,                                { Standard units }
 
79
     {$ENDIF}
 
80
     {$IFDEF PPC_FPC}                                 { FPC UNITS }
 
81
       DosCalls, Os2Def,                              { Standard units }
 
82
     {$ENDIF}
 
83
   {$ENDIF}
 
84
 
 
85
   {$IFDEF OS_UNIX}
 
86
     {$ifdef VER1_0}
 
87
       linux,
 
88
     {$else}
 
89
       baseunix,unix,
 
90
     {$endif}
 
91
   {$ENDIF}
 
92
 
 
93
   {$IFDEF OS_NETWARE_LIBC}
 
94
      libc,
 
95
   {$ENDIF}
 
96
   {$IFDEF OS_NETWARE_CLIB}
 
97
      nwserv,
 
98
   {$ENDIF}
 
99
 
 
100
   video,
 
101
   SysMsg,
 
102
   FVCommon, Objects;                                 { GFV standard units }
 
103
 
 
104
{***************************************************************************}
 
105
{                              PUBLIC CONSTANTS                             }
 
106
{***************************************************************************}
 
107
 
 
108
{---------------------------------------------------------------------------}
 
109
{                              EVENT TYPE MASKS                             }
 
110
{---------------------------------------------------------------------------}
 
111
CONST
 
112
   evMouseDown = $0001;                               { Mouse down event }
 
113
   evMouseUp   = $0002;                               { Mouse up event }
 
114
   evMouseMove = $0004;                               { Mouse move event }
 
115
   evMouseAuto = $0008;                               { Mouse auto event }
 
116
   evKeyDown   = $0010;                               { Key down event }
 
117
   evCommand   = $0100;                               { Command event }
 
118
   evBroadcast = $0200;                               { Broadcast event }
 
119
 
 
120
{---------------------------------------------------------------------------}
 
121
{                             EVENT CODE MASKS                              }
 
122
{---------------------------------------------------------------------------}
 
123
CONST
 
124
   evNothing   = $0000;                               { Empty event }
 
125
   evMouse     = $000F;                               { Mouse event }
 
126
   evKeyboard  = $0010;                               { Keyboard event }
 
127
   evMessage   = $FF00;                               { Message event }
 
128
 
 
129
{---------------------------------------------------------------------------}
 
130
{                             EXTENDED KEY CODES                            }
 
131
{---------------------------------------------------------------------------}
 
132
CONST
 
133
   kbNoKey       = $0000;  kbAltEsc      = $0100;  kbEsc         = $011B;
 
134
   kbAltSpace    = $0200;  kbCtrlIns     = $0400;  kbShiftIns    = $0500;
 
135
   kbCtrlDel     = $0600;  kbShiftDel    = $0700;  kbAltBack     = $0800;
 
136
   kbAltShiftBack= $0900;  kbBack        = $0E08;  kbCtrlBack    = $0E7F;
 
137
   kbShiftTab    = $0F00;  kbTab         = $0F09;  kbAltQ        = $1000;
 
138
   kbCtrlQ       = $1011;  kbAltW        = $1100;  kbCtrlW       = $1117;
 
139
   kbAltE        = $1200;  kbCtrlE       = $1205;  kbAltR        = $1300;
 
140
   kbCtrlR       = $1312;  kbAltT        = $1400;  kbCtrlT       = $1414;
 
141
   kbAltY        = $1500;  kbCtrlY       = $1519;  kbAltU        = $1600;
 
142
   kbCtrlU       = $1615;  kbAltI        = $1700;  kbCtrlI       = $1709;
 
143
   kbAltO        = $1800;  kbCtrlO       = $180F;  kbAltP        = $1900;
 
144
   kbCtrlP       = $1910;  kbAltLftBrack = $1A00;  kbAltRgtBrack = $1B00;
 
145
   kbCtrlEnter   = $1C0A;  kbEnter       = $1C0D;  kbAltA        = $1E00;
 
146
   kbCtrlA       = $1E01;  kbAltS        = $1F00;  kbCtrlS       = $1F13;
 
147
   kbAltD        = $2000;  kbCtrlD       = $2004;  kbAltF        = $2100;
 
148
   kbCtrlF       = $2106;  kbAltG        = $2200;  kbCtrlG       = $2207;
 
149
   kbAltH        = $2300;  kbCtrlH       = $2308;  kbAltJ        = $2400;
 
150
   kbCtrlJ       = $240A;  kbAltK        = $2500;  kbCtrlK       = $250B;
 
151
   kbAltL        = $2600;  kbCtrlL       = $260C;  kbAltSemiCol  = $2700;
 
152
   kbAltQuote    = $2800;  kbAltOpQuote  = $2900;  kbAltBkSlash  = $2B00;
 
153
   kbAltZ        = $2C00;  kbCtrlZ       = $2C1A;  kbAltX        = $2D00;
 
154
   kbCtrlX       = $2D18;  kbAltC        = $2E00;  kbCtrlC       = $2E03;
 
155
   kbAltV        = $2F00;  kbCtrlV       = $2F16;  kbAltB        = $3000;
 
156
   kbCtrlB       = $3002;  kbAltN        = $3100;  kbCtrlN       = $310E;
 
157
   kbAltM        = $3200;  kbCtrlM       = $320D;  kbAltComma    = $3300;
 
158
   kbAltPeriod   = $3400;  kbAltSlash    = $3500;  kbAltGreyAst  = $3700;
 
159
   kbSpaceBar    = $3920;  kbF1          = $3B00;  kbF2          = $3C00;
 
160
   kbF3          = $3D00;  kbF4          = $3E00;  kbF5          = $3F00;
 
161
   kbF6          = $4000;  kbF7          = $4100;  kbF8          = $4200;
 
162
   kbF9          = $4300;  kbF10         = $4400;  kbHome        = $4700;
 
163
   kbUp          = $4800;  kbPgUp        = $4900;  kbGrayMinus   = $4A2D;
 
164
   kbLeft        = $4B00;  kbCenter      = $4C00;  kbRight       = $4D00;
 
165
   kbAltGrayPlus = $4E00;  kbGrayPlus    = $4E2B;  kbEnd         = $4F00;
 
166
   kbDown        = $5000;  kbPgDn        = $5100;  kbIns         = $5200;
 
167
   kbDel         = $5300;  kbShiftF1     = $5400;  kbShiftF2     = $5500;
 
168
   kbShiftF3     = $5600;  kbShiftF4     = $5700;  kbShiftF5     = $5800;
 
169
   kbShiftF6     = $5900;  kbShiftF7     = $5A00;  kbShiftF8     = $5B00;
 
170
   kbShiftF9     = $5C00;  kbShiftF10    = $5D00;  kbCtrlF1      = $5E00;
 
171
   kbCtrlF2      = $5F00;  kbCtrlF3      = $6000;  kbCtrlF4      = $6100;
 
172
   kbCtrlF5      = $6200;  kbCtrlF6      = $6300;  kbCtrlF7      = $6400;
 
173
   kbCtrlF8      = $6500;  kbCtrlF9      = $6600;  kbCtrlF10     = $6700;
 
174
   kbAltF1       = $6800;  kbAltF2       = $6900;  kbAltF3       = $6A00;
 
175
   kbAltF4       = $6B00;  kbAltF5       = $6C00;  kbAltF6       = $6D00;
 
176
   kbAltF7       = $6E00;  kbAltF8       = $6F00;  kbAltF9       = $7000;
 
177
   kbAltF10      = $7100;  kbCtrlPrtSc   = $7200;  kbCtrlLeft    = $7300;
 
178
   kbCtrlRight   = $7400;  kbCtrlEnd     = $7500;  kbCtrlPgDn    = $7600;
 
179
   kbCtrlHome    = $7700;  kbAlt1        = $7800;  kbAlt2        = $7900;
 
180
   kbAlt3        = $7A00;  kbAlt4        = $7B00;  kbAlt5        = $7C00;
 
181
   kbAlt6        = $7D00;  kbAlt7        = $7E00;  kbAlt8        = $7F00;
 
182
   kbAlt9        = $8000;  kbAlt0        = $8100;  kbAltMinus    = $8200;
 
183
   kbAltEqual    = $8300;  kbCtrlPgUp    = $8400;  kbF11         = $8500;
 
184
   kbF12         = $8600;  kbShiftF11    = $8700;  kbShiftF12    = $8800;
 
185
   kbCtrlF11     = $8900;  kbCtrlF12     = $8A00;  kbAltF11      = $8B00;
 
186
   kbAltF12      = $8C00;  kbCtrlUp      = $8D00;  kbCtrlMinus   = $8E00;
 
187
   kbCtrlCenter  = $8F00;  kbCtrlGreyPlus= $9000;  kbCtrlDown    = $9100;
 
188
   kbCtrlTab     = $9400;  kbAltHome     = $9700;  kbAltUp       = $9800;
 
189
   kbAltPgUp     = $9900;  kbAltLeft     = $9B00;  kbAltRight    = $9D00;
 
190
   kbAltEnd      = $9F00;  kbAltDown     = $A000;  kbAltPgDn     = $A100;
 
191
   kbAltIns      = $A200;  kbAltDel      = $A300;  kbAltTab      = $A500;
 
192
 
 
193
{ ------------------------------- REMARK ------------------------------ }
 
194
{ New keys not initially defined by Borland in their unit interface.    }
 
195
{ ------------------------------ END REMARK --- Leon de Boer, 15May96 - }
 
196
   kbFullStop    = $342E;  kbComma       = $332C;  kbBackSlash   = $352F;
 
197
   kbApostrophe  = $2827;  kbSemiColon   = $273B;  kbEqual       = $0D3D;
 
198
   kbGreaterThan = $343E;  kbLessThan    = $333C;  kbQuestion    = $353F;
 
199
   kbQuote       = $2822;  kbColon       = $273A;  kbPlus        = $0D2B;
 
200
   kbPipe        = $2B7C;  kbSlash       = $2B5C;  kbExclaim     = $0221;
 
201
   kbAt          = $0340;  kbNumber      = $0423;  kbPercent     = $0625;
 
202
   kbCaret       = $075E;  kbAmpersand   = $0826;  kbAsterix     = $092A;
 
203
   kbLeftBracket = $0A28;  kbRightBracket= $0B29;  kbApprox      = $2960;
 
204
   kbTilde       = $297E;  kbDollar      = $0524;  kbMinus       = $0C2D;
 
205
   kbUnderline   = $0C5F;  kbLeftSqBr    = $1A5B;  kbRightSqBr   = $1B5D;
 
206
   kbLeftCurlyBr = $1A7B;  kbRightCurlyBr= $1B7D;
 
207
 
 
208
{---------------------------------------------------------------------------}
 
209
{                      KEYBOARD STATE AND SHIFT MASKS                       }
 
210
{---------------------------------------------------------------------------}
 
211
CONST
 
212
   kbRightShift  = $0001;                             { Right shift key }
 
213
   kbLeftShift   = $0002;                             { Left shift key }
 
214
   kbCtrlShift   = $0004;                             { Control key down }
 
215
   kbAltShift    = $0008;                             { Alt key down }
 
216
   kbScrollState = $0010;                             { Scroll lock on }
 
217
   kbNumState    = $0020;                             { Number lock on }
 
218
   kbCapsState   = $0040;                             { Caps lock on }
 
219
   kbInsState    = $0080;                             { Insert mode on }
 
220
 
 
221
   kbBothShifts  = kbRightShift + kbLeftShift;        { Right & Left shifts }
 
222
 
 
223
{---------------------------------------------------------------------------}
 
224
{                         MOUSE BUTTON STATE MASKS                          }
 
225
{---------------------------------------------------------------------------}
 
226
CONST
 
227
   mbLeftButton   = $01;                              { Left mouse button }
 
228
   mbRightButton  = $02;                              { Right mouse button }
 
229
   mbMiddleButton = $04;                              { Middle mouse button }
 
230
 
 
231
{---------------------------------------------------------------------------}
 
232
{                         SCREEN CRT MODE CONSTANTS                         }
 
233
{---------------------------------------------------------------------------}
 
234
CONST
 
235
   smBW80    = $0002;                                 { Black and white }
 
236
   smCO80    = $0003;                                 { Colour mode }
 
237
   smMono    = $0007;                                 { Monochrome mode }
 
238
   smFont8x8 = $0100;                                 { 8x8 font mode }
 
239
 
 
240
{***************************************************************************}
 
241
{                          PUBLIC TYPE DEFINITIONS                          }
 
242
{***************************************************************************}
 
243
 
 
244
{ ******************************* REMARK ****************************** }
 
245
{    The TEvent definition is completely compatable with all existing   }
 
246
{  code but adds two new fields ID and Data into the message record     }
 
247
{  which helps with WIN/NT and OS2 message processing.                  }
 
248
{ ****************************** END REMARK *** Leon de Boer, 11Sep97 * }
 
249
 
 
250
{---------------------------------------------------------------------------}
 
251
{                          EVENT RECORD DEFINITION                          }
 
252
{---------------------------------------------------------------------------}
 
253
TYPE
 
254
   TEvent =
 
255
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
 
256
   PACKED
 
257
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
 
258
   RECORD
 
259
      What: Sw_Word;                                     { Event type }
 
260
      Case Sw_Word Of
 
261
        evNothing: ();                                { ** NO EVENT ** }
 
262
        evMouse: (
 
263
          Buttons: Byte;                              { Mouse buttons }
 
264
          Double: Boolean;                            { Double click state }
 
265
          Where: TPoint);                             { Mouse position }
 
266
        evKeyDown: (
 
267
        { ** KEY EVENT ** }
 
268
          Case Sw_Integer Of
 
269
            0: (KeyCode:  Word);                       { Full key code }
 
270
            1: (
 
271
{$ifdef ENDIAN_BIG}
 
272
                ScanCode: Byte;
 
273
                CharCode: Char;
 
274
{$else not ENDIAN_BIG}
 
275
                CharCode: Char;                       { Char code }
 
276
                ScanCode: Byte;                       { Scan code }
 
277
{$endif not ENDIAN_BIG}
 
278
                KeyShift: byte));                     { Shift states }
 
279
        evMessage: (                                  { ** MESSAGE EVENT ** }
 
280
          Command: Sw_Word;                              { Message command }
 
281
          Id     : Sw_Word;                              { Message id }
 
282
          Data   : Real;                              { Message data }
 
283
          Case Sw_Word Of
 
284
            0: (InfoPtr: Pointer);                    { Message pointer }
 
285
            1: (InfoLong: Longint);                   { Message longint }
 
286
            2: (InfoWord: Word);                      { Message Sw_Word }
 
287
            3: (InfoInt: Integer);                    { Message Sw_Integer }
 
288
            4: (InfoByte: Byte);                      { Message byte }
 
289
            5: (InfoChar: Char));                     { Message character }
 
290
   END;
 
291
   PEvent = ^TEvent;
 
292
 
 
293
   TVideoMode = Video.TVideoMode;                     { Screen mode }
 
294
 
 
295
{---------------------------------------------------------------------------}
 
296
{                    ERROR HANDLER FUNCTION DEFINITION                      }
 
297
{---------------------------------------------------------------------------}
 
298
TYPE
 
299
   TSysErrorFunc = FUNCTION (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 
300
 
 
301
{***************************************************************************}
 
302
{                            INTERFACE ROUTINES                             }
 
303
{***************************************************************************}
 
304
 
 
305
{ Get Dos counter ticks }
 
306
Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
 
307
 
 
308
 
 
309
procedure GiveUpTimeSlice;
 
310
 
 
311
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
312
{                          BUFFER MOVE ROUTINES                             }
 
313
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
314
 
 
315
{-CStrLen------------------------------------------------------------
 
316
Returns the length of string S, where S is a control string using tilde
 
317
characters ('~') to designate shortcut characters. The tildes are
 
318
excluded from the length of the string, as they will not appear on
 
319
the screen. For example, given the string '~B~roccoli' as its
 
320
parameter, CStrLen returns 8.
 
321
25May96 LdB
 
322
---------------------------------------------------------------------}
 
323
FUNCTION CStrLen (Const S: String): Sw_Integer;
 
324
 
 
325
{-MoveStr------------------------------------------------------------
 
326
Moves a string into a buffer for use with a view's WriteBuf or WriteLine.
 
327
Dest must be a TDrawBuffer (or an equivalent array of Sw_Words). The
 
328
characters in Str are moved into the low bytes of corresponding Sw_Words
 
329
in Dest. The high bytes of the Sw_Words are set to Attr, or remain
 
330
unchanged if Attr is zero.
 
331
25May96 LdB
 
332
---------------------------------------------------------------------}
 
333
PROCEDURE MoveStr (Var Dest; Const Str: String; Attr: Byte);
 
334
 
 
335
{-MoveCStr-----------------------------------------------------------
 
336
The characters in Str are moved into the low bytes of corresponding
 
337
Sw_Words in Dest. The high bytes of the Sw_Words are set to Lo(Attr) or
 
338
Hi(Attr). Tilde characters (~) in the string toggle between the two
 
339
attribute bytes passed in the Attr Sw_Word.
 
340
25May96 LdB
 
341
---------------------------------------------------------------------}
 
342
PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
 
343
 
 
344
{-MoveBuf------------------------------------------------------------
 
345
Count bytes are moved from Source into the low bytes of corresponding
 
346
Sw_Words in Dest. The high bytes of the Sw_Words in Dest are set to Attr,
 
347
or remain unchanged if Attr is zero.
 
348
25May96 LdB
 
349
---------------------------------------------------------------------}
 
350
PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Sw_Word);
 
351
 
 
352
{-MoveChar------------------------------------------------------------
 
353
Moves characters into a buffer for use with a view's WriteBuf or
 
354
WriteLine. Dest must be a TDrawBuffer (or an equivalent array of Sw_Words).
 
355
The low bytes of the first Count Sw_Words of Dest are set to C, or
 
356
remain unchanged if Ord(C) is zero. The high bytes of the Sw_Words are
 
357
set to Attr, or remain unchanged if Attr is zero.
 
358
25May96 LdB
 
359
---------------------------------------------------------------------}
 
360
PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Sw_Word);
 
361
 
 
362
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
363
{                        KEYBOARD SUPPORT ROUTINES                          }
 
364
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
365
 
 
366
{-GetAltCode---------------------------------------------------------
 
367
Returns the scancode corresponding to Alt+Ch key that is given.
 
368
25May96 LdB
 
369
---------------------------------------------------------------------}
 
370
FUNCTION GetAltCode (Ch: Char): Word;
 
371
 
 
372
{-GetCtrlCode--------------------------------------------------------
 
373
Returns the scancode corresponding to Alt+Ch key that is given.
 
374
25May96 LdB
 
375
---------------------------------------------------------------------}
 
376
FUNCTION GetCtrlCode (Ch: Char): Word;
 
377
 
 
378
{-GetAltChar---------------------------------------------------------
 
379
Returns the ascii character for the Alt+Key scancode that was given.
 
380
25May96 LdB
 
381
---------------------------------------------------------------------}
 
382
FUNCTION GetAltChar (KeyCode: Word): Char;
 
383
 
 
384
{-GetCtrlChar--------------------------------------------------------
 
385
Returns the ascii character for the Ctrl+Key scancode that was given.
 
386
25May96 LdB
 
387
---------------------------------------------------------------------}
 
388
FUNCTION GetCtrlChar (KeyCode: Word): Char;
 
389
 
 
390
{-CtrlToArrow--------------------------------------------------------
 
391
Converts a WordStar-compatible control key code to the corresponding
 
392
cursor key code.
 
393
25May96 LdB
 
394
---------------------------------------------------------------------}
 
395
FUNCTION CtrlToArrow (KeyCode: Word): Word;
 
396
 
 
397
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
398
{                        KEYBOARD CONTROL ROUTINES                          }
 
399
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
400
 
 
401
{-GetShiftState------------------------------------------------------
 
402
Returns a byte containing the current Shift key state. The return
 
403
value contains a combination of the kbXXXX constants for shift states.
 
404
08Jul96 LdB
 
405
---------------------------------------------------------------------}
 
406
FUNCTION GetShiftState: Byte;
 
407
 
 
408
{-GetKeyEvent--------------------------------------------------------
 
409
Checks whether a keyboard event is available. If a key has been pressed,
 
410
Event.What is set to evKeyDown and Event.KeyCode is set to the scan
 
411
code of the key. Otherwise, Event.What is set to evNothing.
 
412
19May98 LdB
 
413
---------------------------------------------------------------------}
 
414
PROCEDURE GetKeyEvent (Var Event: TEvent);
 
415
 
 
416
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
417
{                          MOUSE CONTROL ROUTINES                           }
 
418
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
419
 
 
420
{-ShowMouse----------------------------------------------------------
 
421
Decrements the hide counter and if zero the mouse is shown on screen.
 
422
30Jun98 LdB
 
423
---------------------------------------------------------------------}
 
424
PROCEDURE ShowMouse;
 
425
 
 
426
{-HideMouse----------------------------------------------------------
 
427
If mouse hide counter is zero it removes the cursor from the screen.
 
428
The hide counter is then incremented by one count.
 
429
30Jun98 LdB
 
430
---------------------------------------------------------------------}
 
431
PROCEDURE HideMouse;
 
432
 
 
433
{-GetMouseEvent------------------------------------------------------
 
434
Checks whether a mouse event is available. If a mouse event has occurred,
 
435
Event.What is set to evMouseDown, evMouseUp, evMouseMove, or evMouseAuto
 
436
and the button and double click variables are set appropriately.
 
437
06Jan97 LdB
 
438
---------------------------------------------------------------------}
 
439
PROCEDURE GetMouseEvent (Var Event: TEvent);
 
440
 
 
441
{-GetSystemEvent------------------------------------------------------
 
442
Checks whether a system event is available. If a system event has occurred,
 
443
Event.What is set to evCommand appropriately
 
444
10Oct2000 PM
 
445
---------------------------------------------------------------------}
 
446
procedure GetSystemEvent (Var Event: TEvent);
 
447
 
 
448
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
449
{                      EVENT HANDLER CONTROL ROUTINES                       }
 
450
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
451
 
 
452
{-InitEvents---------------------------------------------------------
 
453
Initializes the event manager, enabling the mouse handler routine and
 
454
under DOS/DPMI shows the mouse on screen. It is called automatically
 
455
by TApplication.Init.
 
456
02May98 LdB
 
457
---------------------------------------------------------------------}
 
458
PROCEDURE InitEvents;
 
459
 
 
460
{-DoneEvents---------------------------------------------------------
 
461
Terminates event manager and disables the mouse and under DOS hides
 
462
the mouse. It is called automatically by TApplication.Done.
 
463
02May98 LdB
 
464
---------------------------------------------------------------------}
 
465
PROCEDURE DoneEvents;
 
466
 
 
467
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
468
{                           VIDEO CONTROL ROUTINES                          }
 
469
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
470
 
 
471
{-Initkeyboard-------------------------------------------------------
 
472
Initializes the keyboard. Before it is called read(ln)/write(ln)
 
473
are functional, after it is called FV's keyboard routines are
 
474
functional.
 
475
---------------------------------------------------------------------}
 
476
 
 
477
procedure initkeyboard;
 
478
 
 
479
{-Donekeyboard-------------------------------------------------------
 
480
Restores keyboard to original state. FV's keyboard routines may not
 
481
be used after a call to this. Read(ln)/write(ln) can be used again.
 
482
---------------------------------------------------------------------}
 
483
 
 
484
procedure donekeyboard;
 
485
 
 
486
{-InitVideo---------------------------------------------------------
 
487
Initializes the video manager, Saves the current screen mode in
 
488
StartupMode, and switches to the mode indicated by ScreenMode.
 
489
19May98 LdB
 
490
---------------------------------------------------------------------}
 
491
function InitVideo:boolean;
 
492
 
 
493
{-DoneVideo---------------------------------------------------------
 
494
Terminates the video manager by restoring the initial screen mode
 
495
(given by StartupMode), clearing the screen, and restoring the cursor.
 
496
Called automatically by TApplication.Done.
 
497
03Jan97 LdB
 
498
---------------------------------------------------------------------}
 
499
PROCEDURE DoneVideo;
 
500
 
 
501
{-ClearScreen--------------------------------------------------------
 
502
Does nothing provided for compatability purposes only.
 
503
04Jan97 LdB
 
504
---------------------------------------------------------------------}
 
505
PROCEDURE ClearScreen;
 
506
 
 
507
{-SetVideoMode-------------------------------------------------------
 
508
Does nothing provided for compatability purposes only.
 
509
04Jan97 LdB
 
510
---------------------------------------------------------------------}
 
511
PROCEDURE SetVideoMode (Mode: Sw_Word);
 
512
 
 
513
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
514
{                           ERROR CONTROL ROUTINES                          }
 
515
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
516
 
 
517
{-InitSysError-------------------------------------------------------
 
518
Error handling is not yet implemented so this simply sets
 
519
SysErrActive=True (ie it lies) and exits.
 
520
20May98 LdB
 
521
---------------------------------------------------------------------}
 
522
PROCEDURE InitSysError;
 
523
 
 
524
{-DoneSysError-------------------------------------------------------
 
525
Error handling is not yet implemented so this simply sets
 
526
SysErrActive=False and exits.
 
527
20May98 LdB
 
528
---------------------------------------------------------------------}
 
529
PROCEDURE DoneSysError;
 
530
 
 
531
{-SystemError---------------------------------------------------------
 
532
Error handling is not yet implemented so this simply drops through.
 
533
20May98 LdB
 
534
---------------------------------------------------------------------}
 
535
FUNCTION SystemError (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 
536
 
 
537
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
538
{                           STRING FORMAT ROUTINES                          }
 
539
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
540
 
 
541
{-PrintStr-----------------------------------------------------------
 
542
Does nothing provided for compatability purposes only.
 
543
30Jun98 LdB
 
544
---------------------------------------------------------------------}
 
545
PROCEDURE PrintStr (CONST S: String);
 
546
 
 
547
{-FormatStr----------------------------------------------------------
 
548
A string formatting routine that given a string that includes format
 
549
specifiers and a list of parameters in Params, FormatStr produces a
 
550
formatted output string in Result.
 
551
18Feb99 LdB
 
552
---------------------------------------------------------------------}
 
553
PROCEDURE FormatStr (Var Result: String; CONST Format: String; Var Params);
 
554
 
 
555
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
556
{                 >> NEW QUEUED EVENT HANDLER ROUTINES <<                   }
 
557
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
558
 
 
559
{-PutEventInQueue-----------------------------------------------------
 
560
If there is room in the queue the event is placed in the next vacant
 
561
position in the queue manager.
 
562
17Mar98 LdB
 
563
---------------------------------------------------------------------}
 
564
FUNCTION PutEventInQueue (Var Event: TEvent): Boolean;
 
565
 
 
566
{-NextQueuedEvent----------------------------------------------------
 
567
If there are queued events the next event is loaded into event else
 
568
evNothing is returned.
 
569
17Mar98 LdB
 
570
---------------------------------------------------------------------}
 
571
PROCEDURE NextQueuedEvent(Var Event: TEvent);
 
572
 
 
573
{***************************************************************************}
 
574
{                        INITIALIZED PUBLIC VARIABLES                       }
 
575
{***************************************************************************}
 
576
 
 
577
PROCEDURE HideMouseCursor;
 
578
PROCEDURE ShowMouseCursor;
 
579
 
 
580
 
 
581
{---------------------------------------------------------------------------}
 
582
{                INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                  }
 
583
{---------------------------------------------------------------------------}
 
584
CONST
 
585
   CheckSnow    : Boolean = False;                    { Compatability only }
 
586
   MouseEvents  : Boolean = False;                    { Mouse event state }
 
587
   MouseReverse : Boolean = False;                    { Mouse reversed }
 
588
   HiResScreen  : Boolean = False;                    { Compatability only }
 
589
   CtrlBreakHit : Boolean = False;                    { Compatability only }
 
590
   SaveCtrlBreak: Boolean = False;                    { Compatability only }
 
591
   SysErrActive : Boolean = False;                    { Compatability only }
 
592
   FailSysErrors: Boolean = False;                    { Compatability only }
 
593
   ButtonCount  : Byte = 0;                           { Mouse button count }
 
594
   DoubleDelay  : Sw_Word = 8;                           { Double click delay }
 
595
   RepeatDelay  : Sw_Word = 8;                           { Auto mouse delay }
 
596
   SysColorAttr : Sw_Word = $4E4F;                       { System colour attr }
 
597
   SysMonoAttr  : Sw_Word = $7070;                       { System mono attr }
 
598
   StartupMode  : Sw_Word = $FFFF;                       { Compatability only }
 
599
   CursorLines  : Sw_Word = $FFFF;                       { Compatability only }
 
600
   ScreenBuffer : Pointer = Nil;                      { Compatability only }
 
601
   SaveInt09    : Pointer = Nil;                      { Compatability only }
 
602
   SysErrorFunc : TSysErrorFunc = {$ifdef FPC}@{$endif}SystemError; { System error ptr }
 
603
 
 
604
 
 
605
{***************************************************************************}
 
606
{                      UNINITIALIZED PUBLIC VARIABLES                       }
 
607
{***************************************************************************}
 
608
 
 
609
{---------------------------------------------------------------------------}
 
610
{                UNINITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                }
 
611
{---------------------------------------------------------------------------}
 
612
VAR
 
613
   MouseIntFlag: Byte;                                { Mouse in int flag }
 
614
   MouseButtons: Byte;                                { Mouse button state }
 
615
   ScreenWidth : Byte;                                { Screen text width }
 
616
   ScreenHeight: Byte;                                { Screen text height }
 
617
   ScreenMode  : TVideoMode;                         { Screen mode }
 
618
   MouseWhere  : TPoint;                              { Mouse position }
 
619
 
 
620
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 
621
                               IMPLEMENTATION
 
622
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 
623
{ API Units }
 
624
  USES
 
625
  FVConsts,
 
626
  Keyboard,Mouse;
 
627
 
 
628
{***************************************************************************}
 
629
{                        PRIVATE INTERNAL CONSTANTS                         }
 
630
{***************************************************************************}
 
631
 
 
632
{---------------------------------------------------------------------------}
 
633
{                 DOS/DPMI MOUSE INTERRUPT EVENT QUEUE SIZE                 }
 
634
{---------------------------------------------------------------------------}
 
635
CONST EventQSize = 16;                                { Default int bufsize }
 
636
 
 
637
{---------------------------------------------------------------------------}
 
638
{                DOS/DPMI/WIN/NT/OS2 NEW EVENT QUEUE MAX SIZE               }
 
639
{---------------------------------------------------------------------------}
 
640
CONST QueueMax = 64;                                  { Max new queue size }
 
641
 
 
642
{---------------------------------------------------------------------------}
 
643
{   MAX WIEW WIDTH to avoid TDrawBuffer overrun in views unit               }
 
644
{---------------------------------------------------------------------------}
 
645
CONST MaxViewWidth = 255;                                  { Max view width }
 
646
 
 
647
{***************************************************************************}
 
648
{                          PRIVATE INTERNAL TYPES                           }
 
649
{***************************************************************************}
 
650
 
 
651
{***************************************************************************}
 
652
{                  PRIVATE INTERNAL INITIALIZED VARIABLES                   }
 
653
{***************************************************************************}
 
654
 
 
655
{---------------------------------------------------------------------------}
 
656
{          DOS/DPMI/WIN/NT/OS2 ALT KEY SCANCODES FROM KEYS (0-127)          }
 
657
{---------------------------------------------------------------------------}
 
658
CONST AltCodes: Array [0..127] Of Byte = (
 
659
      $00, $00, $00, $00, $00, $00, $00, $00,         { $00 - $07 }
 
660
      $00, $00, $00, $00, $00, $00, $00, $00,         { $08 - $0F }
 
661
      $00, $00, $00, $00, $00, $00, $00, $00,         { $10 - $17 }
 
662
      $00, $00, $00, $00, $00, $00, $00, $00,         { $18 - $1F }
 
663
      $00, $00, $00, $00, $00, $00, $00, $00,         { $20 - $27 }
 
664
      $00, $00, $00, $00, $00, $82, $00, $00,         { $28 - $2F }
 
665
      $81, $78, $79, $7A, $7B, $7C, $7D, $7E,         { $30 - $37 }
 
666
      $7F, $80, $00, $00, $00, $83, $00, $00,         { $38 - $3F }
 
667
      $00, $1E, $30, $2E, $20, $12, $21, $22,         { $40 - $47 }
 
668
      $23, $17, $24, $25, $26, $32, $31, $18,         { $48 - $4F }
 
669
      $19, $10, $13, $1F, $14, $16, $2F, $11,         { $50 - $57 }
 
670
      $2D, $15, $2C, $00, $00, $00, $00, $00,         { $58 - $5F }
 
671
      $00, $00, $00, $00, $00, $00, $00, $00,         { $60 - $67 }
 
672
      $00, $00, $00, $00, $00, $00, $00, $00,         { $68 - $6F }
 
673
      $00, $00, $00, $00, $00, $00, $00, $00,         { $70 - $77 }
 
674
      $00, $00, $00, $00, $00, $00, $00, $00);        { $78 - $7F }
 
675
 
 
676
{***************************************************************************}
 
677
{                  PRIVATE INTERNAL INITIALIZED VARIABLES                   }
 
678
{***************************************************************************}
 
679
 
 
680
{---------------------------------------------------------------------------}
 
681
{                           NEW CONTROL VARIABLES                           }
 
682
{---------------------------------------------------------------------------}
 
683
CONST
 
684
   HideCount : Sw_Integer = 0;                           { Cursor hide count }
 
685
   QueueCount: Sw_Word = 0;                              { Queued message count }
 
686
   QueueHead : Sw_Word = 0;                              { Queue head pointer }
 
687
   QueueTail : Sw_Word = 0;                              { Queue tail pointer }
 
688
 
 
689
{***************************************************************************}
 
690
{                 PRIVATE INTERNAL UNINITIALIZED VARIABLES                  }
 
691
{***************************************************************************}
 
692
 
 
693
{---------------------------------------------------------------------------}
 
694
{                     UNINITIALIZED DOS/DPMI/API VARIABLES                      }
 
695
{---------------------------------------------------------------------------}
 
696
VAR
 
697
   LastDouble : Boolean;                              { Last double buttons }
 
698
   LastButtons: Byte;                                 { Last button state }
 
699
   DownButtons: Byte;                                 { Last down buttons }
 
700
   EventCount : Sw_Word;                                 { Events in queue }
 
701
   AutoDelay  : Sw_Word;                                 { Delay time count }
 
702
   DownTicks  : Sw_Word;                                 { Down key tick count }
 
703
   AutoTicks  : Sw_Word;                                 { Held key tick count }
 
704
   LastWhereX : Sw_Word;                                 { Last x position }
 
705
   LastWhereY : Sw_Word;                                 { Last y position }
 
706
   DownWhereX : Sw_Word;                                 { Last x position }
 
707
   DownWhereY : Sw_Word;                                 { Last y position }
 
708
   LastWhere  : TPoint;                               { Last mouse position }
 
709
   DownWhere  : TPoint;                               { Last down position }
 
710
   EventQHead : Pointer;                              { Head of queue }
 
711
   EventQTail : Pointer;                              { Tail of queue }
 
712
   EventQueue : Array [0..EventQSize - 1] Of TEvent;  { Event queue }
 
713
   EventQLast : RECORD END;                           { Simple end marker }
 
714
   StartupScreenMode : TVideoMode;
 
715
 
 
716
{---------------------------------------------------------------------------}
 
717
{  GetDosTicks (18.2 Hz)                                                    }
 
718
{---------------------------------------------------------------------------}
 
719
 
 
720
Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
 
721
{$IFDEF OS_OS2}
 
722
  const
 
723
    QSV_MS_COUNT = 14;
 
724
  var
 
725
    L: longint;
 
726
  begin
 
727
    DosQuerySysInfo (QSV_MS_COUNT, QSV_MS_COUNT, L, 4);
 
728
    GetDosTicks := L div 55;
 
729
  end;
 
730
{$ENDIF}
 
731
{$IFDEF OS_UNIX}
 
732
  var
 
733
     tv : TimeVal;
 
734
  {  tz : TimeZone;}
 
735
  begin
 
736
    {$ifdef ver1_0}
 
737
    GetTimeOfDay(tv{,tz});
 
738
    GetDosTicks:=((tv.Sec mod 86400) div 60)*1092+((tv.Sec mod 60)*1000000+tv.USec) div 54945;
 
739
    {$else}
 
740
    FPGetTimeOfDay(@tv,nil{,tz});
 
741
    GetDosTicks:=((tv.tv_Sec mod 86400) div 60)*1092+((tv.tv_Sec mod 60)*1000000+tv.tv_USec) div 54945;
 
742
 
 
743
    {$endif}
 
744
  end;
 
745
{$ENDIF OS_UNIX}
 
746
{$IFDEF OS_WINDOWS}
 
747
  begin
 
748
     GetDosTicks:=GetTickCount div 55;
 
749
  end;
 
750
{$ENDIF OS_WINDOWS}
 
751
{$IFDEF OS_DOS}
 
752
  begin
 
753
    GetDosTicks:=MemL[$40:$6c];
 
754
  end;
 
755
{$ENDIF OS_DOS}
 
756
{$IFDEF OS_NETWARE_LIBC}
 
757
var
 
758
  tv : TTimeVal;
 
759
  tz : TTimeZone;
 
760
  begin
 
761
    fpGetTimeOfDay(tv,tz);
 
762
    GetDosTicks:=((tv.tv_sec mod 86400) div 60)*1092+((tv.tv_Sec mod 60)*1000000+tv.tv_USec) div 549
 
763
  end;
 
764
{$ENDIF}
 
765
{$IFDEF OS_NETWARE_CLIB}
 
766
  begin
 
767
    GetDosTicks := Nwserv.GetCurrentTicks;
 
768
  end;
 
769
{$ENDIF}
 
770
 
 
771
 
 
772
procedure GiveUpTimeSlice;
 
773
{$IFDEF OS_DOS}
 
774
var r: registers;
 
775
begin
 
776
  Intr ($28, R); (* This is supported everywhere. *)
 
777
  r.ax:=$1680;
 
778
  intr($2f,r);
 
779
end;
 
780
{$ENDIF}
 
781
{$IFDEF OS_UNIX}
 
782
  var
 
783
    req,rem : timespec;
 
784
begin
 
785
  req.tv_sec:=0;
 
786
  req.tv_nsec:=10000000;{ 10 ms }
 
787
  {$ifdef ver1_0}nanosleep(req,rem){$else}fpnanosleep(@req,@rem){$endif};
 
788
end;
 
789
{$ENDIF}
 
790
{$IFDEF OS_OS2}
 
791
begin
 
792
 DosSleep (5);
 
793
end;
 
794
{$ENDIF}
 
795
{$IFDEF OS_WINDOWS}
 
796
begin
 
797
  { if the return value of this call is non zero then
 
798
    it means that a ReadFileEx or WriteFileEx have completed
 
799
    unused for now ! }
 
800
  { wait for 10 ms }
 
801
  if SleepEx(10,true)=WAIT_IO_COMPLETION then
 
802
    begin
 
803
      { here we should handle the completion of the routines
 
804
        if we use them }
 
805
    end;
 
806
end;
 
807
{$ENDIF}
 
808
{$IFDEF OS_NETWARE_LIBC}
 
809
  begin
 
810
    Delay (10);
 
811
  end;
 
812
{$ENDIF}
 
813
{$IFDEF OS_NETWARE_CLIB}
 
814
  begin
 
815
    Delay (10);
 
816
  end;
 
817
{$ENDIF}
 
818
 
 
819
 
 
820
{---------------------------------------------------------------------------}
 
821
{                UNINITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                }
 
822
{---------------------------------------------------------------------------}
 
823
VAR
 
824
   SaveExit: Pointer;                                 { Saved exit pointer }
 
825
   Queue   : Array [0..QueueMax-1] Of TEvent;         { New message queue }
 
826
 
 
827
{***************************************************************************}
 
828
{                         PRIVATE INTERNAL ROUTINES                         }
 
829
{***************************************************************************}
 
830
 
 
831
PROCEDURE ShowMouseCursor;inline;
 
832
BEGIN
 
833
  ShowMouse;
 
834
END;
 
835
 
 
836
PROCEDURE HideMouseCursor;inline;
 
837
BEGIN
 
838
  HideMouse;
 
839
END;
 
840
 
 
841
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
842
{               DOS/DPMI/WIN/NT/OS2 PRIVATE INTERNAL ROUTINES               }
 
843
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
844
 
 
845
{---------------------------------------------------------------------------}
 
846
{  ExitDrivers -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jun98 LdB       }
 
847
{---------------------------------------------------------------------------}
 
848
PROCEDURE ExitDrivers; {$IFNDEF PPC_FPC}{$IFNDEF OS_UNIX} FAR; {$ENDIF}{$ENDIF}
 
849
BEGIN
 
850
   DoneSysError;                                      { Relase error trap }
 
851
   DoneEvents;                                        { Close event driver }
 
852
{   DoneKeyboard;}
 
853
   DoneVideo;
 
854
   ExitProc := SaveExit;                              { Restore old exit }
 
855
END;
 
856
 
 
857
{---------------------------------------------------------------------------}
 
858
{  DetectVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB       }
 
859
{---------------------------------------------------------------------------}
 
860
 
 
861
procedure DetectVideo;
 
862
VAR
 
863
  CurrMode : TVideoMode;
 
864
begin
 
865
  { Video.InitVideo; Incompatible with BP
 
866
    and forces a screen clear which is often a bad thing PM }
 
867
  GetVideoMode(CurrMode);
 
868
  ScreenMode:=CurrMode;
 
869
end;
 
870
 
 
871
{---------------------------------------------------------------------------}
 
872
{  DetectMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB       }
 
873
FUNCTION DetectMouse: Byte;inline;
 
874
begin
 
875
  DetectMouse:=Mouse.DetectMouse;
 
876
end;
 
877
 
 
878
{***************************************************************************}
 
879
{                            INTERFACE ROUTINES                             }
 
880
{***************************************************************************}
 
881
 
 
882
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
883
{                           BUFFER MOVE ROUTINES                            }
 
884
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
885
 
 
886
{---------------------------------------------------------------------------}
 
887
{  CStrLen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB           }
 
888
{---------------------------------------------------------------------------}
 
889
FUNCTION CStrLen (Const S: String): Sw_Integer;
 
890
VAR I, J: Sw_Integer;
 
891
BEGIN
 
892
   J := 0;                                            { Set result to zero }
 
893
   For I := 1 To Length(S) Do
 
894
     If (S[I] <> '~') Then Inc(J);                    { Inc count if not ~ }
 
895
   CStrLen := J;                                      { Return length }
 
896
END;
 
897
 
 
898
{---------------------------------------------------------------------------}
 
899
{  MoveStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB           }
 
900
{---------------------------------------------------------------------------}
 
901
PROCEDURE MoveStr (Var Dest; Const Str: String; Attr: Byte);
 
902
VAR I: Word; P: PWord;
 
903
BEGIN
 
904
   For I := 1 To Length(Str) Do Begin                 { For each character }
 
905
     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
 
906
     If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
 
907
     WordRec(P^).Lo := Byte(Str[I]);                  { Copy string char }
 
908
   End;
 
909
END;
 
910
 
 
911
{---------------------------------------------------------------------------}
 
912
{  MoveCStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 
913
{---------------------------------------------------------------------------}
 
914
PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
 
915
VAR B: Byte; I, J: Sw_Word; P: PWord;
 
916
BEGIN
 
917
   J := 0;                                            { Start position }
 
918
   For I := 1 To Length(Str) Do Begin                 { For each character }
 
919
     If (Str[I] <> '~') Then Begin                    { Not tilde character }
 
920
       P := @TWordArray(Dest)[J];                     { Pointer to Sw_Word }
 
921
       If (Lo(Attrs) <> 0) Then
 
922
         WordRec(P^).Hi := Lo(Attrs);                 { Copy attribute }
 
923
       WordRec(P^).Lo := Byte(Str[I]);                { Copy string char }
 
924
       Inc(J);                                        { Next position }
 
925
     End Else Begin
 
926
       B := Hi(Attrs);                                { Hold attribute }
 
927
       WordRec(Attrs).Hi := Lo(Attrs);                { Copy low to high }
 
928
       WordRec(Attrs).Lo := B;                        { Complete exchange }
 
929
     End;
 
930
   End;
 
931
END;
 
932
 
 
933
{---------------------------------------------------------------------------}
 
934
{  MoveBuf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB           }
 
935
{---------------------------------------------------------------------------}
 
936
PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Sw_Word);
 
937
VAR I: Word; P: PWord;
 
938
BEGIN
 
939
   For I := 1 To Count Do Begin
 
940
     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
 
941
     If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
 
942
     WordRec(P^).Lo := TByteArray(Source)[I-1];       { Copy source data }
 
943
   End;
 
944
END;
 
945
 
 
946
{---------------------------------------------------------------------------}
 
947
{  MoveChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 
948
{---------------------------------------------------------------------------}
 
949
PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Sw_Word);
 
950
VAR I: Word; P: PWord;
 
951
BEGIN
 
952
   For I := 1 To Count Do Begin
 
953
     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
 
954
     If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
 
955
     If (Ord(C) <> 0) Then WordRec(P^).Lo := Byte(C); { Copy character }
 
956
   End;
 
957
END;
 
958
 
 
959
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
960
{                        KEYBOARD SUPPORT ROUTINES                          }
 
961
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
962
 
 
963
{---------------------------------------------------------------------------}
 
964
{  GetAltCode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB        }
 
965
{---------------------------------------------------------------------------}
 
966
FUNCTION GetAltCode (Ch: Char): Word;
 
967
BEGIN
 
968
   GetAltCode := 0;                                   { Preset zero return }
 
969
   Ch := UpCase(Ch);                                  { Convert upper case }
 
970
   If (Ch < #128) Then
 
971
     GetAltCode := AltCodes[Ord(Ch)] SHL 8            { Return code }
 
972
     Else If (Ch = #240) Then GetAltCode := $0200     { Return code }
 
973
       Else GetAltCode := 0;                          { Return zero }
 
974
END;
 
975
 
 
976
{---------------------------------------------------------------------------}
 
977
{  GetCtrlCode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB       }
 
978
{---------------------------------------------------------------------------}
 
979
FUNCTION GetCtrlCode (Ch: Char): Word;
 
980
BEGIN
 
981
   GetCtrlCode := GetAltCode(Ch) OR (Ord(Ch) - $40);  { Ctrl+key code }
 
982
END;
 
983
 
 
984
{---------------------------------------------------------------------------}
 
985
{  GetAltChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB        }
 
986
{---------------------------------------------------------------------------}
 
987
FUNCTION GetAltChar (KeyCode: Word): Char;
 
988
VAR I: Sw_Integer;
 
989
BEGIN
 
990
   GetAltChar := #0;                                  { Preset fail return }
 
991
   If (Lo(KeyCode) = 0) Then Begin                    { Extended key }
 
992
     If (Hi(KeyCode) <= $83) Then Begin               { Highest value in list }
 
993
       I := 0;                                        { Start at first }
 
994
       While (I < 128) AND (Hi(KeyCode) <> AltCodes[I])
 
995
         Do Inc(I);                                   { Search for match }
 
996
       If (I < 128) Then GetAltChar := Chr(I);        { Return character }
 
997
     End Else
 
998
       If (Hi(KeyCode)=$02) Then GetAltChar := #240;  { Return char }
 
999
   End;
 
1000
END;
 
1001
 
 
1002
{---------------------------------------------------------------------------}
 
1003
{  GetCtrlChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB       }
 
1004
{---------------------------------------------------------------------------}
 
1005
FUNCTION GetCtrlChar (KeyCode: Word): Char;
 
1006
VAR C: Char;
 
1007
BEGIN
 
1008
  C := #0;                                            { Preset #0 return }
 
1009
  If (Lo(KeyCode) > 0) AND (Lo(KeyCode) <= 26) Then   { Between 1-26 }
 
1010
    C := Chr(Lo(KeyCode) + $40);                      { Return char A-Z }
 
1011
  GetCtrlChar := C;                                   { Return result }
 
1012
END;
 
1013
 
 
1014
{---------------------------------------------------------------------------}
 
1015
{  CtrlToArrow -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB       }
 
1016
{---------------------------------------------------------------------------}
 
1017
FUNCTION CtrlToArrow (KeyCode: Word): Word;
 
1018
CONST NumCodes = 11;
 
1019
      CtrlCodes : Array [0..NumCodes-1] Of Char =
 
1020
        (#19, #4, #5, #24, #1, #6, #7, #22, #18, #3, #8);
 
1021
      ArrowCodes: Array [0..NumCodes-1] Of Sw_Word =
 
1022
       (kbLeft, kbRight, kbUp, kbDown, kbHome, kbEnd, kbDel, kbIns,
 
1023
        kbPgUp, kbPgDn, kbBack);
 
1024
VAR I: Sw_Integer;
 
1025
BEGIN
 
1026
   CtrlToArrow := KeyCode;                            { Preset key return }
 
1027
   For I := 0 To NumCodes - 1 Do
 
1028
     If WordRec(KeyCode).Lo = Byte(CtrlCodes[I])      { Matches a code }
 
1029
     Then Begin
 
1030
       CtrlToArrow := ArrowCodes[I];                  { Return key stroke }
 
1031
       Exit;                                          { Now exit }
 
1032
     End;
 
1033
END;
 
1034
 
 
1035
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1036
{                        KEYBOARD CONTROL ROUTINES                          }
 
1037
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1038
 
 
1039
{---------------------------------------------------------------------------}
 
1040
{  GetShiftState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jul96 LdB     }
 
1041
{---------------------------------------------------------------------------}
 
1042
FUNCTION GetShiftState: Byte;
 
1043
begin
 
1044
  GetShiftState:=Keyboard.GetKeyEventShiftState(Keyboard.PollShiftStateEvent);
 
1045
end;
 
1046
 
 
1047
{---------------------------------------------------------------------------}
 
1048
{  GetKeyEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB       }
 
1049
{---------------------------------------------------------------------------}
 
1050
procedure GetKeyEvent (Var Event: TEvent);
 
1051
var
 
1052
  key      : TKeyEvent;
 
1053
  keycode  : Word;
 
1054
  keyshift : byte;
 
1055
begin
 
1056
  if Keyboard.PollKeyEvent<>0 then
 
1057
   begin
 
1058
     key:=Keyboard.GetKeyEvent;
 
1059
     keycode:=Keyboard.GetKeyEventCode(key);
 
1060
     keyshift:=KeyBoard.GetKeyEventShiftState(key);
 
1061
     { fixup shift-keys }
 
1062
     if keyshift and kbShift<>0 then
 
1063
       begin
 
1064
         case keycode of
 
1065
           $5200 : keycode:=kbShiftIns;
 
1066
           $5300 : keycode:=kbShiftDel;
 
1067
           $8500 : keycode:=kbShiftF1;
 
1068
           $8600 : keycode:=kbShiftF2;
 
1069
         end;
 
1070
       end
 
1071
     { fixup ctrl-keys }
 
1072
     else if keyshift and kbCtrl<>0 then
 
1073
       begin
 
1074
         case keycode of
 
1075
           $5200,
 
1076
           $9200 : keycode:=kbCtrlIns;
 
1077
           $5300,
 
1078
           $9300 : keycode:=kbCtrlDel;
 
1079
         end;
 
1080
       end
 
1081
     { fixup alt-keys }
 
1082
     else if keyshift and kbAlt<>0 then
 
1083
       begin
 
1084
         case keycode of
 
1085
           $0e08,
 
1086
           $0e00 : keycode:=kbAltBack;
 
1087
         end;
 
1088
       end
 
1089
     { fixup normal keys }
 
1090
     else
 
1091
       begin
 
1092
         case keycode of
 
1093
           $e00d : keycode:=kbEnter;
 
1094
         end;
 
1095
       end;
 
1096
     Event.What:=evKeyDown;
 
1097
     Event.KeyCode:=keycode;
 
1098
{$ifdef ENDIAN_LITTLE}
 
1099
     Event.CharCode:=chr(keycode and $ff);
 
1100
     Event.ScanCode:=keycode shr 8;
 
1101
{$endif ENDIAN_LITTLE}
 
1102
     Event.KeyShift:=keyshift;
 
1103
   end
 
1104
  else
 
1105
   Event.What:=evNothing;
 
1106
end;
 
1107
 
 
1108
 
 
1109
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1110
{                          MOUSE CONTROL ROUTINES                           }
 
1111
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1112
 
 
1113
{---------------------------------------------------------------------------}
 
1114
{  HideMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jun98 LdB         }
 
1115
{---------------------------------------------------------------------------}
 
1116
procedure HideMouse;
 
1117
begin
 
1118
{ Is mouse hidden yet?
 
1119
  If (HideCount = 0) Then}
 
1120
    Mouse.HideMouse;
 
1121
{  Inc(HideCount);}
 
1122
end;
 
1123
 
 
1124
{---------------------------------------------------------------------------}
 
1125
{  ShowMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jun98 LdB         }
 
1126
{---------------------------------------------------------------------------}
 
1127
procedure ShowMouse;
 
1128
begin
 
1129
{  if HideCount>0 then
 
1130
    dec(HideCount);
 
1131
  if (HideCount=0) then}
 
1132
   Mouse.ShowMouse;
 
1133
end;
 
1134
 
 
1135
{---------------------------------------------------------------------------}
 
1136
{  GetMouseEvent -> Platforms DOS/DPMI/WINDOWS/OS2 - Updated 30Jun98 LdB    }
 
1137
{---------------------------------------------------------------------------}
 
1138
procedure GetMouseEvent (Var Event: TEvent);
 
1139
var
 
1140
  e : Mouse.TMouseEvent;
 
1141
begin
 
1142
  if Mouse.PollMouseEvent(e) then
 
1143
   begin
 
1144
     Mouse.GetMouseEvent(e);
 
1145
     MouseWhere.X:=e.x;
 
1146
     MouseWhere.Y:=e.y;
 
1147
     Event.Double:=false;
 
1148
     case e.Action of
 
1149
       MouseActionMove :
 
1150
         Event.What:=evMouseMove;
 
1151
       MouseActionDown :
 
1152
         begin
 
1153
           Event.What:=evMouseDown;
 
1154
           if (DownButtons=e.Buttons) and (LastWhere.X=MouseWhere.X) and (LastWhere.Y=MouseWhere.Y) and
 
1155
              (GetDosTicks-DownTicks<=DoubleDelay) then
 
1156
             Event.Double:=true;
 
1157
           DownButtons:=e.Buttons;
 
1158
           DownWhere.X:=MouseWhere.x;
 
1159
           DownWhere.Y:=MouseWhere.y;
 
1160
           DownTicks:=GetDosTicks;
 
1161
           AutoTicks:=GetDosTicks;
 
1162
           if AutoTicks=0 then
 
1163
             AutoTicks:=1;
 
1164
           AutoDelay:=RepeatDelay;
 
1165
         end;
 
1166
       MouseActionUp :
 
1167
         begin
 
1168
           AutoTicks:=0;
 
1169
           Event.What:=evMouseUp;
 
1170
           AutoTicks:=0;
 
1171
         end;
 
1172
     end;
 
1173
     Event.Buttons:=e.Buttons;
 
1174
     Event.Where.X:=MouseWhere.x;
 
1175
     Event.Where.Y:=MouseWhere.y;
 
1176
     LastButtons:=Event.Buttons;
 
1177
     LastWhere.x:=Event.Where.x;
 
1178
     LastWhere.y:=Event.Where.y;
 
1179
   end
 
1180
  else if (AutoTicks <> 0) and (GetDosTicks >= AutoTicks + AutoDelay) then
 
1181
   begin
 
1182
     Event.What:=evMouseAuto;
 
1183
     Event.Buttons:=LastButtons;
 
1184
     Event.Where.X:=LastWhere.x;
 
1185
     Event.Where.Y:=LastWhere.y;
 
1186
     AutoTicks:=GetDosTicks;
 
1187
     AutoDelay:=1;
 
1188
   end
 
1189
  else
 
1190
   FillChar(Event,sizeof(TEvent),0);
 
1191
  if MouseReverse and ((Event.Buttons and 3) in [1,2]) then
 
1192
    Event.Buttons := Event.Buttons xor 3;
 
1193
end;
 
1194
 
 
1195
{---------------------------------------------------------------------------}
 
1196
{  GetSystemEvent                                                           }
 
1197
{---------------------------------------------------------------------------}
 
1198
procedure GetSystemEvent (Var Event: TEvent);
 
1199
var
 
1200
  SysEvent : TsystemEvent;
 
1201
begin
 
1202
  if PollSystemEvent(SysEvent) then
 
1203
    begin
 
1204
      SysMsg.GetSystemEvent(SysEvent);
 
1205
      case SysEvent.typ of
 
1206
      SysNothing :
 
1207
        Event.What:=evNothing;
 
1208
      SysSetFocus :
 
1209
        begin
 
1210
          Event.What:=evBroadcast;
 
1211
          Event.Command:=cmReceivedFocus;
 
1212
        end;
 
1213
      SysReleaseFocus :
 
1214
        begin
 
1215
          Event.What:=evBroadcast;
 
1216
          Event.Command:=cmReleasedFocus;
 
1217
        end;
 
1218
      SysClose :
 
1219
        begin
 
1220
          Event.What:=evCommand;
 
1221
          Event.Command:=cmQuitApp;
 
1222
        end;
 
1223
      SysResize :
 
1224
        begin
 
1225
          Event.What:=evCommand;
 
1226
          Event.Command:=cmResizeApp;
 
1227
          Event.Id:=SysEvent.x;
 
1228
          Event.InfoWord:=SysEvent.y;
 
1229
        end;
 
1230
      else
 
1231
        Event.What:=evNothing;
 
1232
      end;
 
1233
    end
 
1234
  else
 
1235
    Event.What:=evNothing;
 
1236
end;
 
1237
 
 
1238
 
 
1239
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1240
{                      EVENT HANDLER CONTROL ROUTINES                       }
 
1241
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1242
 
 
1243
{---------------------------------------------------------------------------}
 
1244
{  InitEvents -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 07Sep99 LdB        }
 
1245
{---------------------------------------------------------------------------}
 
1246
PROCEDURE InitEvents;
 
1247
BEGIN
 
1248
  If (ButtonCount <> 0) Then
 
1249
    begin                   { Mouse is available }
 
1250
     Mouse.InitMouse;                                 { Hook the mouse }
 
1251
     { this is required by the use of HideCount variable }
 
1252
     Mouse.ShowMouse;                                 { visible by default }
 
1253
     { HideCount:=0;  }
 
1254
     LastButtons := 0;                                { Clear last buttons }
 
1255
     DownButtons := 0;                                { Clear down buttons }
 
1256
     MouseWhere.X:=Mouse.GetMouseX;
 
1257
     MouseWhere.Y:=Mouse.GetMouseY;                   { Get mouse position }
 
1258
     LastWhere.x:=MouseWhere.x;
 
1259
     LastWhereX:=MouseWhere.x;
 
1260
     LastWhere.y:=MouseWhere.y;
 
1261
     LastWhereY:=MouseWhere.y;
 
1262
     MouseEvents := True;                             { Set initialized flag }
 
1263
    end;
 
1264
  InitSystemMsg;
 
1265
END;
 
1266
 
 
1267
{---------------------------------------------------------------------------}
 
1268
{  DoneEvents -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB        }
 
1269
{---------------------------------------------------------------------------}
 
1270
PROCEDURE DoneEvents;
 
1271
BEGIN
 
1272
  DoneSystemMsg;
 
1273
  Mouse.DoneMouse;
 
1274
  MouseEvents:=false;
 
1275
END;
 
1276
 
 
1277
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1278
{                           VIDEO CONTROL ROUTINES                          }
 
1279
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1280
 
 
1281
const
 
1282
  VideoInitialized : boolean = false;
 
1283
 
 
1284
{---------------------------------------------------------------------------}
 
1285
{  InitKeyboard -> Platforms ALL - 07May06 DM                               }
 
1286
{---------------------------------------------------------------------------}
 
1287
 
 
1288
procedure initkeyboard;inline;
 
1289
 
 
1290
begin
 
1291
  keyboard.initkeyboard;
 
1292
end;
 
1293
 
 
1294
{---------------------------------------------------------------------------}
 
1295
{  DoneKeyboard -> Platforms ALL - 07May06 DM                               }
 
1296
{---------------------------------------------------------------------------}
 
1297
 
 
1298
procedure donekeyboard;inline;
 
1299
 
 
1300
begin
 
1301
  keyboard.donekeyboard;
 
1302
end;
 
1303
 
 
1304
{---------------------------------------------------------------------------}
 
1305
{  InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB         }
 
1306
{---------------------------------------------------------------------------}
 
1307
function InitVideo:boolean;
 
1308
 
 
1309
var StoreScreenMode : TVideoMode;
 
1310
 
 
1311
begin
 
1312
  initvideo:=false;
 
1313
  if VideoInitialized then
 
1314
    begin
 
1315
      StoreScreenMode:=ScreenMode;
 
1316
      DoneVideo;
 
1317
    end
 
1318
  else
 
1319
    StoreScreenMode.Col:=0;
 
1320
 
 
1321
  Video.InitVideo;
 
1322
  if video.errorcode<>viook then
 
1323
    exit;
 
1324
  GetVideoMode(StartupScreenMode);
 
1325
  GetVideoMode(ScreenMode);
 
1326
{$ifdef win32}
 
1327
  { Force the console to the current screen mode }
 
1328
  Video.SetVideoMode(ScreenMode);
 
1329
{$endif win32}
 
1330
 
 
1331
  If (StoreScreenMode.Col<>0) and
 
1332
     ((StoreScreenMode.color<>ScreenMode.color) or
 
1333
     (StoreScreenMode.row<>ScreenMode.row) or
 
1334
     (StoreScreenMode.col<>ScreenMode.col)) then
 
1335
    begin
 
1336
      Video.SetVideoMode(StoreScreenMode);
 
1337
      GetVideoMode(ScreenMode);
 
1338
    end;
 
1339
 
 
1340
  if ScreenWidth > MaxViewWidth then
 
1341
    ScreenWidth := MaxViewWidth;
 
1342
  ScreenWidth:=Video.ScreenWidth;
 
1343
  ScreenHeight:=Video.ScreenHeight;
 
1344
  VideoInitialized:=true;
 
1345
  initvideo:=true;
 
1346
end;
 
1347
 
 
1348
{---------------------------------------------------------------------------}
 
1349
{  DoneVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB         }
 
1350
{---------------------------------------------------------------------------}
 
1351
PROCEDURE DoneVideo;
 
1352
BEGIN
 
1353
  if not VideoInitialized then
 
1354
    exit;
 
1355
  Video.SetVideoMode(StartupScreenMode);
 
1356
  Video.ClearScreen;
 
1357
  Video.SetCursorPos(0,0);
 
1358
  Video.DoneVideo;
 
1359
  VideoInitialized:=false;
 
1360
END;
 
1361
 
 
1362
{---------------------------------------------------------------------------}
 
1363
{  ClearScreen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Jan97 LdB       }
 
1364
{---------------------------------------------------------------------------}
 
1365
PROCEDURE ClearScreen;
 
1366
BEGIN
 
1367
  Video.ClearScreen;
 
1368
END;
 
1369
 
 
1370
{---------------------------------------------------------------------------}
 
1371
{  SetVideoMode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Nov99 LdB      }
 
1372
{---------------------------------------------------------------------------}
 
1373
PROCEDURE SetVideoMode (Mode: Sw_Word);
 
1374
BEGIN
 
1375
END;
 
1376
 
 
1377
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1378
{                           ERROR CONTROL ROUTINES                          }
 
1379
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1380
 
 
1381
{---------------------------------------------------------------------------}
 
1382
{  InitSysError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB      }
 
1383
{---------------------------------------------------------------------------}
 
1384
PROCEDURE InitSysError;
 
1385
BEGIN
 
1386
   SysErrActive := True;                              { Set active flag }
 
1387
END;
 
1388
 
 
1389
{---------------------------------------------------------------------------}
 
1390
{  DoneSysError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB      }
 
1391
{---------------------------------------------------------------------------}
 
1392
PROCEDURE DoneSysError;
 
1393
BEGIN
 
1394
   SysErrActive := False;                             { Clear active flag }
 
1395
END;
 
1396
 
 
1397
{---------------------------------------------------------------------------}
 
1398
{  SystemError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB       }
 
1399
{---------------------------------------------------------------------------}
 
1400
FUNCTION SystemError (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 
1401
BEGIN
 
1402
   If (FailSysErrors = False) Then Begin              { Check error ignore }
 
1403
 
 
1404
   End Else SystemError := 1;                         { Return 1 for ignored }
 
1405
END;
 
1406
 
 
1407
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1408
{                           STRING FORMAT ROUTINES                          }
 
1409
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1410
 
 
1411
{---------------------------------------------------------------------------}
 
1412
{  PrintStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 18Feb99 LdB          }
 
1413
{---------------------------------------------------------------------------}
 
1414
PROCEDURE PrintStr (CONST S: String);
 
1415
BEGIN
 
1416
   Write(S);                                          { Write to screen }
 
1417
END;
 
1418
 
 
1419
{---------------------------------------------------------------------------}
 
1420
{  FormatStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 13Jul99 LdB         }
 
1421
{---------------------------------------------------------------------------}
 
1422
procedure FormatStr (Var Result: String; CONST Format: String; Var Params);
 
1423
TYPE TLongArray = Array[0..0] Of PtrInt;
 
1424
VAR W, ResultLength : integer;
 
1425
    FormatIndex, Justify, Wth: Byte;
 
1426
    Fill: Char; S: String;
 
1427
 
 
1428
   FUNCTION LongToStr (L: Longint; Radix: Byte): String;
 
1429
   CONST HexChars: Array[0..15] Of Char =
 
1430
    ('0', '1', '2', '3', '4', '5', '6', '7',
 
1431
     '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
 
1432
   VAR I: LongInt; S: String; Sign: String[1];
 
1433
   begin
 
1434
     LongToStr := '';                                 { Preset empty return }
 
1435
     If (L < 0) Then begin                            { If L is negative }
 
1436
       Sign := '-';                                   { Sign is negative }
 
1437
       L := Abs(L);                                   { Convert to positive }
 
1438
     end Else Sign := '';                             { Sign is empty }
 
1439
     S := '';                                         { Preset empty string }
 
1440
     Repeat
 
1441
       I := L MOD Radix;                              { Radix mod of value }
 
1442
       S := HexChars[I] + S;                          { Add char to string }
 
1443
       L := L DIV Radix;                              { Divid by radix }
 
1444
     Until (L = 0);                                   { Until no remainder }
 
1445
     LongToStr := Sign + S;                           { Return result }
 
1446
   end;
 
1447
 
 
1448
   procedure HandleParameter (I : LongInt);
 
1449
   begin
 
1450
     While (FormatIndex <= Length(Format)) Do begin   { While length valid }
 
1451
       if ResultLength>=High(Result) then
 
1452
         exit;
 
1453
       While (FormatIndex <= Length(Format)) and
 
1454
             (Format[FormatIndex] <> '%')          { Param char not found }
 
1455
        Do begin
 
1456
         Result[ResultLength+1] := Format[FormatIndex]; { Transfer character }
 
1457
         Inc(ResultLength);                           { One character added }
 
1458
         Inc(FormatIndex);                            { Next param char }
 
1459
       end;
 
1460
       If (FormatIndex < Length(Format)) and          { Not last char and }
 
1461
       (Format[FormatIndex] = '%') Then begin         { '%' char found }
 
1462
         Fill := ' ';                                 { Default fill char }
 
1463
         Justify := 0;                                { Default justify }
 
1464
         Wth := 0;                                    { Default 0=no width }
 
1465
         Inc(FormatIndex);                            { Next character }
 
1466
         If (Format[FormatIndex] = '0') Then
 
1467
           Fill := '0';                               { Fill char to zero }
 
1468
         If (Format[FormatIndex] = '-') Then begin    { Optional just char }
 
1469
           Justify := 1;                              { Right justify }
 
1470
           Inc(FormatIndex);                          { Next character }
 
1471
         end;
 
1472
         While ((FormatIndex <= Length(Format)) and   { Length still valid }
 
1473
         (Format[FormatIndex] >= '0') and
 
1474
         (Format[FormatIndex] <= '9')) Do begin       { Numeric character }
 
1475
           Wth := Wth * 10;                           { Multiply x10 }
 
1476
           Wth := Wth + Ord(Format[FormatIndex])-$30; { Add numeric value }
 
1477
           Inc(FormatIndex);                          { Next character }
 
1478
         end;
 
1479
         If ((FormatIndex <= Length(Format)) and      { Length still valid }
 
1480
         (Format[FormatIndex] = '#')) Then begin      { Parameter marker }
 
1481
           Inc(FormatIndex);                          { Next character }
 
1482
           HandleParameter(Wth);                      { Width is param idx }
 
1483
         end;
 
1484
         If (FormatIndex <= Length(Format)) Then begin{ Length still valid }
 
1485
           Case Format[FormatIndex] Of
 
1486
           '%': begin                               { Literal % }
 
1487
             S := '%';
 
1488
             Inc(FormatIndex);
 
1489
             Move(S[1], Result[ResultLength+1], 1);
 
1490
             Inc(ResultLength,Length(S));
 
1491
             Continue;
 
1492
           end;
 
1493
           'c': S := Char(TLongArray(Params)[I]);  { Character parameter }
 
1494
             'd': S := LongToStr(TLongArray(Params)[I],
 
1495
               10);                                   { Decimal parameter }
 
1496
             's': S := PString(TLongArray(Params)[I])^;{ String parameter }
 
1497
             'x': S := LongToStr(TLongArray(Params)[I],
 
1498
               16);                                   { Hex parameter }
 
1499
           end;
 
1500
           Inc(FormatIndex);                          { Next character }
 
1501
           If (Wth > 0) Then begin                    { Width control active }
 
1502
             If (Length(S) > Wth) Then begin          { We must shorten S }
 
1503
               If (Justify=1) Then                    { Check right justify }
 
1504
                 S := Copy(S, Length(S)-Wth+1, Wth)   { Take right side data }
 
1505
                 Else S := Copy(S, 1, Wth);           { Take left side data }
 
1506
             end Else begin                           { We must pad out S }
 
1507
               If (Justify=1) Then                    { Right justify }
 
1508
                 While (Length(S) < Wth) Do
 
1509
                   S := S+Fill Else                   { Right justify fill }
 
1510
                 While (Length(S) < Wth) Do
 
1511
                   S := Fill + S;                     { Left justify fill }
 
1512
             end;
 
1513
           end;
 
1514
           W:=Length(S);
 
1515
           if W+ResultLength+1>High(Result) then
 
1516
             W:=High(Result)-ResultLength;
 
1517
           Move(S[1], Result[ResultLength+1],
 
1518
             W);                                      { Move data to result }
 
1519
           Inc(ResultLength,W);                       { Adj result length }
 
1520
           Inc(I);
 
1521
         end;
 
1522
       end;
 
1523
     end;
 
1524
   end;
 
1525
 
 
1526
begin
 
1527
   ResultLength := 0;                                 { Zero result length }
 
1528
   FormatIndex := 1;                                  { Format index to 1 }
 
1529
   HandleParameter(0);                                { Handle parameter }
 
1530
   Result[0] := Chr(ResultLength);                    { Set string length }
 
1531
end;
 
1532
 
 
1533
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1534
{                    NEW QUEUED EVENT HANDLER ROUTINES                      }
 
1535
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1536
 
 
1537
{---------------------------------------------------------------------------}
 
1538
{  PutEventInQueue -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Mar98 LdB   }
 
1539
{---------------------------------------------------------------------------}
 
1540
FUNCTION PutEventInQueue (Var Event: TEvent): Boolean;
 
1541
BEGIN
 
1542
   If (QueueCount < QueueMax) Then Begin              { Check room in queue }
 
1543
     Queue[QueueHead] := Event;                       { Store event }
 
1544
     Inc(QueueHead);                                  { Inc head position }
 
1545
     If (QueueHead = QueueMax) Then QueueHead := 0;   { Roll to start check }
 
1546
     Inc(QueueCount);                                 { Inc queue count }
 
1547
     PutEventInQueue := True;                         { Return successful }
 
1548
   End Else PutEventInQueue := False;                 { Return failure }
 
1549
END;
 
1550
 
 
1551
{---------------------------------------------------------------------------}
 
1552
{  NextQueuedEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Mar98 LdB   }
 
1553
{---------------------------------------------------------------------------}
 
1554
PROCEDURE NextQueuedEvent(Var Event: TEvent);
 
1555
BEGIN
 
1556
   If (QueueCount > 0) Then Begin                     { Check queued event }
 
1557
     Event := Queue[QueueTail];                       { Fetch next event }
 
1558
     Inc(QueueTail);                                  { Inc tail position }
 
1559
     If (QueueTail = QueueMax) Then QueueTail := 0;   { Roll to start check }
 
1560
     Dec(QueueCount);                                 { Dec queue count }
 
1561
   End Else Event.What := evNothing;                  { Return empty event }
 
1562
END;
 
1563
 
 
1564
{***************************************************************************}
 
1565
{                      UNIT INITIALIZATION ROUTINE                          }
 
1566
{***************************************************************************}
 
1567
BEGIN
 
1568
   ButtonCount := DetectMouse;                        { Detect mouse }
 
1569
   DetectVideo;                                       { Detect video }
 
1570
{   InitKeyboard;}
 
1571
   InitSystemMsg;
 
1572
{$ifdef win32}
 
1573
   SetFileApisToOEM;
 
1574
{$endif}
 
1575
 
 
1576
   SaveExit := ExitProc;                              { Save old exit }
 
1577
   ExitProc := @ExitDrivers;                          { Set new exit }
 
1578
END.