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