Rev 762 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
762 | bw | 1 | unit LRLRoutines; |
2 | |||
3 | {$mode objfpc} |
||
4 | {$asmmode intel} |
||
5 | |||
6 | |||
7 | interface |
||
8 | |||
9 | |||
775 | bw | 10 | procedure ImagePut(var Screen, ImageBuffer; X, Y, WinX1, WinY1, WinX2, WinY2: Integer); |
11 | procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y, WinX1, WinY1, WinX2, WinY2: Integer); |
||
762 | bw | 12 | procedure ImageFill(var ImageBuffer; SizeX, SizeY: Word; Value: Byte); |
13 | function ImageSizeX(var ImageBuffer): Word; |
||
14 | function ImageSizeY(var ImageBuffer): Word; |
||
15 | procedure ImageStringGet(Source: String; var FontData, Buffer; ColorOffs: Byte); |
||
16 | procedure ScreenApply(var Buffer); |
||
17 | procedure ImageClear(var Buffer); |
||
18 | procedure ScreenMode(Mode: Integer); |
||
19 | |||
775 | bw | 20 | function ScanToChar(Code: Word): Char; |
762 | bw | 21 | procedure KeyboardInitialize; |
22 | function Keypressed: Boolean; |
||
23 | function ReadKey: Word; |
||
24 | procedure KeyboardFlush; |
||
25 | |||
775 | bw | 26 | procedure MouseInitialize; |
27 | function MSMouseInArea(x1, y1, x2, y2: Integer): Boolean; |
||
28 | function MSMouseDriverExist: Boolean; |
||
29 | procedure MSMouseGetXY(var x, y: Integer); |
||
30 | function MSMouseButtonStatusGet: Word; |
||
31 | function MSMouseButtonWasPressed(Button: Word; var x, y: Integer): Boolean; |
||
32 | function MSMouseButtonWasReleased(Button: Word; var x, y: Integer): Boolean; |
||
33 | procedure MSMouseSetXY(x, y: Integer); |
||
34 | |||
762 | bw | 35 | procedure Palette256Set(var Palette256); |
36 | procedure Palette256Get(var Palette256); |
||
37 | procedure Palette256Darken(var Palette256; StartElement, EndElement, Decrement, MinValue: Byte); |
||
38 | procedure Palette256Transform(var SourcePalette, DestinationPalette); |
||
39 | function DataByteGet(var Buffer; BufferOffset: Word): Byte; |
||
40 | procedure DataBytePut(var Buffer; BufferOffset: Word; Value: Byte); |
||
41 | function DataWordGet(var Buffer; BufferOffset: Word): Word; |
||
42 | procedure DataWordPut(var Buffer; BufferOffset: Word; Value: Word); |
||
43 | procedure DataMove(var Source, Destination; Count: Word; SourceOffset, DestinationOffset: Word); |
||
44 | procedure DataAdd(var Buffer; Count: Word; Amount: Byte; BufferOffset: Word); |
||
45 | procedure DataFill(var Buffer; Count: Word; Value: Byte; BufferOffset: Word); |
||
46 | function DataIdentical(var Array1, Array2; Count: Word; Array1Offset, Array2Offset: Word): Boolean; |
||
47 | function SetInterrupt(Int: Byte; NewAddress: Pointer): Pointer; |
||
48 | procedure FadeClear; |
||
49 | procedure FadeTo(pal: Pointer); |
||
50 | procedure DecompressRepByte(var InArray, OutArray; InArraySize: Word; var OutArraySize: Word); |
||
775 | bw | 51 | |
762 | bw | 52 | function GetInterrupt(Int: Byte): Pointer; |
775 | bw | 53 | procedure WaitForEvent(Timeout: DWord = 0); |
762 | bw | 54 | procedure AssignFile(var AFile: File; AFileName: String); |
55 | function LastDosTick(): Longword; |
||
56 | |||
57 | |||
58 | const |
||
59 | KEY_GREY = $E000; |
||
60 | KEY_UP_BASE = $8000; |
||
61 | KEY_ESC = $0100; |
||
62 | KEY_1 = $0200; |
||
63 | KEY_2 = $0300; |
||
64 | KEY_3 = $0400; |
||
65 | KEY_4 = $0500; |
||
66 | KEY_5 = $0600; |
||
67 | KEY_6 = $0700; |
||
68 | KEY_7 = $0800; |
||
69 | KEY_8 = $0900; |
||
70 | KEY_9 = $0A00; |
||
71 | KEY_0 = $0B00; |
||
72 | KEY_SUBTRACT = $0C00; |
||
73 | KEY_ADD = $0D00; |
||
74 | KEY_BACK = $0E00; |
||
75 | |||
76 | KEY_Q = $1000; |
||
77 | KEY_W = $1100; |
||
78 | KEY_E = $1200; |
||
79 | KEY_R = $1300; |
||
80 | KEY_T = $1400; |
||
81 | KEY_Y = $1500; |
||
82 | KEY_U = $1600; |
||
83 | KEY_I = $1700; |
||
84 | KEY_O = $1800; |
||
85 | KEY_P = $1900; |
||
86 | KEY_LBRACKET = $1A00; |
||
87 | KEY_RBRACKET = $1B00; |
||
88 | KEY_ENTER = $1C00; |
||
89 | |||
90 | KEY_A = $1E00; |
||
91 | KEY_S = $1F00; |
||
92 | KEY_D = $2000; |
||
93 | KEY_F = $2100; |
||
94 | KEY_G = $2200; |
||
95 | KEY_H = $2300; |
||
96 | KEY_J = $2400; |
||
97 | KEY_K = $2500; |
||
98 | KEY_L = $2600; |
||
99 | KEY_SEMICOLON = $2700; |
||
100 | KEY_QUOTE = $2800; |
||
101 | |||
102 | KEY_LSHIFT = $2A00; |
||
103 | KEY_Z = $2C00; |
||
104 | KEY_X = $2D00; |
||
105 | KEY_C = $2E00; |
||
106 | KEY_V = $2F00; |
||
107 | KEY_B = $3000; |
||
108 | KEY_N = $3100; |
||
109 | KEY_M = $3200; |
||
110 | KEY_COMMA = $3300; |
||
111 | KEY_DECIMAL = $3400; |
||
112 | KEY_DIVIDE = $3500; |
||
113 | KEY_RSHIFT = $3600; |
||
114 | |||
115 | KEY_ALT = $3800; |
||
116 | KEY_CAPITAL = $3600; |
||
117 | KEY_F1 = $3B00; |
||
118 | KEY_UP = $4800; |
||
119 | KEY_LEFT = $4B00; |
||
120 | KEY_GREY5 = $4C00; |
||
121 | KEY_RIGHT = $4D00; |
||
122 | KEY_END = $4F00; |
||
123 | KEY_DOWN = $5000; |
||
124 | KEY_PGDN = $5100; |
||
125 | |||
126 | type |
||
127 | ScanToCharRecord = record |
||
128 | Scan: Word; |
||
129 | CL: Char; |
||
130 | CU: Char; |
||
131 | Caps: Boolean; |
||
132 | end; |
||
133 | |||
134 | var |
||
135 | ScreenTitle: PChar = nil; |
||
136 | ScanToCharTable: array[1..45] of ScanToCharRecord = ( |
||
137 | (Scan: KEY_0; CL: '0'; CU: ')'; Caps: False), (Scan: KEY_1; CL: '1'; CU: '!'; Caps: False), |
||
138 | (Scan: KEY_2; CL: '2'; CU: '@'; Caps: False), (Scan: KEY_3; CL: '3'; CU: '#'; Caps: False), |
||
139 | (Scan: KEY_4; CL: '4'; CU: '$'; Caps: False), (Scan: KEY_5; CL: '5'; CU: '%'; Caps: False), |
||
140 | (Scan: KEY_6; CL: '6'; CU: '^'; Caps: False), (Scan: KEY_7; CL: '7'; CU: '&'; Caps: False), |
||
141 | (Scan: KEY_8; CL: '8'; CU: '*'; Caps: False), (Scan: KEY_9; CL: '9'; CU: '('; Caps: False), |
||
142 | (Scan: KEY_SUBTRACT; CL: '-'; CU: '_'; Caps: False), (Scan: KEY_ADD; CL: '='; CU: '+'; Caps: False), |
||
143 | |||
144 | (Scan: KEY_Q; CL: 'q'; CU: 'Q'; Caps: True), (Scan: KEY_W; CL: 'w'; CU: 'W'; Caps: True), |
||
145 | (Scan: KEY_E; CL: 'e'; CU: 'E'; Caps: True), (Scan: KEY_R; CL: 'r'; CU: 'R'; Caps: True), |
||
146 | (Scan: KEY_T; CL: 't'; CU: 'T'; Caps: True), (Scan: KEY_Y; CL: 'y'; CU: 'Y'; Caps: True), |
||
147 | (Scan: KEY_U; CL: 'u'; CU: 'U'; Caps: True), (Scan: KEY_I; CL: 'i'; CU: 'I'; Caps: True), |
||
148 | (Scan: KEY_O; CL: 'o'; CU: 'O'; Caps: True), (Scan: KEY_P; CL: 'p'; CU: 'P'; Caps: True), |
||
149 | (Scan: KEY_LBRACKET; CL: '['; CU: '{'; Caps: False), (Scan: KEY_RBRACKET; CL: ']'; CU: '}'; Caps: False), |
||
150 | |||
151 | (Scan: KEY_A; CL: 'a'; CU: 'A'; Caps: True), (Scan: KEY_S; CL: 's'; CU: 'S'; Caps: True), |
||
152 | (Scan: KEY_D; CL: 'd'; CU: 'D'; Caps: True), (Scan: KEY_F; CL: 'f'; CU: 'F'; Caps: True), |
||
153 | (Scan: KEY_G; CL: 'g'; CU: 'G'; Caps: True), (Scan: KEY_H; CL: 'h'; CU: 'H'; Caps: True), |
||
154 | (Scan: KEY_J; CL: 'j'; CU: 'J'; Caps: True), (Scan: KEY_K; CL: 'k'; CU: 'K'; Caps: True), |
||
155 | (Scan: KEY_L; CL: 'l'; CU: 'L'; Caps: True), |
||
156 | (Scan: KEY_SEMICOLON; CL: ';'; CU: ':'; Caps: False), (Scan: KEY_QUOTE; CL: ''''; CU: '"'; Caps: False), |
||
157 | |||
158 | (Scan: KEY_Z; CL: 'z'; CU: 'Z'; Caps: True), (Scan: KEY_X; CL: 'x'; CU: 'X'; Caps: True), |
||
159 | (Scan: KEY_C; CL: 'c'; CU: 'C'; Caps: True), (Scan: KEY_V; CL: 'v'; CU: 'V'; Caps: True), |
||
160 | (Scan: KEY_B; CL: 'b'; CU: 'B'; Caps: True), (Scan: KEY_N; CL: 'n'; CU: 'N'; Caps: True), |
||
161 | (Scan: KEY_M; CL: 'm'; CU: 'M'; Caps: True), |
||
162 | (Scan: KEY_COMMA; CL: ','; CU: '<'; Caps: False), (Scan: KEY_DECIMAL; CL: '.'; CU: '>'; Caps: False), |
||
163 | (Scan: KEY_DIVIDE; CL: '/'; CU: '?'; Caps: False) |
||
164 | ); |
||
165 | |||
166 | |||
167 | implementation |
||
168 | |||
169 | |||
170 | uses |
||
171 | SysUtils; |
||
172 | |||
173 | |||
174 | const |
||
175 | BUFFER_WIDTH = 320; |
||
176 | BUFFER_HEIGHT = 200; |
||
177 | |||
178 | type |
||
179 | PRGBColor = ^TRGBColor; |
||
180 | TRGBColor = packed record |
||
181 | R, G, B: Byte; |
||
182 | end; |
||
183 | |||
184 | PRGBPalette = ^TRGBPalette; |
||
185 | TRGBPalette = array[Byte] of TRGBColor; |
||
186 | |||
187 | |||
188 | var |
||
189 | ScreenRGBPalette: TRGBPalette; |
||
190 | ScreenRGBBuffer : PRGBColor = nil; |
||
191 | ScreenRGBTemporary: PRGBColor = nil; |
||
192 | ScreenPalBuffer : array[0..BUFFER_HEIGHT - 1, 0..BUFFER_WIDTH - 1] of Byte; |
||
193 | |||
194 | WindowWidth : Longint; |
||
195 | WindowHeight: Longint; |
||
196 | ScreenWidth : Longword; |
||
197 | ScreenHeight: Longword; |
||
198 | CurrentScreenMode: Integer = 0; |
||
199 | |||
200 | LastKeyEvent: Word = $FFFF; |
||
201 | LastKeyUp : Boolean = True; |
||
202 | LastKeyDown: Boolean = False; |
||
203 | AltDown : Boolean = False; |
||
204 | ShiftDown : Boolean = False; |
||
205 | LShiftDown : Boolean = False; |
||
206 | RShiftDown : Boolean = False; |
||
207 | CapsPressed: Boolean = False; |
||
208 | |||
209 | |||
210 | |||
211 | procedure Paint; |
||
212 | begin |
||
213 | kos_begindraw(); |
||
214 | kos_definewindow(10, 10, 100, 100, $64000000); |
||
215 | if CurrentScreenMode <> 0 then |
||
216 | begin |
||
217 | kos_setcaption(ScreenTitle); |
||
218 | if Assigned(ScreenRGBBuffer) then |
||
219 | kos_drawimage24(0, 0, ScreenWidth, ScreenHeight, ScreenRGBBuffer) else |
||
220 | kos_drawrect(0, 0, ScreenWidth, ScreenHeight, $FF00FF); |
||
221 | end; |
||
222 | kos_enddraw(); |
||
223 | end; |
||
224 | |||
225 | |||
226 | procedure UpdateRGBBuffer; |
||
227 | var |
||
228 | XStep, YStep: Longword; |
||
229 | |||
230 | procedure Horizontal; |
||
231 | var |
||
232 | X, Y, I: Longword; |
||
233 | B: PByte; |
||
234 | C: PRGBColor; |
||
235 | begin |
||
236 | C := ScreenRGBTemporary; |
||
237 | for Y := 0 to BUFFER_HEIGHT - 1 do |
||
238 | begin |
||
239 | I := 0; |
||
240 | B := @ScreenPalBuffer[Y, 0]; |
||
241 | for X := 0 to ScreenWidth - 1 do |
||
242 | begin |
||
243 | C^ := ScreenRGBPalette[PByte(B + (I shr 16))^]; |
||
244 | Inc(I, XStep); |
||
245 | Inc(C); |
||
246 | end; |
||
247 | end; |
||
248 | end; |
||
249 | |||
250 | procedure Vertical; |
||
251 | var |
||
252 | Y, I: Longword; |
||
253 | S: PRGBColor; |
||
254 | C: PRGBColor; |
||
255 | begin |
||
256 | I := 0; |
||
257 | S := ScreenRGBTemporary; |
||
258 | C := ScreenRGBBuffer; |
||
259 | for Y := 0 to ScreenHeight - 1 do |
||
260 | begin |
||
261 | Move(PRGBColor(S + (I shr 16) * ScreenWidth)^, C^, ScreenWidth * SizeOf(C^)); |
||
262 | Inc(I, YStep); |
||
263 | Inc(C, ScreenWidth); |
||
264 | end; |
||
265 | end; |
||
266 | |||
267 | var |
||
268 | I, J: Longint; |
||
269 | B: PByte; |
||
270 | C: PRGBColor; |
||
271 | |||
272 | begin |
||
273 | if (ScreenWidth = BUFFER_WIDTH) and (ScreenHeight = BUFFER_HEIGHT) then |
||
274 | begin |
||
275 | {перенос один в один} |
||
276 | B := @ScreenPalBuffer; |
||
277 | C := ScreenRGBBuffer; |
||
278 | for I := 0 to BUFFER_HEIGHT - 1 do |
||
279 | for J := 0 to BUFFER_WIDTH - 1 do |
||
280 | begin |
||
281 | C^ := ScreenRGBPalette[B^]; |
||
282 | Inc(B); |
||
283 | Inc(C); |
||
284 | end; |
||
285 | end else |
||
286 | begin |
||
287 | {масштабирование} |
||
288 | XStep := (BUFFER_WIDTH shl 16) div ScreenWidth; |
||
289 | YStep := (BUFFER_HEIGHT shl 16) div ScreenHeight; |
||
290 | Horizontal; |
||
291 | Vertical; |
||
292 | end; |
||
293 | |||
294 | Paint; |
||
295 | end; |
||
296 | |||
297 | |||
775 | bw | 298 | procedure ImagePut(var Screen, ImageBuffer; X, Y, WinX1, WinY1, WinX2, WinY2: Integer); |
762 | bw | 299 | var |
775 | bw | 300 | Width, Height: Longint; |
762 | bw | 301 | I, J, K: Integer; |
302 | P: Pointer; |
||
303 | begin |
||
304 | Width := PWord(@ImageBuffer)[0]; |
||
305 | Height := PWord(@ImageBuffer)[1]; |
||
306 | |||
307 | P := @ImageBuffer + 4; |
||
308 | for I := Y to Y + Height - 1 do |
||
309 | begin |
||
310 | if (I >= 0) and (I < BUFFER_HEIGHT) and (I >= WinY1) and (I <= WinY2) then |
||
311 | begin |
||
312 | if X < WinX1 then |
||
313 | J := WinX1 - X else |
||
314 | J := 0; |
||
775 | bw | 315 | if X + Width - 1 > WinX2 then |
316 | K := WinX2 - X - J + 1 else |
||
317 | K := Width - J; |
||
762 | bw | 318 | Move((P + J)^, (@Screen + I * BUFFER_WIDTH + X + J)^, K); |
319 | end; |
||
320 | Inc(P, Width); |
||
321 | end; |
||
322 | end; |
||
323 | |||
324 | |||
775 | bw | 325 | procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y, WinX1, WinY1, WinX2, WinY2: Integer); |
762 | bw | 326 | var |
775 | bw | 327 | Width, Height: Longint; |
762 | bw | 328 | I, J, K, L: Integer; |
329 | PI, PO: PByte; |
||
330 | begin |
||
331 | Width := PWord(@ImageBuffer)[0]; |
||
332 | Height := PWord(@ImageBuffer)[1]; |
||
333 | |||
334 | PI := @ImageBuffer + 4; |
||
335 | |||
336 | for I := Y to Y + Height - 1 do |
||
337 | begin |
||
338 | if (I >= 0) and (I < BUFFER_HEIGHT) and (I >= WinY1) and (I <= WinY2) then |
||
339 | begin |
||
340 | if X < WinX1 then |
||
341 | J := WinX1 - X else |
||
342 | J := 0; |
||
775 | bw | 343 | if X + Width - 1 > WinX2 then |
344 | K := WinX2 - X - J + 1 else |
||
345 | K := Width - J; |
||
762 | bw | 346 | |
347 | Inc(PI, J); |
||
348 | PO := @Screen + I * BUFFER_WIDTH + X + J; |
||
349 | for L := 1 to K do |
||
350 | begin |
||
351 | if PI^ > 0 then |
||
352 | PO^ := PI^; |
||
353 | Inc(PI); |
||
354 | Inc(PO); |
||
355 | end; |
||
356 | Dec(PI, J + K); |
||
357 | end; |
||
358 | Inc(PI, Width); |
||
359 | end; |
||
360 | end; |
||
361 | |||
362 | |||
363 | procedure ImageFill(var ImageBuffer; SizeX, SizeY: Word; Value: Byte); |
||
364 | begin |
||
365 | PWord(@ImageBuffer)^ := SizeX; |
||
366 | PWord(@ImageBuffer + 2)^ := SizeY; |
||
367 | FillChar((@ImageBuffer + 4)^, SizeX * SizeY, Value); |
||
368 | end; |
||
369 | |||
370 | |||
371 | function ImageSizeX(var ImageBuffer): Word; |
||
372 | begin |
||
373 | Result := PWord(@ImageBuffer)^; |
||
374 | end; |
||
375 | |||
376 | |||
377 | function ImageSizeY(var ImageBuffer): Word; |
||
378 | begin |
||
379 | Result := PWord(@ImageBuffer + 2)^; |
||
380 | end; |
||
381 | |||
382 | |||
383 | procedure ImageStringGet(Source: String; var FontData, Buffer; ColorOffs: Byte); |
||
384 | var |
||
385 | Width, Height: Word; |
||
386 | Table: PWord; |
||
387 | P, B: PByte; |
||
388 | X, I, J, K, C: Word; |
||
389 | begin |
||
390 | Height := PWord(@FontData + 2)^; |
||
391 | Table := PWord(@FontData + 4); |
||
392 | |||
393 | { расчет длины строки } |
||
394 | Width := 0; |
||
395 | for I := 1 to Length(Source) do |
||
396 | begin |
||
397 | P := @Table[Ord(Source[I])]; |
||
398 | Inc(Width, PWord(P + PWord(P)^)^); |
||
399 | end; |
||
400 | |||
401 | PWord(@Buffer)^ := Width; |
||
402 | PWord(@Buffer + 2)^ := Height; |
||
403 | |||
404 | { вывод строки } |
||
405 | X := 0; |
||
406 | for I := 1 to Length(Source) do |
||
407 | begin |
||
408 | P := @Table[Ord(Source[I])]; |
||
409 | B := PByte(P + PWord(P)^); |
||
410 | C := PWord(B)^; |
||
411 | Inc(B, 2); |
||
412 | |||
413 | P := PByte(@Buffer + 4 + X); |
||
414 | for K := 0 to Height - 1 do |
||
415 | begin |
||
416 | for J := 0 to C - 1 do |
||
417 | begin |
||
418 | if B^ = 0 then |
||
419 | P^ := 0 else |
||
420 | P^ := B^ + ColorOffs; |
||
421 | Inc(P); |
||
422 | Inc(B); |
||
423 | end; |
||
424 | Inc(P, Width - C); |
||
425 | end; |
||
426 | |||
427 | Inc(X, C); |
||
428 | end; |
||
429 | end; |
||
430 | |||
431 | procedure ScreenApply(var Buffer); |
||
432 | begin |
||
433 | Move(Buffer, ScreenPalBuffer, SizeOf(ScreenPalBuffer)); |
||
434 | UpdateRGBBuffer; |
||
435 | end; |
||
436 | |||
437 | procedure ImageClear(var Buffer); |
||
438 | begin |
||
439 | FillChar(Buffer, BUFFER_WIDTH * BUFFER_HEIGHT, 0); |
||
440 | end; |
||
441 | |||
442 | procedure ScreenMode(Mode: Integer); |
||
443 | var |
||
444 | ThreadInfo: TKosThreadInfo; |
||
445 | begin |
||
446 | if Mode <> CurrentScreenMode then |
||
447 | begin |
||
448 | if Assigned(ScreenRGBBuffer) then FreeMem(ScreenRGBBuffer); |
||
449 | if Assigned(ScreenRGBTemporary) then FreeMem(ScreenRGBTemporary); |
||
450 | |||
451 | case Mode of |
||
452 | -2: begin |
||
453 | ScreenWidth := BUFFER_WIDTH div 2; |
||
454 | ScreenHeight := BUFFER_HEIGHT div 2; |
||
455 | end; |
||
456 | 1..3: begin |
||
457 | ScreenWidth := BUFFER_WIDTH * Mode; |
||
458 | ScreenHeight := BUFFER_HEIGHT * Mode; |
||
459 | end; |
||
460 | end; |
||
461 | |||
462 | if CurrentScreenMode = 0 then Paint; |
||
463 | |||
464 | kos_threadinfo(@ThreadInfo); |
||
465 | |||
466 | with ThreadInfo, WindowRect do |
||
467 | begin |
||
468 | WindowWidth := Width - ClientRect.Width + Longint(ScreenWidth); |
||
469 | WindowHeight := Height - ClientRect.Height + Longint(ScreenHeight); |
||
470 | kos_movewindow(Left, Top, WindowWidth, WindowHeight); |
||
471 | end; |
||
472 | |||
473 | CurrentScreenMode := Mode; |
||
474 | |||
475 | ScreenRGBBuffer := GetMem(ScreenWidth * ScreenHeight * SizeOf(ScreenRGBBuffer^)); |
||
476 | ScreenRGBTemporary := GetMem(ScreenWidth * BUFFER_HEIGHT * SizeOf(ScreenRGBTemporary^)); |
||
477 | |||
478 | UpdateRGBBuffer; |
||
479 | end; |
||
480 | end; |
||
481 | |||
482 | |||
483 | |||
775 | bw | 484 | function ScanToChar(Code: Word): Char; |
485 | var |
||
486 | I: Word; |
||
487 | begin |
||
488 | for I := Low(ScanToCharTable) to High(ScanToCharTable) do |
||
489 | with ScanToCharTable[I] do |
||
490 | if Scan = Code then |
||
491 | begin |
||
492 | if not CapsPressed then |
||
493 | if not ShiftDown then |
||
494 | Result := CL else |
||
495 | Result := CU |
||
496 | else |
||
497 | if not ShiftDown then |
||
498 | if not Caps then |
||
499 | Result := CL else |
||
500 | Result := CU |
||
501 | else |
||
502 | if not Caps then |
||
503 | Result := CL else |
||
504 | Result := CL; |
||
505 | Exit; |
||
506 | end; |
||
507 | Result := #0; |
||
508 | end; |
||
509 | |||
762 | bw | 510 | procedure KeyboardInitialize; |
511 | begin |
||
512 | kos_setkeyboardmode(1); |
||
513 | end; |
||
514 | |||
515 | function ReadKeyLoop: Word; |
||
516 | var |
||
517 | Event: Word; |
||
518 | begin |
||
519 | kos_maskevents(ME_PAINT or ME_KEYBOARD); |
||
520 | repeat |
||
521 | Event := kos_getevent(); |
||
522 | if Event = SE_PAINT then Paint; |
||
523 | until Event = SE_KEYBOARD; |
||
524 | Result := kos_getkey(); |
||
525 | end; |
||
526 | |||
527 | function TranslateKey(Key: Word): Word; |
||
528 | begin |
||
529 | if Key = KEY_GREY then |
||
530 | Result := kos_getkey() else |
||
531 | Result := Key; |
||
532 | |||
533 | LastKeyDown := Result < KEY_UP_BASE; |
||
534 | LastKeyUp := not LastKeyDown; |
||
535 | if LastKeyUp then Dec(Result, KEY_UP_BASE); |
||
536 | |||
537 | if Result = KEY_ALT then |
||
538 | begin |
||
539 | AltDown := LastKeyDown; |
||
540 | Result := $FFFF; |
||
541 | end else |
||
542 | |||
543 | if Result = KEY_LSHIFT then |
||
544 | begin |
||
545 | LShiftDown := LastKeyDown; |
||
546 | ShiftDown := LShiftDown or RShiftDown; |
||
547 | Result := $FFFF; |
||
548 | end else |
||
549 | |||
550 | if Result = KEY_RSHIFT then |
||
551 | begin |
||
552 | RShiftDown := LastKeyDown; |
||
553 | ShiftDown := LShiftDown or RShiftDown; |
||
554 | Result := $FFFF; |
||
555 | end else |
||
556 | |||
557 | if AltDown then |
||
558 | case Result of |
||
559 | KEY_1: begin Result := $FFFF; if LastKeyDown then ScreenMode(1); end; |
||
560 | KEY_2: begin Result := $FFFF; if LastKeyDown then ScreenMode(2); end; |
||
561 | KEY_3: begin Result := $FFFF; if LastKeyDown then ScreenMode(3); end; |
||
562 | KEY_9: begin Result := $FFFF; if LastKeyDown then ScreenMode(-2); end; |
||
563 | KEY_0: begin Result := $FFFF; if LastKeyDown then ScreenMode(100); end; |
||
564 | end; |
||
565 | end; |
||
566 | |||
567 | function Keypressed: Boolean; |
||
568 | begin |
||
569 | if (LastKeyEvent < KEY_UP_BASE) and LastKeyDown then |
||
570 | Result := True else |
||
571 | begin |
||
572 | kos_maskevents(ME_KEYBOARD); |
||
573 | if kos_getevent(False) = SE_KEYBOARD then |
||
574 | begin |
||
575 | LastKeyEvent := TranslateKey(kos_getkey()); |
||
576 | if LastKeyEvent < KEY_UP_BASE then |
||
577 | Result := LastKeyDown else |
||
578 | Result := False; |
||
579 | end else |
||
580 | begin |
||
581 | LastKeyEvent := $FFFF; |
||
582 | Result := False; |
||
583 | end; |
||
584 | end; |
||
585 | end; |
||
586 | |||
587 | function ReadKey: Word; |
||
588 | begin |
||
589 | repeat |
||
590 | if LastKeyEvent < KEY_UP_BASE then |
||
591 | Result := LastKeyEvent else |
||
592 | Result := TranslateKey(ReadKeyLoop); |
||
593 | LastKeyEvent := $FFFF; |
||
594 | until (Result < KEY_UP_BASE) and LastKeyDown; |
||
595 | end; |
||
596 | |||
597 | procedure KeyboardFlush; |
||
598 | begin |
||
599 | end; |
||
600 | |||
775 | bw | 601 | procedure ProcessKeyboard; |
602 | begin |
||
603 | LastKeyEvent := TranslateKey(kos_getkey()); |
||
604 | end; |
||
605 | |||
606 | |||
607 | |||
608 | const |
||
609 | MK_LBUTTON = 1; |
||
610 | MK_RBUTTON = 2; |
||
611 | MK_MBUTTON = 4; |
||
612 | MouseButtonsCount = 3; |
||
613 | |||
762 | bw | 614 | var |
775 | bw | 615 | MouseButtonsState : DWord; |
616 | MouseButtonsPressed : array[1..MouseButtonsCount] of DWord; |
||
617 | MouseButtonsReleased: array[1..MouseButtonsCount] of DWord; |
||
618 | |||
619 | |||
620 | procedure ProcessMouse; |
||
621 | var |
||
622 | I: Longint; |
||
623 | Buttons, ButtonMask: DWord; |
||
624 | NowPressed, WasPressed: Boolean; |
||
762 | bw | 625 | begin |
775 | bw | 626 | Buttons := kos_getmousebuttons(); |
627 | |||
628 | for I := 1 to MouseButtonsCount do |
||
762 | bw | 629 | begin |
775 | bw | 630 | ButtonMask := 1 shl (I - 1); |
631 | NowPressed := (Buttons and ButtonMask) <> 0; |
||
632 | WasPressed := (MouseButtonsState and ButtonMask) <> 0; |
||
633 | |||
634 | if NowPressed and not WasPressed then Inc(MouseButtonsPressed[I]) else |
||
635 | if not NowPressed and WasPressed then Inc(MouseButtonsReleased[I]); |
||
762 | bw | 636 | end; |
775 | bw | 637 | |
638 | MouseButtonsState := Buttons; |
||
762 | bw | 639 | end; |
640 | |||
775 | bw | 641 | procedure MouseInitialize; |
642 | var |
||
643 | I: Longint; |
||
644 | begin |
||
645 | MouseButtonsState := kos_getmousebuttons(); |
||
646 | for I := 1 to MouseButtonsCount do |
||
647 | begin |
||
648 | MouseButtonsPressed[I] := 0; |
||
649 | MouseButtonsReleased[I] := 0; |
||
650 | end; |
||
651 | ProcessMouse; |
||
652 | end; |
||
762 | bw | 653 | |
775 | bw | 654 | function MSMouseInArea(x1, y1, x2, y2: Integer): Boolean; |
655 | var |
||
656 | X, Y: Integer; |
||
657 | begin |
||
658 | MSMouseGetXY(X, Y); |
||
659 | Result := (X >= x1) and (X <= x2) and (Y >= y1) and (Y <= y2); |
||
660 | end; |
||
661 | |||
662 | function MSMouseDriverExist: Boolean; |
||
663 | begin |
||
664 | Result := True; |
||
665 | end; |
||
666 | |||
667 | procedure MSMouseGetXY(var X, Y: Integer); |
||
668 | var |
||
669 | WinPos: TKosPoint; |
||
670 | begin |
||
671 | WinPos := kos_getmousewinpos(); |
||
672 | |||
673 | X := Round(Double(WinPos.X) * BUFFER_WIDTH / ScreenWidth); |
||
674 | if X < 0 then X := 0 else |
||
675 | if X >= BUFFER_WIDTH then X := BUFFER_WIDTH - 1; |
||
676 | |||
677 | Y := Round(Double(WinPos.Y) * BUFFER_HEIGHT / ScreenHeight); |
||
678 | if Y < 0 then Y := 0 else |
||
679 | if Y >= BUFFER_HEIGHT then Y := BUFFER_HEIGHT - 1; |
||
680 | end; |
||
681 | |||
682 | function MSMouseButtonStatusGet: Word; |
||
683 | begin |
||
684 | Result := Word(kos_getmousebuttons()); |
||
685 | end; |
||
686 | |||
687 | function MSMouseButtonWasPressed(Button: Word; var x, y: Integer): Boolean; |
||
688 | begin |
||
689 | Inc(Button); |
||
690 | if Button < MouseButtonsCount then |
||
691 | begin |
||
692 | Result := MouseButtonsPressed[Button] > 0; |
||
693 | MouseButtonsPressed[Button] := 0; |
||
694 | end else |
||
695 | Result := False; |
||
696 | MSMouseGetXY(x, y); |
||
697 | end; |
||
698 | |||
699 | function MSMouseButtonWasReleased(Button: Word; var x, y: Integer): Boolean; |
||
700 | begin |
||
701 | Inc(Button); |
||
702 | if Button < MouseButtonsCount then |
||
703 | begin |
||
704 | Result := MouseButtonsReleased[Button] > 0; |
||
705 | MouseButtonsReleased[Button] := 0; |
||
706 | end else |
||
707 | Result := False; |
||
708 | MSMouseGetXY(x, y); |
||
709 | end; |
||
710 | |||
711 | procedure MSMouseSetXY(x, y: Integer); |
||
712 | begin |
||
713 | end; |
||
714 | |||
715 | |||
716 | |||
717 | |||
762 | bw | 718 | procedure Palette256Set(var Palette256); |
719 | var |
||
720 | I: Longint; |
||
721 | P: PRGBColor; |
||
722 | begin |
||
723 | P := @Palette256; |
||
724 | for I := 0 to 255 do |
||
725 | with ScreenRGBPalette[I] do |
||
726 | begin |
||
727 | R := Round(P^.B / 63 * 255); |
||
728 | G := Round(P^.G / 63 * 255); |
||
729 | B := Round(P^.R / 63 * 255); |
||
730 | Inc(P); |
||
731 | end; |
||
732 | UpdateRGBBuffer; |
||
733 | end; |
||
734 | |||
735 | |||
736 | procedure Palette256Get(var Palette256); |
||
737 | var |
||
738 | I: Longint; |
||
739 | P: PRGBColor; |
||
740 | begin |
||
741 | P := @Palette256; |
||
742 | for I := 0 to 255 do |
||
743 | with ScreenRGBPalette[I] do |
||
744 | begin |
||
745 | P^.R := Round(B / 255 * 63); |
||
746 | P^.G := Round(G / 255 * 63); |
||
747 | P^.B := Round(R / 255 * 63); |
||
748 | Inc(P); |
||
749 | end; |
||
750 | end; |
||
751 | |||
752 | procedure Palette256Darken(var Palette256; StartElement, EndElement, Decrement, MinValue: Byte); |
||
753 | var |
||
754 | I, J: Byte; |
||
755 | PB : PByte; |
||
756 | begin |
||
757 | PB := @Palette256; |
||
758 | Inc(PB, StartElement * 3); |
||
759 | for I := StartElement to EndElement do |
||
760 | for J := 1 to 3 do |
||
761 | begin |
||
762 | if PB^ > MinValue then |
||
763 | if PB^ < Decrement then |
||
764 | PB^ := MinValue else |
||
765 | Dec(PB^, Decrement); |
||
766 | Inc(PB); |
||
767 | end; |
||
768 | end; |
||
769 | |||
770 | procedure Palette256Transform(var SourcePalette, DestinationPalette); |
||
771 | var |
||
772 | I: Longint; |
||
773 | S, D: PByte; |
||
774 | begin |
||
775 | S := @SourcePalette; |
||
776 | D := @DestinationPalette; |
||
777 | for I := 0 to 767 do |
||
778 | begin |
||
779 | if S^ < D^ then Inc(S^) else |
||
780 | if S^ > D^ then Dec(S^); |
||
781 | Inc(S); |
||
782 | Inc(D); |
||
783 | end; |
||
784 | end; |
||
785 | |||
786 | |||
787 | function DataByteGet(var Buffer; BufferOffset: Word): Byte; |
||
788 | begin |
||
789 | Result := PByte(@Buffer + BufferOffset)^; |
||
790 | end; |
||
791 | |||
792 | procedure DataBytePut(var Buffer; BufferOffset: Word; Value: Byte); |
||
793 | begin |
||
794 | PByte(@Buffer + BufferOffset)^ := Value; |
||
795 | end; |
||
796 | |||
797 | function DataWordGet(var Buffer; BufferOffset: Word): Word; |
||
798 | begin |
||
799 | Result := PWord(@Buffer + BufferOffset)^; |
||
800 | end; |
||
801 | |||
802 | procedure DataWordPut(var Buffer; BufferOffset: Word; Value: Word); |
||
803 | begin |
||
804 | PWord(@Buffer + BufferOffset)^ := Value; |
||
805 | end; |
||
806 | |||
807 | procedure DataMove(var Source, Destination; Count: Word; SourceOffset, DestinationOffset: Word); |
||
808 | begin |
||
809 | Move((@Source + SourceOffset)^, (@Destination + DestinationOffset)^, Count); |
||
810 | end; |
||
811 | |||
812 | procedure DataFill(var Buffer; Count: Word; Value: Byte; BufferOffset: Word); |
||
813 | begin |
||
814 | FillChar((@Buffer + BufferOffset)^, Count, Value); |
||
815 | end; |
||
816 | |||
817 | function DataIdentical(var Array1, Array2; Count: Word; Array1Offset, Array2Offset: Word): Boolean; |
||
818 | begin |
||
819 | Result := CompareByte((@Array1 + Array1Offset)^, (@Array2 + Array2Offset)^, Count) = 0; |
||
820 | end; |
||
821 | |||
822 | procedure DataAdd(var Buffer; Count: Word; Amount: Byte; BufferOffset: Word); |
||
823 | var |
||
824 | I: Word; |
||
825 | PB: PByte; |
||
826 | begin |
||
827 | PB := @Buffer + BufferOffset; |
||
828 | for I := 1 to Count do |
||
829 | begin |
||
830 | if PB^ > 0 then |
||
831 | Inc(PB^, Amount); |
||
832 | Inc(PB); |
||
833 | end; |
||
834 | end; |
||
835 | |||
836 | |||
837 | function SetInterrupt(Int: Byte; NewAddress: Pointer): Pointer; |
||
838 | begin |
||
839 | Result := nil; |
||
840 | end; |
||
841 | |||
842 | |||
843 | procedure FadeClear; |
||
844 | var |
||
845 | Pal1, Pal2: Pointer; |
||
846 | i: Integer; |
||
847 | begin |
||
848 | GetMem(Pal1, 768); |
||
849 | GetMem(Pal2, 768); |
||
850 | Palette256Get(Pal1^); |
||
851 | for i := 0 to 32 do |
||
852 | begin |
||
853 | DataMove(Pal1^, Pal2^, 768, 0, 0); |
||
854 | Palette256Darken(Pal2^, 0, 255, i * 2, 0); |
||
855 | Palette256Set(Pal2^); |
||
856 | end; |
||
857 | FreeMem(Pal1, 768); |
||
858 | FreeMem(Pal2, 768); |
||
859 | end; |
||
860 | |||
861 | procedure FadeTo(Pal: Pointer); |
||
862 | var |
||
863 | Pal1: Pointer; |
||
864 | I: Integer; |
||
865 | begin |
||
866 | GetMem(Pal1, 768); |
||
867 | Palette256Get(Pal1^); |
||
868 | for I := 0 to 32 do |
||
869 | begin |
||
870 | Palette256Transform(Pal1^, Pal^); |
||
871 | Palette256Transform(Pal1^, Pal^); |
||
872 | Palette256Set(Pal1^); |
||
873 | kos_delay(1); |
||
874 | end; |
||
875 | FreeMem(Pal1, 768); |
||
876 | end; |
||
877 | |||
878 | |||
879 | procedure DecompressRepByte(var InArray, OutArray; InArraySize: Word; var OutArraySize: Word); |
||
880 | var |
||
881 | I, J: Word; |
||
882 | PIn : PByte; |
||
883 | POut: PByte; |
||
884 | begin |
||
885 | I := 0; |
||
886 | PIn := @InArray; |
||
887 | POut := @OutArray; |
||
888 | |||
889 | while I < InArraySize do |
||
890 | begin |
||
891 | Inc(I); |
||
892 | |||
893 | if PIn^ = 0 then |
||
894 | begin |
||
895 | Inc(PIn); |
||
896 | J := PIn^; |
||
897 | Inc(I, 2); |
||
898 | Inc(PIn); |
||
899 | Inc(OutArraySize, J); |
||
900 | while J > 0 do |
||
901 | begin |
||
902 | POut^ := PIn^; |
||
903 | Inc(POut); |
||
904 | Dec(J); |
||
905 | end; |
||
906 | Inc(PIn); |
||
907 | end else |
||
908 | |||
909 | if PIn^ < 4 then |
||
910 | begin |
||
911 | J := PIn^; |
||
912 | Inc(I); |
||
913 | Inc(PIn); |
||
914 | Inc(OutArraySize, J); |
||
915 | while J > 0 do |
||
916 | begin |
||
917 | POut^ := PIn^; |
||
918 | Inc(POut); |
||
919 | Dec(J); |
||
920 | end; |
||
921 | Inc(PIn); |
||
922 | end else |
||
923 | |||
924 | begin |
||
925 | POut^ := PIn^; |
||
926 | Inc(PIn); |
||
927 | Inc(POut); |
||
928 | Inc(OutArraySize); |
||
929 | end; |
||
930 | end; |
||
931 | end; |
||
932 | |||
933 | |||
775 | bw | 934 | function GetInterrupt(Int: Byte): Pointer; |
762 | bw | 935 | begin |
775 | bw | 936 | Result := nil; |
762 | bw | 937 | end; |
938 | |||
939 | |||
775 | bw | 940 | procedure WaitForEvent(Timeout: DWord = 0); |
941 | var |
||
942 | Event: Word; |
||
762 | bw | 943 | begin |
775 | bw | 944 | kos_maskevents(ME_PAINT or ME_KEYBOARD or ME_MOUSE); |
945 | Event := kos_waitevent(Timeout); |
||
946 | case Event of |
||
947 | SE_PAINT: Paint; |
||
948 | SE_KEYBOARD: ProcessKeyboard; |
||
949 | SE_MOUSE: ProcessMouse; |
||
950 | end; |
||
762 | bw | 951 | end; |
952 | |||
953 | |||
954 | procedure AssignFile(var AFile: File; AFileName: String); |
||
955 | begin |
||
956 | Assign(AFile, IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + AFileName); |
||
957 | end; |
||
958 | |||
775 | bw | 959 | |
762 | bw | 960 | function LastDosTick(): Longword; |
961 | begin |
||
962 | Result := Round(kos_timecounter() * 0.182); |
||
963 | end; |
||
964 | |||
965 | |||
966 | end.>>>>>>>>=>=>>>>>>>>>>=>>>=>>>';> |