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