DEADSOFTWARE

9345bb77e51faf19992e6532d0686c45dd81ff87
[d2df-sdl.git] / src / gx / glgfx.pas
1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
2 * Understanding is not required. Only obedience.
3 *
4 * This program is free software: you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation, either version 3 of the License, or
7 * (at your option) any later version.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 *)
17 {$INCLUDE ../shared/a_modes.inc}
18 unit glgfx;
20 interface
22 uses
23 SysUtils, Classes,
24 GL, GLExt, SDL2,
25 sdlcarcass;
28 // ////////////////////////////////////////////////////////////////////////// //
29 type
30 TGxRGBA = packed record
31 public
32 r, g, b, a: Byte;
34 public
35 constructor Create (ar, ag, ab: Integer; aa: Integer=255);
37 function asUInt (): LongWord; inline;
38 function isOpaque (): Boolean; inline;
39 function isTransparent (): Boolean; inline;
41 // WARNING! This function does blending in RGB space, and RGB space is not linear!
42 // alpha value of `self` doesn't matter
43 // `aa` means: 255 for replace color, 0 for keep `self`
44 function blend (ar, ag, ab, aa: Integer): TGxRGBA; inline;
45 end;
48 // ////////////////////////////////////////////////////////////////////////// //
49 type
50 THMouseEvent = record
51 public
52 const
53 // both for but and for bstate
54 None = 0;
55 Left = $0001;
56 Right = $0002;
57 Middle = $0004;
58 WheelUp = $0008;
59 WheelDown = $0010;
61 // event types
62 type
63 TKind = (Release, Press, Motion);
65 private
66 mEaten: Boolean;
67 mCancelled: Boolean;
69 public
70 kind: TKind; // motion, press, release
71 x, y: Integer; // current mouse position
72 dx, dy: Integer; // for wheel this is wheel motion, otherwise this is relative mouse motion
73 but: Word; // current pressed/released button, or 0 for motion
74 bstate: Word; // button state BEFORE event (i.e. press/release modifications aren't done yet)
75 kstate: Word; // keyboard state (see THKeyEvent);
77 public
78 procedure intrInit (); inline; // init hidden fields
80 function press (): Boolean; inline;
81 function release (): Boolean; inline;
82 function motion (): Boolean; inline;
83 procedure eat (); inline;
84 procedure cancel (); inline;
86 public
87 property eaten: Boolean read mEaten;
88 property cancelled: Boolean read mCancelled;
89 end;
91 THKeyEvent = record
92 public
93 const
94 // modifiers
95 ModCtrl = $0001;
96 ModAlt = $0002;
97 ModShift = $0004;
98 ModHyper = $0008;
100 // event types
101 type
102 TKind = (Release, Press);
104 private
105 mEaten: Boolean;
106 mCancelled: Boolean;
108 public
109 kind: TKind;
110 scan: Word; // SDL_SCANCODE_XXX
111 sym: LongWord; // SDLK_XXX
112 x, y: Integer; // current mouse position
113 bstate: Word; // button state
114 kstate: Word; // keyboard state BEFORE event (i.e. press/release modifications aren't done yet)
116 public
117 procedure intrInit (); inline; // init hidden fields
119 function press (): Boolean; inline;
120 function release (): Boolean; inline;
121 procedure eat (); inline;
122 procedure cancel (); inline;
124 function isHot (ch: AnsiChar): Boolean;
126 public
127 property eaten: Boolean read mEaten;
128 property cancelled: Boolean read mCancelled;
129 end;
133 // ////////////////////////////////////////////////////////////////////////// //
134 // setup 2D OpenGL mode; will be called automatically in `glInit()`
135 procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
137 // the following calls MUST be paired AT ALL COSTS!
138 procedure gxBeginUIDraw (scale: Single=1.0);
139 procedure gxEndUIDraw ();
142 type
143 TScissorSave = record
144 public
145 wassc: Boolean;
146 scxywh: packed array[0..3] of GLint;
148 public
150 public
151 procedure save (enableScissoring: Boolean);
152 procedure restore ();
154 // set new scissor rect, bounded by the saved scissor rect
155 procedure combineRect (x, y, w, h: Integer);
156 end;
159 procedure oglDrawCursor ();
160 procedure oglDrawCursorAt (msX, msY: Integer);
162 // return `false` if destination rect is empty
163 // modifies rect0
164 function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
166 procedure normRGBA (var r, g, b, a: Integer); inline;
167 function setupGLColor (r, g, b, a: Integer): Boolean;
168 function setupGLColor (constref clr: TGxRGBA): Boolean;
169 function isScaled (): Boolean;
171 function textWidth6 (const s: AnsiString): Integer;
172 function textWidth8 (const s: AnsiString): Integer;
173 // return width (including last empty pixel)
174 function drawTextInternal (wdt, x, y: Integer; const s: AnsiString; constref clr: TGxRGBA; tid: GLuint; constref fontwdt: array of Byte; prop: Boolean): Integer;
175 procedure drawLine (x1, y1, x2, y2: Integer; constref clr: TGxRGBA);
176 procedure drawVLine (x, y, len: Integer; constref clr: TGxRGBA);
177 procedure drawHLine (x, y, len: Integer; constref clr: TGxRGBA);
178 procedure drawRect (x, y, w, h: Integer; constref clr: TGxRGBA);
179 procedure drawRectUI (x, y, w, h: Integer; constref clr: TGxRGBA);
180 procedure darkenRect (x, y, w, h: Integer; a: Integer);
181 procedure fillRect (x, y, w, h: Integer; constref clr: TGxRGBA);
182 function drawText6 (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
183 function drawText8 (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
184 function drawText6Prop (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
185 function drawText8Prop (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
186 // x-centered at `x`
187 function drawText6XC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
188 function drawText8XC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
189 function drawText6PropXC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
190 function drawText8PropXC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
193 // ////////////////////////////////////////////////////////////////////////// //
194 // event handlers
195 var
196 evMouseCB: procedure (var ev: THMouseEvent) = nil;
197 evKeyCB: procedure (var ev: THKeyEvent) = nil;
200 // ////////////////////////////////////////////////////////////////////////// //
201 function getMouseX (): Integer; inline;
202 function getMouseY (): Integer; inline;
203 function getButState (): Word; inline;
204 function getModState (): Word; inline;
206 function gxScreenWidth (): Integer; inline;
207 function gxScreenHeight (): Integer; inline;
210 // ////////////////////////////////////////////////////////////////////////// //
211 property
212 gMouseX: Integer read getMouseX;
213 gMouseY: Integer read getMouseY;
214 gButState: Word read getButState;
215 gModState: Word read getModState;
217 var
218 gGfxDoClear: Boolean = true;
221 // ////////////////////////////////////////////////////////////////////////// //
222 // any mods = 255: nothing was defined
223 function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString;
225 operator = (constref ev: THKeyEvent; const s: AnsiString): Boolean;
226 operator = (const s: AnsiString; constref ev: THKeyEvent): Boolean;
228 operator = (constref ev: THMouseEvent; const s: AnsiString): Boolean;
229 operator = (const s: AnsiString; constref ev: THMouseEvent): Boolean;
232 implementation
235 var
236 curButState: Word = 0;
237 curModState: Word = 0;
238 curMsX: Integer = 0;
239 curMsY: Integer = 0;
242 // ////////////////////////////////////////////////////////////////////////// //
243 function gxScreenWidth (): Integer; inline; begin result := gScrWidth; end;
244 function gxScreenHeight (): Integer; inline; begin result := gScrHeight; end;
247 // ////////////////////////////////////////////////////////////////////////// //
248 function strEquCI (const s0, s1: AnsiString): Boolean;
249 var
250 f: Integer;
251 c0, c1: AnsiChar;
252 begin
253 result := (Length(s0) = Length(s1));
254 if result then
255 begin
256 for f := 1 to Length(s0) do
257 begin
258 c0 := s0[f];
259 if (c0 >= 'a') and (c0 <= 'z') then Dec(c0, 32); // poor man's `toupper()`
260 c1 := s1[f];
261 if (c1 >= 'a') and (c1 <= 'z') then Dec(c1, 32); // poor man's `toupper()`
262 if (c0 <> c1) then begin result := false; exit; end;
263 end;
264 end;
265 end;
268 // ////////////////////////////////////////////////////////////////////////// //
269 function getMouseX (): Integer; inline; begin result := curMsX; end;
270 function getMouseY (): Integer; inline; begin result := curMsY; end;
271 function getButState (): Word; inline; begin result := curButState; end;
272 function getModState (): Word; inline; begin result := curModState; end;
275 // ////////////////////////////////////////////////////////////////////////// //
276 procedure THMouseEvent.intrInit (); inline; begin mEaten := false; mCancelled := false; end;
277 function THMouseEvent.press (): Boolean; inline; begin result := (kind = TKind.Press); end;
278 function THMouseEvent.release (): Boolean; inline; begin result := (kind = TKind.Release); end;
279 function THMouseEvent.motion (): Boolean; inline; begin result := (kind = TKind.Motion); end;
280 procedure THMouseEvent.eat (); inline; begin mEaten := true; end;
281 procedure THMouseEvent.cancel (); inline; begin mCancelled := true; end;
283 procedure THKeyEvent.intrInit (); inline; begin mEaten := false; mCancelled := false; end;
284 function THKeyEvent.press (): Boolean; inline; begin result := (kind = TKind.Press); end;
285 function THKeyEvent.release (): Boolean; inline; begin result := (kind = TKind.Release); end;
286 procedure THKeyEvent.eat (); inline; begin mEaten := true; end;
287 procedure THKeyEvent.cancel (); inline; begin mCancelled := true; end;
289 function THKeyEvent.isHot (ch: AnsiChar): Boolean;
290 begin
291 case scan of
292 SDL_SCANCODE_A: result := (ch = 'A') or (ch = 'a') or (ch = 'Ô') or (ch = 'ô');
293 SDL_SCANCODE_B: result := (ch = 'B') or (ch = 'b') or (ch = 'È') or (ch = 'è');
294 SDL_SCANCODE_C: result := (ch = 'C') or (ch = 'c') or (ch = 'Ñ') or (ch = 'ñ');
295 SDL_SCANCODE_D: result := (ch = 'D') or (ch = 'd') or (ch = 'Â') or (ch = 'â');
296 SDL_SCANCODE_E: result := (ch = 'E') or (ch = 'e') or (ch = 'Ó') or (ch = 'ó');
297 SDL_SCANCODE_F: result := (ch = 'F') or (ch = 'f') or (ch = 'À') or (ch = 'à');
298 SDL_SCANCODE_G: result := (ch = 'G') or (ch = 'g') or (ch = 'Ï') or (ch = 'ï');
299 SDL_SCANCODE_H: result := (ch = 'H') or (ch = 'h') or (ch = 'Ð') or (ch = 'ð');
300 SDL_SCANCODE_I: result := (ch = 'I') or (ch = 'i') or (ch = 'Ø') or (ch = 'ø');
301 SDL_SCANCODE_J: result := (ch = 'J') or (ch = 'j') or (ch = 'Î') or (ch = 'î');
302 SDL_SCANCODE_K: result := (ch = 'K') or (ch = 'k') or (ch = 'Ë') or (ch = 'ë');
303 SDL_SCANCODE_L: result := (ch = 'L') or (ch = 'l') or (ch = 'Ä') or (ch = 'ä');
304 SDL_SCANCODE_M: result := (ch = 'M') or (ch = 'm') or (ch = 'Ü') or (ch = 'ü');
305 SDL_SCANCODE_N: result := (ch = 'N') or (ch = 'n') or (ch = 'Ò') or (ch = 'ò');
306 SDL_SCANCODE_O: result := (ch = 'O') or (ch = 'o') or (ch = 'Ù') or (ch = 'ù');
307 SDL_SCANCODE_P: result := (ch = 'P') or (ch = 'p') or (ch = 'Ç') or (ch = 'ç');
308 SDL_SCANCODE_Q: result := (ch = 'Q') or (ch = 'q') or (ch = 'É') or (ch = 'é');
309 SDL_SCANCODE_R: result := (ch = 'R') or (ch = 'r') or (ch = 'Ê') or (ch = 'ê');
310 SDL_SCANCODE_S: result := (ch = 'S') or (ch = 's') or (ch = 'Û') or (ch = 'û');
311 SDL_SCANCODE_T: result := (ch = 'T') or (ch = 't') or (ch = 'Å') or (ch = 'å');
312 SDL_SCANCODE_U: result := (ch = 'U') or (ch = 'u') or (ch = 'Ã') or (ch = 'ã');
313 SDL_SCANCODE_V: result := (ch = 'V') or (ch = 'v') or (ch = 'Ì') or (ch = 'ì');
314 SDL_SCANCODE_W: result := (ch = 'W') or (ch = 'w') or (ch = 'Ö') or (ch = 'ö');
315 SDL_SCANCODE_X: result := (ch = 'X') or (ch = 'x') or (ch = '×') or (ch = '÷');
316 SDL_SCANCODE_Y: result := (ch = 'Y') or (ch = 'y') or (ch = 'Í') or (ch = 'í');
317 SDL_SCANCODE_Z: result := (ch = 'Z') or (ch = 'z') or (ch = 'ß') or (ch = 'ÿ');
319 SDL_SCANCODE_1: result := (ch = '1') or (ch = '!');
320 SDL_SCANCODE_2: result := (ch = '2') or (ch = '@');
321 SDL_SCANCODE_3: result := (ch = '3') or (ch = '#');
322 SDL_SCANCODE_4: result := (ch = '4') or (ch = '$');
323 SDL_SCANCODE_5: result := (ch = '5') or (ch = '%');
324 SDL_SCANCODE_6: result := (ch = '6') or (ch = '^');
325 SDL_SCANCODE_7: result := (ch = '7') or (ch = '&');
326 SDL_SCANCODE_8: result := (ch = '8') or (ch = '*');
327 SDL_SCANCODE_9: result := (ch = '9') or (ch = '(');
328 SDL_SCANCODE_0: result := (ch = '0') or (ch = ')');
330 SDL_SCANCODE_RETURN: result := (ch = #13) or (ch = #10);
331 SDL_SCANCODE_ESCAPE: result := (ch = #27);
332 SDL_SCANCODE_BACKSPACE: result := (ch = #8);
333 SDL_SCANCODE_TAB: result := (ch = #9);
334 SDL_SCANCODE_SPACE: result := (ch = ' ');
336 SDL_SCANCODE_MINUS: result := (ch = '-');
337 SDL_SCANCODE_EQUALS: result := (ch = '=');
338 SDL_SCANCODE_LEFTBRACKET: result := (ch = '[') or (ch = '{');
339 SDL_SCANCODE_RIGHTBRACKET: result := (ch = ']') or (ch = '}');
340 SDL_SCANCODE_BACKSLASH, SDL_SCANCODE_NONUSHASH: result := (ch = '\') or (ch = '|');
341 SDL_SCANCODE_SEMICOLON: result := (ch = ';') or (ch = ':');
342 SDL_SCANCODE_APOSTROPHE: result := (ch = '''') or (ch = '"');
343 SDL_SCANCODE_GRAVE: result := (ch = '`') or (ch = '~');
344 SDL_SCANCODE_COMMA: result := (ch = ',') or (ch = '<');
345 SDL_SCANCODE_PERIOD: result := (ch = '.') or (ch = '>');
346 SDL_SCANCODE_SLASH: result := (ch = '/') or (ch = '?');
348 else result := false;
349 end;
350 end;
353 // ////////////////////////////////////////////////////////////////////////// //
354 constructor TGxRGBA.Create (ar, ag, ab: Integer; aa: Integer=255);
355 begin
356 if (ar < 0) then r := 0 else if (ar > 255) then r := 255 else r := Byte(ar);
357 if (ag < 0) then g := 0 else if (ag > 255) then g := 255 else g := Byte(ag);
358 if (ab < 0) then b := 0 else if (ab > 255) then b := 255 else b := Byte(ab);
359 if (aa < 0) then a := 0 else if (aa > 255) then a := 255 else a := Byte(aa);
360 end;
362 function TGxRGBA.asUInt (): LongWord; inline; begin result := LongWord(r) or (LongWord(g) shl 8) or (LongWord(b) shl 16) or (LongWord(a) shl 24); end;
364 function TGxRGBA.isOpaque (): Boolean; inline; begin result := (a = 255); end;
365 function TGxRGBA.isTransparent (): Boolean; inline; begin result := (a = 0); end;
367 function TGxRGBA.blend (ar, ag, ab, aa: Integer): TGxRGBA; inline;
368 var
369 me, it, a_tmp_, dc_tmp_, srb_tmp_, sg_tmp_, drb_tmp_, dg_tmp_, orb_tmp_, og_tmp_: LongWord;
370 begin
371 if (aa <= 0) then begin result := self; exit; end;
372 result := TGxRGBA.Create(ar, ag, ab, aa);
373 if (aa >= 255) then begin result.a := a; exit; end;
374 me := asUInt;
375 it := result.asUInt;
376 a_tmp_ := (256-(255-(it shr 24))) and (-(1-(((255-(it shr 24))+1) shr 8))); // to not loose bits, but 255 should become 0
377 dc_tmp_ := me and $ffffff;
378 srb_tmp_ := (it and $ff00ff);
379 sg_tmp_ := (it and $00ff00);
380 drb_tmp_ := (dc_tmp_ and $ff00ff);
381 dg_tmp_ := (dc_tmp_ and $00ff00);
382 orb_tmp_ := (drb_tmp_+(((srb_tmp_-drb_tmp_)*a_tmp_+$800080) shr 8)) and $ff00ff;
383 og_tmp_ := (dg_tmp_+(((sg_tmp_-dg_tmp_)*a_tmp_+$008000) shr 8)) and $00ff00;
384 me := (orb_tmp_ or og_tmp_); // or $ff000000; /* and $ffffff;*/
385 result.r := Byte(me and $ff);
386 result.g := Byte((me shr 8) and $ff);
387 result.b := Byte((me shr 16) and $ff);
388 result.a := a;
389 end;
392 // ////////////////////////////////////////////////////////////////////////// //
393 // any mods = 255: nothing was defined
394 function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString;
395 var
396 pos, epos: Integer;
397 begin
398 kmods := 255;
399 mbuts := 255;
400 pos := 1;
401 //while (pos <= Length(s)) and (s[pos] <= ' ') do Inc(pos);
402 if (pos < Length(s)) and ((s[pos] = '+') or (s[pos] = '-') or (s[pos] = '*')) then Inc(pos);
403 while (pos <= Length(s)) do
404 begin
405 if (Length(s)-pos >= 1) and (s[pos+1] = '-') then
406 begin
407 case s[pos] of
408 'C', 'c': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModCtrl; Inc(pos, 2); continue; end;
409 'M', 'm': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModAlt; Inc(pos, 2); continue; end;
410 'S', 's': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModShift; Inc(pos, 2); continue; end;
411 end;
412 break;
413 end;
414 if (Length(s)-pos >= 3) and (s[pos+3] = '-') and ((s[pos+1] = 'M') or (s[pos+1] = 'm')) and ((s[pos+2] = 'B') or (s[pos+2] = 'b')) then
415 begin
416 case s[pos] of
417 'L', 'l': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Left; Inc(pos, 4); continue; end;
418 'R', 'r': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Right; Inc(pos, 4); continue; end;
419 'M', 'm': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Middle; Inc(pos, 4); continue; end;
420 end;
421 break;
422 end;
423 break;
424 end;
425 epos := Length(s)+1;
426 while (epos > pos) and (s[epos-1] <= ' ') do Dec(epos);
427 if (epos > pos) then result := Copy(s, pos, epos-pos) else result := '';
428 end;
431 operator = (constref ev: THKeyEvent; const s: AnsiString): Boolean;
432 var
433 f: Integer;
434 kmods: Byte = 255;
435 mbuts: Byte = 255;
436 kname: AnsiString;
437 begin
438 result := false;
439 if (Length(s) > 0) then
440 begin
441 if (s[1] = '+') then begin if (not ev.press) then exit; end
442 else if (s[1] = '-') then begin if (not ev.release) then exit; end
443 else if (s[1] = '*') then begin end
444 else if (not ev.press) then exit;
445 end;
446 kname := parseModKeys(s, kmods, mbuts);
447 if (kmods = 255) then kmods := 0;
448 if (ev.kstate <> kmods) then exit;
449 if (mbuts <> 255) and (ev.bstate <> mbuts) then exit;
451 if (strEquCI(kname, 'Enter')) then kname := 'RETURN';
453 for f := 0 to SDL_NUM_SCANCODES-1 do
454 begin
455 if strEquCI(kname, SDL_GetScancodeName(f)) then
456 begin
457 result := (ev.scan = f);
458 exit;
459 end;
460 end;
461 end;
464 operator = (const s: AnsiString; constref ev: THKeyEvent): Boolean;
465 begin
466 result := (ev = s);
467 end;
470 operator = (constref ev: THMouseEvent; const s: AnsiString): Boolean;
471 var
472 kmods: Byte = 255;
473 mbuts: Byte = 255;
474 kname: AnsiString;
475 but: Integer = -1;
476 modch: AnsiChar = ' ';
477 begin
478 result := false;
480 if (Length(s) > 0) then
481 begin
482 if (s[1] = '+') then begin if (not ev.press) then exit; modch := '+'; end
483 else if (s[1] = '-') then begin if (not ev.release) then exit; modch := '-'; end
484 else if (s[1] = '*') then begin if (not ev.motion) then exit; end
485 else if (not ev.press) then exit;
486 end;
488 kname := parseModKeys(s, kmods, mbuts);
489 if strEquCI(kname, 'LMB') then but := THMouseEvent.Left
490 else if strEquCI(kname, 'RMB') then but := THMouseEvent.Right
491 else if strEquCI(kname, 'MMB') then but := THMouseEvent.Middle
492 else if strEquCI(kname, 'WheelUp') or strEquCI(kname, 'WUP') then but := THMouseEvent.WheelUp
493 else if strEquCI(kname, 'WheelDown') or strEquCI(kname, 'WDN') or strEquCI(kname, 'WDOWN') then but := THMouseEvent.WheelDown
494 else if strEquCI(kname, 'None') then but := 0
495 else exit;
497 if (mbuts = 255) then mbuts := 0;
498 if (kmods = 255) then kmods := 0;
499 if (ev.kstate <> kmods) then exit;
500 if (modch = '-') then mbuts := mbuts or but else if (modch = '+') then mbuts := mbuts and (not but);
502 result := (ev.bstate = mbuts) and (ev.but = but);
503 end;
506 operator = (const s: AnsiString; constref ev: THMouseEvent): Boolean;
507 begin
508 result := (ev = s);
509 end;
512 // ////////////////////////////////////////////////////////////////////////// //
513 procedure resetKMState (sendEvents: Boolean=true);
514 var
515 mask: Word;
516 mev: THMouseEvent;
517 kev: THKeyEvent;
518 begin
519 // generate mouse release events
520 if (curButState <> 0) then
521 begin
522 if sendEvents then
523 begin
524 mask := 1;
525 while (mask <> 0) do
526 begin
527 // checked each time, 'cause `evMouseCB` can be changed from the handler
528 if ((curButState and mask) <> 0) and assigned(evMouseCB) then
529 begin
530 FillChar(mev, sizeof(mev), 0);
531 mev.intrInit();
532 mev.kind := mev.TKind.Release;
533 mev.x := curMsX;
534 mev.y := curMsY;
535 mev.dx := 0;
536 mev.dy := 0;
537 mev.but := mask;
538 mev.bstate := curButState;
539 mev.kstate := curModState;
540 curButState := curButState and (not mask);
541 evMouseCB(mev);
542 end;
543 mask := mask shl 1;
544 end;
545 end;
546 curButState := 0;
547 end;
549 // generate modifier release events
550 if (curModState <> 0) then
551 begin
552 if sendEvents then
553 begin
554 mask := 1;
555 while (mask <= 8) do
556 begin
557 // checked each time, 'cause `evMouseCB` can be changed from the handler
558 if ((curModState and mask) <> 0) and assigned(evKeyCB) then
559 begin
560 FillChar(kev, sizeof(kev), 0);
561 kev.intrInit();
562 kev.kind := kev.TKind.Release;
563 case mask of
564 THKeyEvent.ModCtrl: begin kev.scan := SDL_SCANCODE_LCTRL; kev.sym := SDLK_LCTRL;{arbitrary} end;
565 THKeyEvent.ModAlt: begin kev.scan := SDL_SCANCODE_LALT; kev.sym := SDLK_LALT;{arbitrary} end;
566 THKeyEvent.ModShift: begin kev.scan := SDL_SCANCODE_LSHIFT; kev.sym := SDLK_LSHIFT;{arbitrary} end;
567 THKeyEvent.ModHyper: begin kev.scan := SDL_SCANCODE_LGUI; kev.sym := SDLK_LGUI;{arbitrary} end;
568 else assert(false);
569 end;
570 kev.x := curMsX;
571 kev.y := curMsY;
572 mev.bstate := 0{curMsButState}; // anyway
573 mev.kstate := curModState;
574 curModState := curModState and (not mask);
575 evKeyCB(kev);
576 end;
577 mask := mask shl 1;
578 end;
579 end;
580 curModState := 0;
581 end;
582 end;
585 function onSDLEvent (var ev: TSDL_Event): Boolean;
586 var
587 mev: THMouseEvent;
588 kev: THKeyEvent;
590 function buildBut (b: Byte): Word;
591 begin
592 result := 0;
593 case b of
594 SDL_BUTTON_LEFT: result := result or THMouseEvent.Left;
595 SDL_BUTTON_MIDDLE: result := result or THMouseEvent.Middle;
596 SDL_BUTTON_RIGHT: result := result or THMouseEvent.Right;
597 end;
598 end;
600 begin
601 result := false;
603 case ev.type_ of
604 SDL_KEYDOWN, SDL_KEYUP:
605 begin
606 // fix left/right modifiers
607 FillChar(kev, sizeof(kev), 0);
608 kev.intrInit();
609 if (ev.type_ = SDL_KEYDOWN) then kev.kind := THKeyEvent.TKind.Press else kev.kind := THKeyEvent.TKind.Release;
610 kev.scan := ev.key.keysym.scancode;
611 kev.sym := ev.key.keysym.sym;
613 if (kev.scan = SDL_SCANCODE_RCTRL) then kev.scan := SDL_SCANCODE_LCTRL;
614 if (kev.scan = SDL_SCANCODE_RALT) then kev.scan := SDL_SCANCODE_LALT;
615 if (kev.scan = SDL_SCANCODE_RSHIFT) then kev.scan := SDL_SCANCODE_LSHIFT;
616 if (kev.scan = SDL_SCANCODE_RGUI) then kev.scan := SDL_SCANCODE_LGUI;
618 if (kev.sym = SDLK_RCTRL) then kev.sym := SDLK_LCTRL;
619 if (kev.sym = SDLK_RALT) then kev.sym := SDLK_LALT;
620 if (kev.sym = SDLK_RSHIFT) then kev.sym := SDLK_LSHIFT;
621 if (kev.sym = SDLK_RGUI) then kev.sym := SDLK_LGUI;
623 kev.x := curMsX;
624 kev.y := curMsY;
625 kev.bstate := curButState;
626 kev.kstate := curModState;
628 case kev.scan of
629 SDL_SCANCODE_LCTRL: if (kev.press) then curModState := curModState or THKeyEvent.ModCtrl else curModState := curModState and (not THKeyEvent.ModCtrl);
630 SDL_SCANCODE_LALT: if (kev.press) then curModState := curModState or THKeyEvent.ModAlt else curModState := curModState and (not THKeyEvent.ModAlt);
631 SDL_SCANCODE_LSHIFT: if (kev.press) then curModState := curModState or THKeyEvent.ModShift else curModState := curModState and (not THKeyEvent.ModShift);
632 end;
634 if assigned(evKeyCB) then
635 begin
636 evKeyCB(kev);
637 result := kev.eaten;
638 end;
639 end;
641 SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP:
642 begin
643 FillChar(mev, sizeof(mev), 0);
644 mev.intrInit();
645 if (ev.type_ = SDL_MOUSEBUTTONDOWN) then mev.kind := THMouseEvent.TKind.Press else mev.kind := THMouseEvent.TKind.Release;
646 mev.dx := ev.button.x-curMsX;
647 mev.dy := ev.button.y-curMsY;
648 curMsX := ev.button.x;
649 curMsY := ev.button.y;
650 mev.but := buildBut(ev.button.button);
651 mev.x := curMsX;
652 mev.y := curMsY;
653 mev.bstate := curButState;
654 mev.kstate := curModState;
655 if (mev.but <> 0) then
656 begin
657 // ev.button.clicks: Byte
658 if (ev.type_ = SDL_MOUSEBUTTONDOWN) then curButState := curButState or mev.but else curButState := curButState and (not mev.but);
659 if assigned(evMouseCB) then
660 begin
661 evMouseCB(mev);
662 result := mev.eaten;
663 end;
664 end;
665 end;
666 SDL_MOUSEWHEEL:
667 begin
668 if (ev.wheel.y <> 0) then
669 begin
670 FillChar(mev, sizeof(mev), 0);
671 mev.intrInit();
672 mev.kind := THMouseEvent.TKind.Press;
673 mev.dx := 0;
674 mev.dy := ev.wheel.y;
675 if (ev.wheel.y < 0) then mev.but := THMouseEvent.WheelUp else mev.but := THMouseEvent.WheelDown;
676 mev.x := curMsX;
677 mev.y := curMsY;
678 mev.bstate := curButState;
679 mev.kstate := curModState;
680 if assigned(evMouseCB) then
681 begin
682 evMouseCB(mev);
683 result := mev.eaten;
684 end;
685 end;
686 end;
687 SDL_MOUSEMOTION:
688 begin
689 FillChar(mev, sizeof(mev), 0);
690 mev.intrInit();
691 mev.kind := THMouseEvent.TKind.Motion;
692 mev.dx := ev.button.x-curMsX;
693 mev.dy := ev.button.y-curMsY;
694 curMsX := ev.button.x;
695 curMsY := ev.button.y;
696 mev.but := 0;
697 mev.x := curMsX;
698 mev.y := curMsY;
699 mev.bstate := curButState;
700 mev.kstate := curModState;
701 if assigned(evMouseCB) then
702 begin
703 evMouseCB(mev);
704 result := mev.eaten;
705 end;
706 end;
709 SDL_TEXTINPUT:
710 begin
711 Utf8ToUnicode(@uc, PChar(ev.text.text), 1);
712 keychr := Word(uc);
713 if (keychr > 127) then keychr := Word(wchar2win(WideChar(keychr)));
714 CharPress(AnsiChar(keychr));
715 end;
717 end;
718 end;
721 // ////////////////////////////////////////////////////////////////////////// //
722 procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
723 begin
724 glViewport(0, 0, winWidth, winHeight);
726 glDisable(GL_BLEND);
727 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
728 glDisable(GL_LINE_SMOOTH);
729 glDisable(GL_POINT_SMOOTH);
730 glDisable(GL_DEPTH_TEST);
731 glDisable(GL_TEXTURE_2D);
732 glDisable(GL_LIGHTING);
733 glDisable(GL_DITHER);
734 glDisable(GL_STENCIL_TEST);
735 glDisable(GL_SCISSOR_TEST);
736 glDisable(GL_CULL_FACE);
738 glMatrixMode(GL_PROJECTION);
739 glLoadIdentity();
740 if (upsideDown) then
741 begin
742 glOrtho(0, winWidth, 0, winHeight, -1, 1); // set origin to bottom left
743 end
744 else
745 begin
746 glOrtho(0, winWidth, winHeight, 0, -1, 1); // set origin to top left
747 end;
749 glMatrixMode(GL_MODELVIEW);
750 glLoadIdentity();
752 glClearColor(0, 0, 0, 0);
753 glColor4f(1, 1, 1, 1);
754 end;
757 procedure gxBeginUIDraw (scale: Single=1.0);
758 begin
759 glMatrixMode(GL_MODELVIEW);
760 glPushMatrix();
761 glLoadIdentity();
762 glScalef(scale, scale, 1);
763 end;
765 procedure gxEndUIDraw ();
766 begin
767 glMatrixMode(GL_MODELVIEW);
768 glPopMatrix();
769 end;
772 // ////////////////////////////////////////////////////////////////////////// //
773 // cursor (hi, Death Track!)
774 const curTexWidth = 32;
775 const curTexHeight = 32;
776 const curWidth = 17;
777 const curHeight = 23;
779 const cursorImg: array[0..curWidth*curHeight-1] of Byte = (
780 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
781 3,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
782 3,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
783 3,3,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,
784 3,3,4,2,2,0,0,0,0,0,0,0,0,0,0,0,0,
785 3,3,4,4,2,2,0,0,0,0,0,0,0,0,0,0,0,
786 3,3,4,4,4,2,2,0,0,0,0,0,0,0,0,0,0,
787 3,3,4,4,4,4,2,2,0,0,0,0,0,0,0,0,0,
788 3,3,4,4,4,5,6,2,2,0,0,0,0,0,0,0,0,
789 3,3,4,4,5,6,7,5,2,2,0,0,0,0,0,0,0,
790 3,3,4,5,6,7,5,4,5,2,2,0,0,0,0,0,0,
791 3,3,5,6,7,5,4,5,6,7,2,2,0,0,0,0,0,
792 3,3,6,7,5,4,5,6,7,7,7,2,2,0,0,0,0,
793 3,3,7,5,4,5,6,7,7,7,7,7,2,2,0,0,0,
794 3,3,5,4,5,6,8,8,8,8,8,8,8,8,2,0,0,
795 3,3,4,5,6,3,8,8,8,8,8,8,8,8,8,0,0,
796 3,3,5,6,3,3,0,0,0,0,0,0,0,0,0,0,0,
797 3,3,6,3,3,0,0,0,0,0,0,0,0,0,0,0,0,
798 3,3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0,
799 3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
800 3,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
801 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
802 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
803 );
804 const cursorPal: array[0..9*4-1] of Byte = (
805 0, 0, 0, 0,
806 0, 0, 0,163,
807 85,255,255,255,
808 85, 85,255,255,
809 255, 85, 85,255,
810 170, 0,170,255,
811 85, 85, 85,255,
812 0, 0, 0,255,
813 0, 0,170,255
814 );
817 var
818 curtexid: GLuint = 0;
820 procedure createCursorTexture ();
821 var
822 tex, tpp: PByte;
823 c: Integer;
824 x, y: Integer;
825 begin
826 if (curtexid <> 0) then exit; //begin glDeleteTextures(1, @curtexid); curtexid := 0; end;
828 GetMem(tex, curTexWidth*curTexHeight*4);
829 try
830 FillChar(tex^, curTexWidth*curTexHeight*4, 0);
832 // draw shadow
833 for y := 0 to curHeight-1 do
834 begin
835 for x := 0 to curWidth-1 do
836 begin
837 if (cursorImg[y*curWidth+x] <> 0) then
838 begin
839 c := 1*4;
840 tpp := tex+((y+1)*(curTexWidth*4)+(x+3)*4);
841 tpp^ := cursorPal[c+0]; Inc(tpp);
842 tpp^ := cursorPal[c+1]; Inc(tpp);
843 tpp^ := cursorPal[c+2]; Inc(tpp);
844 tpp^ := cursorPal[c+3]; Inc(tpp);
845 tpp^ := cursorPal[c+0]; Inc(tpp);
846 tpp^ := cursorPal[c+1]; Inc(tpp);
847 tpp^ := cursorPal[c+2]; Inc(tpp);
848 tpp^ := cursorPal[c+3]; Inc(tpp);
849 end;
850 end;
851 end;
853 // draw cursor
854 for y := 0 to curHeight-1 do
855 begin
856 for x := 0 to curWidth-1 do
857 begin
858 c := cursorImg[y*curWidth+x]*4;
859 if (c <> 0) then
860 begin
861 tpp := tex+(y*(curTexWidth*4)+x*4);
862 tpp^ := cursorPal[c+0]; Inc(tpp);
863 tpp^ := cursorPal[c+1]; Inc(tpp);
864 tpp^ := cursorPal[c+2]; Inc(tpp);
865 tpp^ := cursorPal[c+3]; Inc(tpp);
866 end;
867 end;
868 end;
870 glGenTextures(1, @curtexid);
871 if (curtexid = 0) then raise Exception.Create('can''t create cursor texture');
873 glBindTexture(GL_TEXTURE_2D, curtexid);
874 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
875 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
876 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
877 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
879 //GLfloat[4] bclr = 0.0;
880 //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr);
882 glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, curTexWidth, curTexHeight, 0, GL_RGBA{gltt}, GL_UNSIGNED_BYTE, tex);
883 glFlush();
884 finally
885 FreeMem(tex);
886 end;
887 end;
889 procedure oglDrawCursorAt (msX, msY: Integer);
890 begin
891 //if (curtexid = 0) then createCursorTexture() else glBindTexture(GL_TEXTURE_2D, curtexid);
892 glBindTexture(GL_TEXTURE_2D, curtexid);
893 // blend it
894 glEnable(GL_BLEND);
895 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
896 glEnable(GL_TEXTURE_2D);
897 glDisable(GL_STENCIL_TEST);
898 glDisable(GL_SCISSOR_TEST);
899 glDisable(GL_LIGHTING);
900 glDisable(GL_DEPTH_TEST);
901 glDisable(GL_CULL_FACE);
902 // color and opacity
903 glColor4f(1, 1, 1, 0.9);
904 //Dec(msX, 2);
905 glBegin(GL_QUADS);
906 glTexCoord2f(0.0, 0.0); glVertex2i(msX, msY); // top-left
907 glTexCoord2f(1.0, 0.0); glVertex2i(msX+curTexWidth, msY); // top-right
908 glTexCoord2f(1.0, 1.0); glVertex2i(msX+curTexWidth, msY+curTexHeight); // bottom-right
909 glTexCoord2f(0.0, 1.0); glVertex2i(msX, msY+curTexHeight); // bottom-left
910 glEnd();
911 //Inc(msX, 2);
912 glDisable(GL_BLEND);
913 glDisable(GL_TEXTURE_2D);
914 glColor4f(1, 1, 1, 1);
915 glBindTexture(GL_TEXTURE_2D, 0);
916 end;
918 procedure oglDrawCursor (); begin oglDrawCursorAt(curMsX, curMsY); end;
921 // ////////////////////////////////////////////////////////////////////////// //
922 // fonts
923 const kgiFont6: array[0..256*8-1] of Byte = (
924 $00,$00,$00,$00,$00,$00,$00,$00,$3c,$42,$a5,$81,$a5,$99,$42,$3c,$3c,$7e,$db,$ff,$ff,$db,$66,$3c,$6c,$fe,
925 $fe,$fe,$7c,$38,$10,$00,$10,$38,$7c,$fe,$7c,$38,$10,$00,$10,$38,$54,$fe,$54,$10,$38,$00,$10,$38,$7c,$fe,
926 $fe,$10,$38,$00,$00,$00,$00,$30,$30,$00,$00,$00,$ff,$ff,$ff,$e7,$e7,$ff,$ff,$ff,$38,$44,$82,$82,$82,$44,
927 $38,$00,$c7,$bb,$7d,$7d,$7d,$bb,$c7,$ff,$0f,$03,$05,$79,$88,$88,$88,$70,$38,$44,$44,$44,$38,$10,$7c,$10,
928 $30,$28,$24,$24,$28,$20,$e0,$c0,$3c,$24,$3c,$24,$24,$e4,$dc,$18,$10,$54,$38,$ee,$38,$54,$10,$00,$10,$10,
929 $10,$7c,$10,$10,$10,$10,$10,$10,$10,$ff,$00,$00,$00,$00,$00,$00,$00,$ff,$10,$10,$10,$10,$10,$10,$10,$f0,
930 $10,$10,$10,$10,$10,$10,$10,$1f,$10,$10,$10,$10,$10,$10,$10,$ff,$10,$10,$10,$10,$10,$10,$10,$10,$10,$10,
931 $10,$10,$00,$00,$00,$ff,$00,$00,$00,$00,$00,$00,$00,$1f,$10,$10,$10,$10,$00,$00,$00,$f0,$10,$10,$10,$10,
932 $10,$10,$10,$1f,$00,$00,$00,$00,$10,$10,$10,$f0,$00,$00,$00,$00,$81,$42,$24,$18,$18,$24,$42,$81,$01,$02,
933 $04,$08,$10,$20,$40,$80,$80,$40,$20,$10,$08,$04,$02,$01,$00,$10,$10,$ff,$10,$10,$00,$00,$00,$00,$00,$00,
934 $00,$00,$00,$00,$20,$20,$20,$20,$00,$00,$20,$00,$50,$50,$50,$00,$00,$00,$00,$00,$50,$50,$f8,$50,$f8,$50,
935 $50,$00,$20,$78,$a0,$70,$28,$f0,$20,$00,$c0,$c8,$10,$20,$40,$98,$18,$00,$40,$a0,$40,$a8,$90,$98,$60,$00,
936 $10,$20,$40,$00,$00,$00,$00,$00,$10,$20,$40,$40,$40,$20,$10,$00,$40,$20,$10,$10,$10,$20,$40,$00,$88,$50,
937 $20,$f8,$20,$50,$88,$00,$00,$20,$20,$f8,$20,$20,$00,$00,$00,$00,$00,$00,$00,$20,$20,$40,$00,$00,$00,$78,
938 $00,$00,$00,$00,$00,$00,$00,$00,$00,$60,$60,$00,$00,$00,$08,$10,$20,$40,$80,$00,$70,$88,$98,$a8,$c8,$88,
939 $70,$00,$20,$60,$a0,$20,$20,$20,$f8,$00,$70,$88,$08,$10,$60,$80,$f8,$00,$70,$88,$08,$30,$08,$88,$70,$00,
940 $10,$30,$50,$90,$f8,$10,$10,$00,$f8,$80,$e0,$10,$08,$10,$e0,$00,$30,$40,$80,$f0,$88,$88,$70,$00,$f8,$88,
941 $10,$20,$20,$20,$20,$00,$70,$88,$88,$70,$88,$88,$70,$00,$70,$88,$88,$78,$08,$10,$60,$00,$00,$00,$20,$00,
942 $00,$20,$00,$00,$00,$00,$20,$00,$00,$20,$20,$40,$18,$30,$60,$c0,$60,$30,$18,$00,$00,$00,$f8,$00,$f8,$00,
943 $00,$00,$c0,$60,$30,$18,$30,$60,$c0,$00,$70,$88,$08,$10,$20,$00,$20,$00,$70,$88,$08,$68,$a8,$a8,$70,$00,
944 $20,$50,$88,$88,$f8,$88,$88,$00,$f0,$48,$48,$70,$48,$48,$f0,$00,$30,$48,$80,$80,$80,$48,$30,$00,$e0,$50,
945 $48,$48,$48,$50,$e0,$00,$f8,$80,$80,$f0,$80,$80,$f8,$00,$f8,$80,$80,$f0,$80,$80,$80,$00,$70,$88,$80,$b8,
946 $88,$88,$70,$00,$88,$88,$88,$f8,$88,$88,$88,$00,$70,$20,$20,$20,$20,$20,$70,$00,$38,$10,$10,$10,$90,$90,
947 $60,$00,$88,$90,$a0,$c0,$a0,$90,$88,$00,$80,$80,$80,$80,$80,$80,$f8,$00,$88,$d8,$a8,$a8,$88,$88,$88,$00,
948 $88,$c8,$c8,$a8,$98,$98,$88,$00,$70,$88,$88,$88,$88,$88,$70,$00,$f0,$88,$88,$f0,$80,$80,$80,$00,$70,$88,
949 $88,$88,$a8,$90,$68,$00,$f0,$88,$88,$f0,$a0,$90,$88,$00,$70,$88,$80,$70,$08,$88,$70,$00,$f8,$20,$20,$20,
950 $20,$20,$20,$00,$88,$88,$88,$88,$88,$88,$70,$00,$88,$88,$88,$88,$50,$50,$20,$00,$88,$88,$88,$a8,$a8,$d8,
951 $88,$00,$88,$88,$50,$20,$50,$88,$88,$00,$88,$88,$88,$70,$20,$20,$20,$00,$f8,$08,$10,$20,$40,$80,$f8,$00,
952 $70,$40,$40,$40,$40,$40,$70,$00,$00,$00,$80,$40,$20,$10,$08,$00,$70,$10,$10,$10,$10,$10,$70,$00,$20,$50,
953 $88,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$f8,$00,$40,$20,$10,$00,$00,$00,$00,$00,$00,$00,$70,$08,
954 $78,$88,$78,$00,$80,$80,$b0,$c8,$88,$c8,$b0,$00,$00,$00,$70,$88,$80,$88,$70,$00,$08,$08,$68,$98,$88,$98,
955 $68,$00,$00,$00,$70,$88,$f8,$80,$70,$00,$10,$28,$20,$f8,$20,$20,$20,$00,$00,$00,$68,$98,$98,$68,$08,$70,
956 $80,$80,$f0,$88,$88,$88,$88,$00,$20,$00,$60,$20,$20,$20,$70,$00,$10,$00,$30,$10,$10,$10,$90,$60,$40,$40,
957 $48,$50,$60,$50,$48,$00,$60,$20,$20,$20,$20,$20,$70,$00,$00,$00,$d0,$a8,$a8,$a8,$a8,$00,$00,$00,$b0,$c8,
958 $88,$88,$88,$00,$00,$00,$70,$88,$88,$88,$70,$00,$00,$00,$b0,$c8,$c8,$b0,$80,$80,$00,$00,$68,$98,$98,$68,
959 $08,$08,$00,$00,$b0,$c8,$80,$80,$80,$00,$00,$00,$78,$80,$f0,$08,$f0,$00,$40,$40,$f0,$40,$40,$48,$30,$00,
960 $00,$00,$90,$90,$90,$90,$68,$00,$00,$00,$88,$88,$88,$50,$20,$00,$00,$00,$88,$a8,$a8,$a8,$50,$00,$00,$00,
961 $88,$50,$20,$50,$88,$00,$00,$00,$88,$88,$98,$68,$08,$70,$00,$00,$f8,$10,$20,$40,$f8,$00,$18,$20,$20,$40,
962 $20,$20,$18,$00,$20,$20,$20,$00,$20,$20,$20,$00,$c0,$20,$20,$10,$20,$20,$c0,$00,$40,$a8,$10,$00,$00,$00,
963 $00,$00,$00,$00,$20,$50,$f8,$00,$00,$00,$00,$00,$00,$00,$00,$00,$ff,$ff,$f0,$f0,$f0,$f0,$0f,$0f,$0f,$0f,
964 $00,$00,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$00,$00,$00,$00,$00,$00,$00,$00,$00,$3c,$3c,$00,$00,$00,$ff,$ff,
965 $ff,$ff,$ff,$ff,$00,$00,$c0,$c0,$c0,$c0,$c0,$c0,$c0,$c0,$0f,$0f,$0f,$0f,$f0,$f0,$f0,$f0,$fc,$fc,$fc,$fc,
966 $fc,$fc,$fc,$fc,$03,$03,$03,$03,$03,$03,$03,$03,$3f,$3f,$3f,$3f,$3f,$3f,$3f,$3f,$11,$22,$44,$88,$11,$22,
967 $44,$88,$88,$44,$22,$11,$88,$44,$22,$11,$fe,$7c,$38,$10,$00,$00,$00,$00,$00,$00,$00,$00,$10,$38,$7c,$fe,
968 $80,$c0,$e0,$f0,$e0,$c0,$80,$00,$01,$03,$07,$0f,$07,$03,$01,$00,$ff,$7e,$3c,$18,$18,$3c,$7e,$ff,$81,$c3,
969 $e7,$ff,$ff,$e7,$c3,$81,$f0,$f0,$f0,$f0,$00,$00,$00,$00,$00,$00,$00,$00,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
970 $00,$00,$00,$00,$00,$00,$00,$00,$f0,$f0,$f0,$f0,$33,$33,$cc,$cc,$33,$33,$cc,$cc,$00,$20,$20,$50,$50,$88,
971 $f8,$00,$20,$20,$70,$20,$70,$20,$20,$00,$00,$00,$00,$50,$88,$a8,$50,$00,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,
972 $00,$00,$00,$00,$ff,$ff,$ff,$ff,$f0,$f0,$f0,$f0,$f0,$f0,$f0,$f0,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$ff,$ff,
973 $ff,$ff,$00,$00,$00,$00,$00,$00,$68,$90,$90,$90,$68,$00,$30,$48,$48,$70,$48,$48,$70,$c0,$f8,$88,$80,$80,
974 $80,$80,$80,$00,$00,$50,$70,$88,$f8,$80,$70,$00,$00,$00,$78,$80,$f0,$80,$78,$00,$00,$00,$78,$90,$90,$90,
975 $60,$00,$20,$00,$60,$20,$20,$20,$70,$00,$50,$00,$70,$20,$20,$20,$70,$00,$f8,$20,$70,$a8,$a8,$70,$20,$f8,
976 $20,$50,$88,$f8,$88,$50,$20,$00,$70,$88,$88,$88,$50,$50,$d8,$00,$30,$40,$40,$20,$50,$50,$50,$20,$00,$00,
977 $00,$50,$a8,$a8,$50,$00,$08,$70,$a8,$a8,$a8,$70,$80,$00,$38,$40,$80,$f8,$80,$40,$38,$00,$70,$88,$88,$88,
978 $88,$88,$88,$00,$00,$f8,$00,$f8,$00,$f8,$00,$00,$20,$20,$f8,$20,$20,$00,$f8,$00,$c0,$30,$08,$30,$c0,$00,
979 $f8,$00,$50,$f8,$80,$f0,$80,$80,$f8,$00,$78,$80,$80,$f0,$80,$80,$78,$00,$20,$20,$20,$20,$20,$20,$a0,$40,
980 $70,$20,$20,$20,$20,$20,$70,$00,$50,$70,$20,$20,$20,$20,$70,$00,$00,$18,$24,$24,$18,$00,$00,$00,$00,$30,
981 $78,$78,$30,$00,$00,$00,$00,$00,$00,$00,$30,$00,$00,$00,$3e,$20,$20,$20,$a0,$60,$20,$00,$a0,$50,$50,$50,
982 $00,$00,$00,$00,$40,$a0,$20,$40,$e0,$00,$00,$00,$00,$38,$38,$38,$38,$38,$38,$00,$3c,$42,$99,$a1,$a1,$99,
983 $42,$3c,$00,$00,$90,$a8,$e8,$a8,$90,$00,$00,$00,$60,$10,$70,$90,$68,$00,$00,$00,$f0,$80,$f0,$88,$f0,$00,
984 $00,$00,$90,$90,$90,$f8,$08,$00,$00,$00,$30,$50,$50,$70,$88,$00,$00,$00,$70,$88,$f8,$80,$70,$00,$00,$20,
985 $70,$a8,$a8,$70,$20,$00,$00,$00,$78,$48,$40,$40,$40,$00,$00,$00,$88,$50,$20,$50,$88,$00,$00,$00,$88,$98,
986 $a8,$c8,$88,$00,$00,$50,$20,$00,$98,$a8,$c8,$00,$00,$00,$90,$a0,$c0,$a0,$90,$00,$00,$00,$38,$28,$28,$48,
987 $88,$00,$00,$00,$88,$d8,$a8,$88,$88,$00,$00,$00,$88,$88,$f8,$88,$88,$00,$00,$00,$70,$88,$88,$88,$70,$00,
988 $00,$00,$78,$48,$48,$48,$48,$00,$00,$00,$78,$88,$78,$28,$48,$00,$00,$00,$f0,$88,$f0,$80,$80,$00,$00,$00,
989 $78,$80,$80,$80,$78,$00,$00,$00,$f8,$20,$20,$20,$20,$00,$00,$00,$88,$50,$20,$40,$80,$00,$00,$00,$a8,$70,
990 $20,$70,$a8,$00,$00,$00,$f0,$48,$70,$48,$f0,$00,$00,$00,$40,$40,$70,$48,$70,$00,$00,$00,$88,$88,$c8,$a8,
991 $c8,$00,$00,$00,$f0,$08,$70,$08,$f0,$00,$00,$00,$a8,$a8,$a8,$a8,$f8,$00,$00,$00,$70,$88,$38,$88,$70,$00,
992 $00,$00,$a8,$a8,$a8,$f8,$08,$00,$00,$00,$48,$48,$78,$08,$08,$00,$00,$00,$c0,$40,$70,$48,$70,$00,$90,$a8,
993 $a8,$e8,$a8,$a8,$90,$00,$20,$50,$88,$88,$f8,$88,$88,$00,$f8,$88,$80,$f0,$88,$88,$f0,$00,$90,$90,$90,$90,
994 $90,$f8,$08,$00,$38,$28,$28,$48,$48,$f8,$88,$00,$f8,$80,$80,$f0,$80,$80,$f8,$00,$20,$70,$a8,$a8,$a8,$70,
995 $20,$00,$f8,$88,$88,$80,$80,$80,$80,$00,$88,$88,$50,$20,$50,$88,$88,$00,$88,$88,$98,$a8,$c8,$88,$88,$00,
996 $50,$20,$88,$98,$a8,$c8,$88,$00,$88,$90,$a0,$c0,$a0,$90,$88,$00,$18,$28,$48,$48,$48,$48,$88,$00,$88,$d8,
997 $a8,$a8,$88,$88,$88,$00,$88,$88,$88,$f8,$88,$88,$88,$00,$70,$88,$88,$88,$88,$88,$70,$00,$f8,$88,$88,$88,
998 $88,$88,$88,$00,$78,$88,$88,$78,$28,$48,$88,$00,$f0,$88,$88,$f0,$80,$80,$80,$00,$70,$88,$80,$80,$80,$88,
999 $70,$00,$f8,$20,$20,$20,$20,$20,$20,$00,$88,$88,$88,$50,$20,$40,$80,$00,$a8,$a8,$70,$20,$70,$a8,$a8,$00,
1000 $f0,$48,$48,$70,$48,$48,$f0,$00,$80,$80,$80,$f0,$88,$88,$f0,$00,$88,$88,$88,$c8,$a8,$a8,$c8,$00,$f0,$08,
1001 $08,$30,$08,$08,$f0,$00,$a8,$a8,$a8,$a8,$a8,$a8,$f8,$00,$70,$88,$08,$78,$08,$88,$70,$00,$a8,$a8,$a8,$a8,
1002 $a8,$f8,$08,$00,$88,$88,$88,$88,$78,$08,$08,$00,$c0,$40,$40,$70,$48,$48,$70,$00
1003 );
1005 const kgiFont8: array[0..256*8-1] of Byte = (
1006 $00,$00,$00,$00,$00,$00,$00,$00,$7e,$81,$a5,$81,$bd,$99,$81,$7e,$7e,$ff,$db,$ff,$c3,$e7,$ff,$7e,$6c,$fe,
1007 $fe,$fe,$7c,$38,$10,$00,$10,$38,$7c,$fe,$7c,$38,$10,$00,$38,$7c,$38,$fe,$fe,$d6,$10,$38,$10,$10,$38,$7c,
1008 $fe,$7c,$10,$38,$00,$00,$18,$3c,$3c,$18,$00,$00,$ff,$ff,$e7,$c3,$c3,$e7,$ff,$ff,$00,$3c,$66,$42,$42,$66,
1009 $3c,$00,$ff,$c3,$99,$bd,$bd,$99,$c3,$ff,$0f,$07,$0f,$7d,$cc,$cc,$cc,$78,$3c,$66,$66,$66,$3c,$18,$7e,$18,
1010 $3f,$33,$3f,$30,$30,$70,$f0,$e0,$7f,$63,$7f,$63,$63,$67,$e6,$c0,$99,$5a,$3c,$e7,$e7,$3c,$5a,$99,$80,$e0,
1011 $f8,$fe,$f8,$e0,$80,$00,$02,$0e,$3e,$fe,$3e,$0e,$02,$00,$18,$3c,$7e,$18,$18,$7e,$3c,$18,$66,$66,$66,$66,
1012 $66,$00,$66,$00,$7f,$db,$db,$7b,$1b,$1b,$1b,$00,$7e,$c3,$78,$cc,$cc,$78,$8c,$f8,$00,$00,$00,$00,$7e,$7e,
1013 $7e,$00,$18,$3c,$7e,$18,$7e,$3c,$18,$ff,$18,$3c,$7e,$18,$18,$18,$18,$00,$18,$18,$18,$18,$7e,$3c,$18,$00,
1014 $00,$18,$0c,$fe,$0c,$18,$00,$00,$00,$30,$60,$fe,$60,$30,$00,$00,$00,$00,$c0,$c0,$c0,$fe,$00,$00,$00,$24,
1015 $66,$ff,$66,$24,$00,$00,$00,$18,$3c,$7e,$ff,$ff,$00,$00,$00,$ff,$ff,$7e,$3c,$18,$00,$00,$00,$00,$00,$00,
1016 $00,$00,$00,$00,$30,$78,$78,$30,$30,$00,$30,$00,$6c,$6c,$6c,$00,$00,$00,$00,$00,$6c,$6c,$fe,$6c,$fe,$6c,
1017 $6c,$00,$30,$7c,$c0,$78,$0c,$f8,$30,$00,$00,$c6,$cc,$18,$30,$66,$c6,$00,$38,$6c,$38,$76,$dc,$cc,$76,$00,
1018 $60,$60,$c0,$00,$00,$00,$00,$00,$18,$30,$60,$60,$60,$30,$18,$00,$60,$30,$18,$18,$18,$30,$60,$00,$00,$66,
1019 $3c,$ff,$3c,$66,$00,$00,$00,$30,$30,$fc,$30,$30,$00,$00,$00,$00,$00,$00,$00,$70,$30,$60,$00,$00,$00,$fc,
1020 $00,$00,$00,$00,$00,$00,$00,$00,$00,$30,$30,$00,$06,$0c,$18,$30,$60,$c0,$80,$00,$78,$cc,$dc,$fc,$ec,$cc,
1021 $78,$00,$30,$f0,$30,$30,$30,$30,$fc,$00,$78,$cc,$0c,$38,$60,$cc,$fc,$00,$78,$cc,$0c,$38,$0c,$cc,$78,$00,
1022 $1c,$3c,$6c,$cc,$fe,$0c,$0c,$00,$fc,$c0,$f8,$0c,$0c,$cc,$78,$00,$38,$60,$c0,$f8,$cc,$cc,$78,$00,$fc,$cc,
1023 $0c,$18,$30,$60,$60,$00,$78,$cc,$cc,$78,$cc,$cc,$78,$00,$78,$cc,$cc,$7c,$0c,$18,$70,$00,$00,$00,$30,$30,
1024 $00,$30,$30,$00,$00,$00,$30,$30,$00,$70,$30,$60,$18,$30,$60,$c0,$60,$30,$18,$00,$00,$00,$fc,$00,$fc,$00,
1025 $00,$00,$60,$30,$18,$0c,$18,$30,$60,$00,$78,$cc,$0c,$18,$30,$00,$30,$00,$7c,$c6,$de,$de,$de,$c0,$78,$00,
1026 $30,$78,$cc,$cc,$fc,$cc,$cc,$00,$fc,$66,$66,$7c,$66,$66,$fc,$00,$3c,$66,$c0,$c0,$c0,$66,$3c,$00,$fc,$6c,
1027 $66,$66,$66,$6c,$fc,$00,$fe,$62,$68,$78,$68,$62,$fe,$00,$fe,$62,$68,$78,$68,$60,$f0,$00,$3c,$66,$c0,$c0,
1028 $ce,$66,$3e,$00,$cc,$cc,$cc,$fc,$cc,$cc,$cc,$00,$78,$30,$30,$30,$30,$30,$78,$00,$1e,$0c,$0c,$0c,$cc,$cc,
1029 $78,$00,$e6,$66,$6c,$78,$6c,$66,$e6,$00,$f0,$60,$60,$60,$62,$66,$fe,$00,$c6,$ee,$fe,$d6,$c6,$c6,$c6,$00,
1030 $c6,$e6,$f6,$de,$ce,$c6,$c6,$00,$38,$6c,$c6,$c6,$c6,$6c,$38,$00,$fc,$66,$66,$7c,$60,$60,$f0,$00,$78,$cc,
1031 $cc,$cc,$dc,$78,$1c,$00,$fc,$66,$66,$7c,$78,$6c,$e6,$00,$78,$cc,$e0,$38,$1c,$cc,$78,$00,$fc,$b4,$30,$30,
1032 $30,$30,$78,$00,$cc,$cc,$cc,$cc,$cc,$cc,$fc,$00,$cc,$cc,$cc,$cc,$cc,$78,$30,$00,$c6,$c6,$c6,$d6,$fe,$ee,
1033 $c6,$00,$c6,$c6,$6c,$38,$6c,$c6,$c6,$00,$cc,$cc,$cc,$78,$30,$30,$78,$00,$fe,$cc,$98,$30,$62,$c6,$fe,$00,
1034 $78,$60,$60,$60,$60,$60,$78,$00,$c0,$60,$30,$18,$0c,$06,$02,$00,$78,$18,$18,$18,$18,$18,$78,$00,$10,$38,
1035 $6c,$c6,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$ff,$30,$30,$18,$00,$00,$00,$00,$00,$00,$00,$78,$0c,
1036 $7c,$cc,$76,$00,$e0,$60,$7c,$66,$66,$66,$bc,$00,$00,$00,$78,$cc,$c0,$cc,$78,$00,$1c,$0c,$0c,$7c,$cc,$cc,
1037 $76,$00,$00,$00,$78,$cc,$fc,$c0,$78,$00,$38,$6c,$60,$f0,$60,$60,$f0,$00,$00,$00,$76,$cc,$cc,$7c,$0c,$f8,
1038 $e0,$60,$6c,$76,$66,$66,$e6,$00,$30,$00,$70,$30,$30,$30,$78,$00,$18,$00,$78,$18,$18,$18,$d8,$70,$e0,$60,
1039 $66,$6c,$78,$6c,$e6,$00,$70,$30,$30,$30,$30,$30,$78,$00,$00,$00,$ec,$fe,$d6,$c6,$c6,$00,$00,$00,$f8,$cc,
1040 $cc,$cc,$cc,$00,$00,$00,$78,$cc,$cc,$cc,$78,$00,$00,$00,$dc,$66,$66,$7c,$60,$f0,$00,$00,$76,$cc,$cc,$7c,
1041 $0c,$1e,$00,$00,$d8,$6c,$6c,$60,$f0,$00,$00,$00,$7c,$c0,$78,$0c,$f8,$00,$10,$30,$7c,$30,$30,$34,$18,$00,
1042 $00,$00,$cc,$cc,$cc,$cc,$76,$00,$00,$00,$cc,$cc,$cc,$78,$30,$00,$00,$00,$c6,$c6,$d6,$fe,$6c,$00,$00,$00,
1043 $c6,$6c,$38,$6c,$c6,$00,$00,$00,$cc,$cc,$cc,$7c,$0c,$f8,$00,$00,$fc,$98,$30,$64,$fc,$00,$1c,$30,$30,$e0,
1044 $30,$30,$1c,$00,$18,$18,$18,$00,$18,$18,$18,$00,$e0,$30,$30,$1c,$30,$30,$e0,$00,$76,$dc,$00,$00,$00,$00,
1045 $00,$00,$10,$38,$6c,$c6,$c6,$c6,$fe,$00,$78,$cc,$c0,$cc,$78,$18,$0c,$78,$00,$cc,$00,$cc,$cc,$cc,$7e,$00,
1046 $1c,$00,$78,$cc,$fc,$c0,$78,$00,$7e,$c3,$3c,$06,$3e,$66,$3f,$00,$cc,$00,$78,$0c,$7c,$cc,$7e,$00,$e0,$00,
1047 $78,$0c,$7c,$cc,$7e,$00,$30,$30,$78,$0c,$7c,$cc,$7e,$00,$00,$00,$7c,$c0,$c0,$7c,$06,$3c,$7e,$c3,$3c,$66,
1048 $7e,$60,$3c,$00,$cc,$00,$78,$cc,$fc,$c0,$78,$00,$e0,$00,$78,$cc,$fc,$c0,$78,$00,$cc,$00,$70,$30,$30,$30,
1049 $78,$00,$7c,$c6,$38,$18,$18,$18,$3c,$00,$e0,$00,$70,$30,$30,$30,$78,$00,$cc,$30,$78,$cc,$cc,$fc,$cc,$00,
1050 $30,$30,$00,$78,$cc,$fc,$cc,$00,$1c,$00,$fc,$60,$78,$60,$fc,$00,$00,$00,$7f,$0c,$7f,$cc,$7f,$00,$3e,$6c,
1051 $cc,$fe,$cc,$cc,$ce,$00,$78,$cc,$00,$78,$cc,$cc,$78,$00,$00,$cc,$00,$78,$cc,$cc,$78,$00,$00,$e0,$00,$78,
1052 $cc,$cc,$78,$00,$78,$cc,$00,$cc,$cc,$cc,$7e,$00,$00,$e0,$00,$cc,$cc,$cc,$7e,$00,$00,$cc,$00,$cc,$cc,$fc,
1053 $0c,$f8,$c6,$38,$7c,$c6,$c6,$7c,$38,$00,$cc,$00,$cc,$cc,$cc,$cc,$78,$00,$18,$18,$7e,$c0,$c0,$7e,$18,$18,
1054 $38,$6c,$64,$f0,$60,$e6,$fc,$00,$cc,$cc,$78,$fc,$30,$fc,$30,$00,$f0,$d8,$d8,$f4,$cc,$de,$cc,$0e,$0e,$1b,
1055 $18,$7e,$18,$18,$d8,$70,$1c,$00,$78,$0c,$7c,$cc,$7e,$00,$38,$00,$70,$30,$30,$30,$78,$00,$00,$1c,$00,$78,
1056 $cc,$cc,$78,$00,$00,$1c,$00,$cc,$cc,$cc,$7e,$00,$00,$f8,$00,$f8,$cc,$cc,$cc,$00,$fc,$00,$cc,$ec,$fc,$dc,
1057 $cc,$00,$3c,$6c,$6c,$3e,$00,$7e,$00,$00,$3c,$66,$66,$3c,$00,$7e,$00,$00,$30,$00,$30,$60,$c0,$cc,$78,$00,
1058 $00,$00,$00,$fc,$c0,$c0,$00,$00,$00,$00,$00,$fc,$0c,$0c,$00,$00,$c6,$cc,$d8,$3e,$63,$ce,$98,$1f,$c6,$cc,
1059 $d8,$f3,$67,$cf,$9f,$03,$00,$18,$00,$18,$18,$3c,$3c,$18,$00,$33,$66,$cc,$66,$33,$00,$00,$00,$cc,$66,$33,
1060 $66,$cc,$00,$00,$22,$88,$22,$88,$22,$88,$22,$88,$55,$aa,$55,$aa,$55,$aa,$55,$aa,$dc,$76,$dc,$76,$dc,$76,
1061 $dc,$76,$18,$18,$18,$18,$18,$18,$18,$18,$18,$18,$18,$18,$f8,$18,$18,$18,$18,$18,$f8,$18,$f8,$18,$18,$18,
1062 $36,$36,$36,$36,$f6,$36,$36,$36,$00,$00,$00,$00,$fe,$36,$36,$36,$00,$00,$f8,$18,$f8,$18,$18,$18,$36,$36,
1063 $f6,$06,$f6,$36,$36,$36,$36,$36,$36,$36,$36,$36,$36,$36,$00,$00,$fe,$06,$f6,$36,$36,$36,$36,$36,$f6,$06,
1064 $fe,$00,$00,$00,$36,$36,$36,$36,$fe,$00,$00,$00,$18,$18,$f8,$18,$f8,$00,$00,$00,$00,$00,$00,$00,$f8,$18,
1065 $18,$18,$18,$18,$18,$18,$1f,$00,$00,$00,$18,$18,$18,$18,$ff,$00,$00,$00,$00,$00,$00,$00,$ff,$18,$18,$18,
1066 $18,$18,$18,$18,$1f,$18,$18,$18,$00,$00,$00,$00,$ff,$00,$00,$00,$18,$18,$18,$18,$ff,$18,$18,$18,$18,$18,
1067 $1f,$18,$1f,$18,$18,$18,$36,$36,$36,$36,$37,$36,$36,$36,$36,$36,$37,$30,$3f,$00,$00,$00,$00,$00,$3f,$30,
1068 $37,$36,$36,$36,$36,$36,$f7,$00,$ff,$00,$00,$00,$00,$00,$ff,$00,$f7,$36,$36,$36,$36,$36,$37,$30,$37,$36,
1069 $36,$36,$00,$00,$ff,$00,$ff,$00,$00,$00,$36,$36,$f7,$00,$f7,$36,$36,$36,$18,$18,$ff,$00,$ff,$00,$00,$00,
1070 $36,$36,$36,$36,$ff,$00,$00,$00,$00,$00,$ff,$00,$ff,$18,$18,$18,$00,$00,$00,$00,$ff,$36,$36,$36,$36,$36,
1071 $36,$36,$3f,$00,$00,$00,$18,$18,$1f,$18,$1f,$00,$00,$00,$00,$00,$1f,$18,$1f,$18,$18,$18,$00,$00,$00,$00,
1072 $3f,$36,$36,$36,$36,$36,$36,$36,$f7,$36,$36,$36,$18,$18,$ff,$00,$ff,$18,$18,$18,$18,$18,$18,$18,$f8,$00,
1073 $00,$00,$00,$00,$00,$00,$1f,$18,$18,$18,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$00,$00,$00,$00,$ff,$ff,$ff,$ff,
1074 $f0,$f0,$f0,$f0,$f0,$f0,$f0,$f0,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$ff,$ff,$ff,$ff,$00,$00,$00,$00,$00,$00,
1075 $76,$dc,$c8,$dc,$76,$00,$00,$78,$cc,$f8,$cc,$f8,$c0,$c0,$00,$fe,$c6,$c0,$c0,$c0,$c0,$00,$00,$fe,$6c,$6c,
1076 $6c,$6c,$6c,$00,$fe,$66,$30,$18,$30,$66,$fe,$00,$00,$00,$7e,$cc,$cc,$cc,$78,$00,$00,$66,$66,$66,$66,$7c,
1077 $60,$c0,$00,$76,$dc,$18,$18,$18,$18,$00,$fc,$30,$78,$cc,$cc,$78,$30,$fc,$38,$6c,$c6,$fe,$c6,$6c,$38,$00,
1078 $38,$6c,$c6,$c6,$6c,$6c,$ee,$00,$1c,$30,$18,$7c,$cc,$cc,$78,$00,$00,$00,$7e,$db,$db,$7e,$00,$00,$06,$0c,
1079 $7e,$db,$db,$7e,$60,$c0,$3c,$60,$c0,$fc,$c0,$60,$3c,$00,$78,$cc,$cc,$cc,$cc,$cc,$cc,$00,$00,$fc,$00,$fc,
1080 $00,$fc,$00,$00,$30,$30,$fc,$30,$30,$00,$fc,$00,$60,$30,$18,$30,$60,$00,$fc,$00,$18,$30,$60,$30,$18,$00,
1081 $fc,$00,$0e,$1b,$1b,$18,$18,$18,$18,$18,$18,$18,$18,$18,$18,$d8,$d8,$70,$30,$30,$00,$fc,$00,$30,$30,$00,
1082 $00,$72,$9c,$00,$72,$9c,$00,$00,$38,$6c,$6c,$38,$00,$00,$00,$00,$00,$00,$00,$18,$18,$00,$00,$00,$00,$00,
1083 $00,$00,$18,$00,$00,$00,$0f,$0c,$0c,$0c,$ec,$6c,$3c,$1c,$78,$6c,$6c,$6c,$6c,$00,$00,$00,$78,$0c,$38,$60,
1084 $7c,$00,$00,$00,$00,$00,$3c,$3c,$3c,$3c,$00,$00,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff
1085 );
1087 const kgiFont6PropWidth: array[0..256-1] of Byte = (
1088 $08,$08,$08,$07,$07,$07,$07,$04,$08,$07,$08,$08,$06,$06,$06,$07,
1089 $06,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,
1090 $85,$21,$13,$05,$05,$05,$05,$13,$13,$13,$05,$05,$12,$14,$12,$05,
1091 $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$21,$12,$05,$05,$05,$05,
1092 $05,$05,$05,$05,$05,$05,$05,$05,$05,$13,$05,$05,$05,$05,$05,$05,
1093 $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$13,$05,$13,$05,$05,
1094 $13,$05,$05,$05,$05,$05,$05,$05,$05,$13,$04,$14,$13,$05,$05,$05,
1095 $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$14,$21,$04,$05,$08,
1096 $08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$04,
1097 $44,$08,$08,$08,$08,$08,$08,$08,$05,$04,$05,$08,$08,$08,$08,$08,
1098 $05,$05,$05,$05,$05,$05,$13,$13,$05,$05,$05,$04,$05,$05,$05,$05,
1099 $05,$05,$05,$05,$05,$03,$04,$04,$06,$05,$04,$07,$04,$03,$05,$08,
1100 $05,$05,$05,$05,$05,$05,$05,$14,$05,$05,$05,$04,$05,$05,$05,$05,
1101 $14,$05,$05,$05,$05,$05,$05,$05,$14,$05,$05,$05,$05,$05,$14,$05,
1102 $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,
1103 $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05
1104 );
1106 const kgiFont8PropWidth: array[0..256-1] of Byte = (
1107 $08,$08,$08,$07,$07,$07,$07,$06,$08,$07,$08,$08,$07,$08,$08,$08,
1108 $07,$07,$07,$07,$08,$08,$07,$08,$07,$07,$07,$07,$07,$08,$08,$08,
1109 $85,$14,$15,$07,$06,$07,$07,$03,$14,$14,$08,$06,$13,$06,$22,$07,
1110 $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$22,$13,$05,$06,$15,$06,
1111 $07,$06,$07,$07,$07,$07,$07,$07,$06,$14,$07,$07,$07,$07,$07,$07,
1112 $07,$06,$07,$06,$06,$06,$06,$07,$07,$06,$07,$14,$07,$14,$07,$08,
1113 $23,$07,$07,$06,$07,$06,$06,$07,$07,$14,$05,$07,$14,$07,$06,$06,
1114 $07,$07,$06,$06,$15,$07,$06,$07,$07,$06,$06,$06,$32,$06,$07,$07,
1115 $06,$07,$06,$08,$07,$07,$07,$07,$08,$06,$06,$06,$07,$05,$06,$06,
1116 $06,$08,$07,$06,$06,$06,$07,$07,$06,$07,$06,$07,$07,$06,$07,$08,
1117 $07,$05,$06,$07,$06,$06,$16,$16,$06,$06,$06,$08,$08,$06,$08,$08,
1118 $08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,
1119 $38,$08,$08,$38,$08,$08,$38,$28,$28,$28,$08,$08,$28,$08,$08,$08,
1120 $08,$08,$08,$28,$38,$38,$28,$08,$08,$08,$38,$08,$08,$08,$48,$08,
1121 $07,$06,$07,$07,$07,$07,$07,$07,$06,$07,$07,$06,$08,$08,$06,$06,
1122 $06,$06,$06,$06,$35,$05,$06,$07,$15,$32,$32,$08,$15,$15,$24,$08
1123 );
1126 function createFontTexture (constref font: array of Byte; constref fontwdt: array of Byte; prop: Boolean): GLuint;
1127 const
1128 Width = 16*8;
1129 Height = 16*8;
1130 var
1131 tex, tpp: PByte;
1132 b: Byte;
1133 cc: Integer;
1134 x, y, dx, dy: Integer;
1135 begin
1136 GetMem(tex, Width*Height*4);
1138 for cc := 0 to 255 do
1139 begin
1140 x := (cc mod 16)*8;
1141 y := (cc div 16)*8;
1142 for dy := 0 to 7 do
1143 begin
1144 b := font[cc*8+dy];
1145 if prop then b := b shl (fontwdt[cc] shr 4);
1146 tpp := tex+((y+dy)*(Width*4))+x*4;
1147 for dx := 0 to 7 do
1148 begin
1149 if ((b and $80) <> 0) then
1150 begin
1151 tpp^ := 255; Inc(tpp);
1152 tpp^ := 255; Inc(tpp);
1153 tpp^ := 255; Inc(tpp);
1154 tpp^ := 255; Inc(tpp);
1155 end
1156 else
1157 begin
1158 tpp^ := 0; Inc(tpp);
1159 tpp^ := 0; Inc(tpp);
1160 tpp^ := 0; Inc(tpp);
1161 tpp^ := 0; Inc(tpp);
1162 end;
1163 b := (b and $7f) shl 1;
1164 end;
1165 end;
1166 end;
1168 glGenTextures(1, @result);
1169 if (result = 0) then raise Exception.Create('can''t create Holmes font texture');
1171 glBindTexture(GL_TEXTURE_2D, result);
1172 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
1173 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
1174 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
1175 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
1177 //GLfloat[4] bclr = 0.0;
1178 //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr);
1180 glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Width, Height, 0, GL_RGBA{gltt}, GL_UNSIGNED_BYTE, tex);
1181 glFlush();
1183 //FreeMem(tex);
1184 end;
1187 var
1188 font6texid: GLuint = 0;
1189 font8texid: GLuint = 0;
1190 prfont6texid: GLuint = 0;
1191 prfont8texid: GLuint = 0;
1194 procedure deleteFonts ();
1195 begin
1196 if (font6texid <> 0) then glDeleteTextures(1, @font6texid);
1197 if (font8texid <> 0) then glDeleteTextures(1, @font8texid);
1198 if (prfont6texid <> 0) then glDeleteTextures(1, @prfont6texid);
1199 if (prfont8texid <> 0) then glDeleteTextures(1, @prfont8texid);
1200 font6texid := 0;
1201 font8texid := 0;
1202 prfont6texid := 0;
1203 prfont8texid := 0;
1204 end;
1207 procedure createFonts ();
1208 begin
1209 if (font6texid = 0) then font6texid := createFontTexture(kgiFont6, kgiFont6PropWidth, false);
1210 if (font8texid = 0) then font8texid := createFontTexture(kgiFont8, kgiFont8PropWidth, false);
1211 if (prfont6texid = 0) then prfont6texid := createFontTexture(kgiFont6, kgiFont6PropWidth, true);
1212 if (prfont8texid = 0) then prfont8texid := createFontTexture(kgiFont8, kgiFont8PropWidth, true);
1213 end;
1216 // ////////////////////////////////////////////////////////////////////////// //
1217 procedure TScissorSave.save (enableScissoring: Boolean);
1218 begin
1219 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
1220 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
1221 //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
1222 if enableScissoring and (not wassc) then glEnable(GL_SCISSOR_TEST);
1223 end;
1225 procedure TScissorSave.restore ();
1226 begin
1227 glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]);
1228 if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
1229 end;
1231 procedure TScissorSave.combineRect (x, y, w, h: Integer);
1232 //var ox, oy, ow, oh: Integer;
1233 begin
1234 if (w < 1) or (h < 1) then begin glScissor(0, 0, 0, 0); exit; end;
1235 y := gScrHeight-(y+h);
1236 //ox := x; oy := y; ow := w; oh := h;
1237 if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then
1238 begin
1239 //writeln('oops: COMBINE: old=(', ox, ',', oy, ')-(', ox+ow-1, ',', oy+oh-1, '); sci: (', scxywh[0], ',', scxywh[1], ')-(', scxywh[0]+scxywh[2]-1, ',', scxywh[1]+scxywh[3]-1, ')');
1240 //writeln('oops: COMBINE: oldx=<', ox, '-', ox+ow-1, '>; oldy=<', oy, ',', oy+oh-1, '> : scix=<', scxywh[0], '-', scxywh[0]+scxywh[2]-1, '>; sciy=<', scxywh[1], '-', scxywh[1]+scxywh[3]-1, '>');
1241 glScissor(0, 0, 0, 0);
1242 end
1243 else
1244 begin
1245 glScissor(x, y, w, h);
1246 end;
1247 end;
1249 //TODO: overflow checks
1250 function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
1251 var
1252 ex0, ey0: Integer;
1253 ex1, ey1: Integer;
1254 begin
1255 result := false;
1256 if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit; // at least one rect is null
1257 // check for intersection
1258 ex0 := x0+w0;
1259 ey0 := y0+h0;
1260 ex1 := x1+w1;
1261 ey1 := y1+h1;
1262 if (ex0 <= x1) or (ey0 <= y1) or (ex1 <= x0) or (ey1 <= y0) then exit;
1263 if (x0 >= ex1) or (y0 >= ey1) or (x1 >= ex0) or (y1 >= ey0) then exit;
1264 // ok, intersects
1265 if (x0 < x1) then x0 := x1;
1266 if (y0 < y1) then y0 := y1;
1267 if (ex0 > ex1) then ex0 := ex1;
1268 if (ey0 > ey1) then ey0 := ey1;
1269 w0 := ex0-x0;
1270 h0 := ey0-y0;
1271 result := (w0 > 0) and (h0 > 0);
1272 end;
1275 // ////////////////////////////////////////////////////////////////////////// //
1276 procedure normRGBA (var r, g, b, a: Integer); inline;
1277 begin
1278 if (a < 0) then a := 0 else if (a > 255) then a := 255;
1279 if (r < 0) then r := 0 else if (r > 255) then r := 255;
1280 if (g < 0) then g := 0 else if (g > 255) then g := 255;
1281 if (b < 0) then b := 0 else if (b > 255) then b := 255;
1282 end;
1284 // returns `false` if the color is transparent
1285 function setupGLColor (r, g, b, a: Integer): Boolean;
1286 begin
1287 normRGBA(r, g, b, a);
1288 if (a < 255) then
1289 begin
1290 if (a = 0) then begin result := false; exit; end;
1291 glEnable(GL_BLEND);
1292 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1293 end
1294 else
1295 begin
1296 glDisable(GL_BLEND);
1297 end;
1298 glColor4ub(Byte(r), Byte(g), Byte(b), Byte(a));
1299 result := true;
1300 end;
1302 // returns `false` if the color is transparent
1303 function setupGLColor (constref clr: TGxRGBA): Boolean;
1304 begin
1305 if (clr.a < 255) then
1306 begin
1307 if (clr.a = 0) then begin result := false; exit; end;
1308 glEnable(GL_BLEND);
1309 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1310 end
1311 else
1312 begin
1313 glDisable(GL_BLEND);
1314 end;
1315 glColor4ub(clr.r, clr.g, clr.b, clr.a);
1316 result := true;
1317 end;
1319 function isScaled (): Boolean;
1320 var
1321 mt: packed array [0..15] of Double;
1322 begin
1323 glGetDoublev(GL_MODELVIEW_MATRIX, @mt[0]);
1324 result := (mt[0] <> 1.0) or (mt[1*4+1] <> 1.0);
1325 end;
1328 // ////////////////////////////////////////////////////////////////////////// //
1329 function textWidth6 (const s: AnsiString): Integer;
1330 var
1331 f: Integer;
1332 begin
1333 result := 0;
1334 for f := 1 to Length(s) do Inc(result, Integer(kgiFont6PropWidth[Integer(s[f])] and $0f)+1);
1335 if (result > 0) then Dec(result); // don't count last empty pixel
1336 end;
1339 function textWidth8 (const s: AnsiString): Integer;
1340 var
1341 f: Integer;
1342 begin
1343 result := 0;
1344 for f := 1 to Length(s) do Inc(result, Integer(kgiFont8PropWidth[Integer(s[f])] and $0f)+1);
1345 if (result > 0) then Dec(result); // don't count last empty pixel
1346 end;
1349 // return width (including last empty pixel)
1350 function drawTextInternal (wdt, x, y: Integer; const s: AnsiString; constref clr: TGxRGBA; tid: GLuint; constref fontwdt: array of Byte; prop: Boolean): Integer;
1351 var
1352 f, c: Integer;
1353 tx, ty: Integer;
1354 begin
1355 result := 0;
1356 if (Length(s) = 0) then exit;
1357 if not setupGLColor(clr) then exit;
1359 glEnable(GL_ALPHA_TEST);
1360 glAlphaFunc(GL_NOTEQUAL, 0.0);
1361 glEnable(GL_TEXTURE_2D);
1362 glBindTexture(GL_TEXTURE_2D, tid);
1364 for f := 1 to Length(s) do
1365 begin
1366 c := Integer(s[f]) and $ff;
1367 tx := (c mod 16)*8;
1368 ty := (c div 16)*8;
1369 glBegin(GL_QUADS);
1370 glTexCoord2f((tx+0)/128.0, (ty+0)/128.0); glVertex2i(x+0, y+0); // top-left
1371 glTexCoord2f((tx+8)/128.0, (ty+0)/128.0); glVertex2i(x+8, y+0); // top-right
1372 glTexCoord2f((tx+8)/128.0, (ty+8)/128.0); glVertex2i(x+8, y+8); // bottom-right
1373 glTexCoord2f((tx+0)/128.0, (ty+8)/128.0); glVertex2i(x+0, y+8); // bottom-left
1374 glEnd();
1375 if prop then
1376 begin
1377 x += Integer(fontwdt[c] and $0f)+1;
1378 result += Integer(fontwdt[c] and $0f)+1;
1379 end
1380 else
1381 begin
1382 x += wdt;
1383 result += wdt;
1384 end;
1385 end;
1387 glDisable(GL_ALPHA_TEST);
1388 glDisable(GL_BLEND);
1389 glDisable(GL_TEXTURE_2D);
1390 glColor4f(1, 1, 1, 1);
1391 glBindTexture(GL_TEXTURE_2D, 0);
1392 end;
1395 // ////////////////////////////////////////////////////////////////////////// //
1396 procedure drawHLine (x, y, len: Integer; constref clr: TGxRGBA);
1397 begin
1398 if (len < 1) then exit;
1399 if not setupGLColor(clr) then exit;
1400 glDisable(GL_TEXTURE_2D);
1401 if (not isScaled) then
1402 begin
1403 glLineWidth(1);
1404 glBegin(GL_LINES);
1405 glVertex2f(x+0.375, y+0.375);
1406 glVertex2f(x+len+0.375, y+0.375);
1407 glEnd();
1408 end
1409 else
1410 begin
1411 glBegin(GL_QUADS);
1412 glVertex2i(x, y);
1413 glVertex2i(x+len, y);
1414 glVertex2i(x+len, y+1);
1415 glVertex2i(x, y+1);
1416 glEnd();
1417 end;
1418 end;
1421 procedure drawVLine (x, y, len: Integer; constref clr: TGxRGBA);
1422 begin
1423 if (len < 1) then exit;
1424 if not setupGLColor(clr) then exit;
1425 glDisable(GL_TEXTURE_2D);
1426 if (not isScaled) then
1427 begin
1428 glLineWidth(1);
1429 glBegin(GL_LINES);
1430 glVertex2f(x+0.375, y+0.375);
1431 glVertex2f(x+0.375, y+len+0.375);
1432 glEnd();
1433 end
1434 else
1435 begin
1436 glBegin(GL_QUADS);
1437 glVertex2i(x, y);
1438 glVertex2i(x, y+len);
1439 glVertex2i(x+1, y+len);
1440 glVertex2i(x+1, y);
1441 glEnd();
1442 end;
1443 end;
1446 procedure drawLine (x1, y1, x2, y2: Integer; constref clr: TGxRGBA);
1447 begin
1448 if not setupGLColor(clr) then exit;
1450 glDisable(GL_TEXTURE_2D);
1452 glLineWidth(1);
1453 glPointSize(1);
1455 if (not isScaled) then
1456 begin
1457 glLineWidth(1);
1458 glBegin(GL_LINES);
1459 glVertex2f(x1+0.375, y1+0.375);
1460 glVertex2f(x2+0.375, y2+0.375);
1461 glEnd();
1463 if (x1 <> x2) or (y1 <> y2) then
1464 begin
1465 glBegin(GL_POINTS);
1466 glVertex2f(x2+0.375, y2+0.375);
1467 glEnd();
1468 end;
1469 end
1470 else
1471 begin
1472 glLineWidth(1);
1473 glBegin(GL_LINES);
1474 glVertex2i(x1, y1);
1475 glVertex2i(x2, y2);
1476 // draw last point
1477 glVertex2i(x2, y2);
1478 glVertex2i(x2+1, y2+1);
1479 glEnd();
1480 end;
1482 glColor4f(1, 1, 1, 1);
1483 glDisable(GL_BLEND);
1484 end;
1487 procedure drawRect (x, y, w, h: Integer; constref clr: TGxRGBA);
1488 begin
1489 if (w < 0) or (h < 0) then exit;
1490 if not setupGLColor(clr) then exit;
1491 glDisable(GL_TEXTURE_2D);
1492 glLineWidth(1);
1493 glDisable(GL_LINE_SMOOTH);
1494 glDisable(GL_POLYGON_SMOOTH);
1495 if (w = 1) and (h = 1) then
1496 begin
1497 glBegin(GL_POINTS);
1498 glVertex2f(x+0.375, y+0.375);
1499 glEnd();
1500 end
1501 else
1502 begin
1503 glLineWidth(1);
1504 glBegin(GL_LINES);
1505 glVertex2i(x, y); glVertex2i(x+w, y); // top
1506 glVertex2i(x, y+h-1); glVertex2i(x+w, y+h-1); // bottom
1507 glVertex2f(x+0.375, y+1); glVertex2f(x+0.375, y+h-1); // left
1508 glVertex2f(x+w-1+0.375, y+1); glVertex2f(x+w-1+0.375, y+h-1); // right
1509 glEnd();
1510 end;
1511 //glRect(x, y, x+w, y+h);
1512 glColor4f(1, 1, 1, 1);
1513 glDisable(GL_BLEND);
1514 end;
1517 procedure drawRectUI (x, y, w, h: Integer; constref clr: TGxRGBA);
1518 procedure hline (x, y, len: Integer);
1519 begin
1520 if (len < 1) then exit;
1521 glBegin(GL_QUADS);
1522 glVertex2i(x, y);
1523 glVertex2i(x+len, y);
1524 glVertex2i(x+len, y+1);
1525 glVertex2i(x, y+1);
1526 glEnd();
1527 end;
1529 procedure vline (x, y, len: Integer);
1530 begin
1531 if (len < 1) then exit;
1532 glBegin(GL_QUADS);
1533 glVertex2i(x, y);
1534 glVertex2i(x, y+len);
1535 glVertex2i(x+1, y+len);
1536 glVertex2i(x+1, y);
1537 glEnd();
1538 end;
1540 var
1541 scaled: Boolean;
1542 begin
1543 if (w < 0) or (h < 0) then exit;
1544 if not setupGLColor(clr) then exit;
1545 glDisable(GL_TEXTURE_2D);
1546 glLineWidth(1);
1547 glDisable(GL_LINE_SMOOTH);
1548 glDisable(GL_POLYGON_SMOOTH);
1549 scaled := isScaled();
1550 if (w = 1) and (h = 1) then
1551 begin
1552 glBegin(GL_POINTS);
1553 if scaled then glVertex2i(x, y) else glVertex2f(x+0.375, y+0.375);
1554 glEnd();
1555 end
1556 else
1557 begin
1558 if not scaled then
1559 begin
1560 glLineWidth(1);
1561 glBegin(GL_LINES);
1562 glVertex2i(x, y); glVertex2i(x+w, y); // top
1563 glVertex2i(x, y+h-1); glVertex2i(x+w, y+h-1); // bottom
1564 glVertex2f(x+0.375, y+1); glVertex2f(x+0.375, y+h-1); // left
1565 glVertex2f(x+w-1+0.375, y+1); glVertex2f(x+w-1+0.375, y+h-1); // right
1566 glEnd();
1567 end
1568 else
1569 begin
1570 hline(x, y, w);
1571 hline(x, y+h-1, w);
1572 vline(x, y+1, h-2);
1573 vline(x+w-1, y+1, h-2);
1574 end;
1575 end;
1576 //glRect(x, y, x+w, y+h);
1577 glColor4f(1, 1, 1, 1);
1578 glDisable(GL_BLEND);
1579 end;
1582 procedure darkenRect (x, y, w, h: Integer; a: Integer);
1583 begin
1584 if (w < 0) or (h < 0) then exit;
1585 if (a < 0) then a := 0;
1586 if (a >= 255) then exit;
1587 glEnable(GL_BLEND);
1588 glBlendFunc(GL_ZERO, GL_SRC_ALPHA);
1589 glDisable(GL_LINE_SMOOTH);
1590 glDisable(GL_POLYGON_SMOOTH);
1591 glDisable(GL_TEXTURE_2D);
1592 glColor4f(0.0, 0.0, 0.0, a/255.0);
1593 glBegin(GL_QUADS);
1594 glVertex2i(x, y);
1595 glVertex2i(x+w, y);
1596 glVertex2i(x+w, y+h);
1597 glVertex2i(x, y+h);
1598 glEnd();
1599 //glRect(x, y, x+w, y+h);
1600 glColor4f(1, 1, 1, 1);
1601 glDisable(GL_BLEND);
1602 //glBlendEquation(GL_FUNC_ADD);
1603 end;
1606 procedure fillRect (x, y, w, h: Integer; constref clr: TGxRGBA);
1607 begin
1608 if (w < 0) or (h < 0) then exit;
1609 if not setupGLColor(clr) then exit;
1610 glDisable(GL_LINE_SMOOTH);
1611 glDisable(GL_POLYGON_SMOOTH);
1612 glDisable(GL_TEXTURE_2D);
1613 glBegin(GL_QUADS);
1614 glVertex2f(x, y);
1615 glVertex2f(x+w, y);
1616 glVertex2f(x+w, y+h);
1617 glVertex2f(x, y+h);
1618 glEnd();
1619 glColor4f(1, 1, 1, 1);
1620 glDisable(GL_BLEND);
1621 end;
1624 // ////////////////////////////////////////////////////////////////////////// //
1625 function drawText6 (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
1626 begin
1627 if (font6texid = 0) then createFonts();
1628 drawTextInternal(6, x, y, s, clr, font6texid, kgiFont6PropWidth, false);
1629 result := Length(s)*6;
1630 end;
1632 function drawText8 (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
1633 begin
1634 if (font8texid = 0) then createFonts();
1635 drawTextInternal(8, x, y, s, clr, font8texid, kgiFont8PropWidth, false);
1636 result := Length(s)*8;
1637 end;
1639 function drawText6Prop (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
1640 begin
1641 if (prfont6texid = 0) then createFonts();
1642 result := drawTextInternal(6, x, y, s, clr, prfont6texid, kgiFont6PropWidth, true);
1643 end;
1645 function drawText8Prop (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
1646 begin
1647 if (prfont8texid = 0) then createFonts();
1648 result := drawTextInternal(8, x, y, s, clr, prfont8texid, kgiFont8PropWidth, true);
1649 end;
1652 // ////////////////////////////////////////////////////////////////////////// //
1653 // x-centered at `x`
1654 function drawText6XC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
1655 begin
1656 if (font6texid = 0) then createFonts();
1657 x -= Length(s)*6 div 2;
1658 drawTextInternal(6, x, y, s, clr, font6texid, kgiFont6PropWidth, false);
1659 result := Length(s)*6;
1660 end;
1662 function drawText8XC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
1663 begin
1664 if (font8texid = 0) then createFonts();
1665 x -= Length(s)*8 div 2;
1666 drawTextInternal(8, x, y, s, clr, font8texid, kgiFont8PropWidth, false);
1667 result := Length(s)*8;
1668 end;
1670 function drawText6PropXC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
1671 begin
1672 if (prfont6texid = 0) then createFonts();
1673 x -= textWidth6(s) div 2;
1674 result := drawTextInternal(6, x, y, s, clr, prfont6texid, kgiFont6PropWidth, true);
1675 end;
1677 function drawText8PropXC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
1678 begin
1679 if (prfont8texid = 0) then createFonts();
1680 x -= textWidth8(s) div 2;
1681 result := drawTextInternal(8, x, y, s, clr, prfont8texid, kgiFont8PropWidth, true);
1682 end;
1685 // ////////////////////////////////////////////////////////////////////////// //
1686 procedure oglRestoreMode (doClear: Boolean);
1687 begin
1688 oglSetup2D(gScrWidth, gScrHeight);
1689 glScissor(0, 0, gScrWidth, gScrHeight);
1691 glBindTexture(GL_TEXTURE_2D, 0);
1692 glDisable(GL_BLEND);
1693 glDisable(GL_TEXTURE_2D);
1694 glDisable(GL_STENCIL_TEST);
1695 glDisable(GL_SCISSOR_TEST);
1696 glDisable(GL_LIGHTING);
1697 glDisable(GL_DEPTH_TEST);
1698 glDisable(GL_CULL_FACE);
1699 glDisable(GL_LINE_SMOOTH);
1700 glDisable(GL_POINT_SMOOTH);
1701 glLineWidth(1);
1702 glPointSize(1);
1703 glColor4f(1, 1, 1, 1);
1705 if doClear then
1706 begin
1707 glClearColor(0, 0, 0, 0);
1708 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_ACCUM_BUFFER_BIT or GL_STENCIL_BUFFER_BIT);
1709 end;
1711 // scale everything
1712 glMatrixMode(GL_MODELVIEW);
1713 glLoadIdentity();
1714 //glScalef(4, 4, 1);
1715 end;
1718 procedure onWinFocus (); begin end;
1720 procedure onWinBlur (); begin resetKMState(true); end;
1722 procedure onPreRender (); begin oglRestoreMode(gGfxDoClear); end;
1724 procedure onPostRender (); begin oglRestoreMode(false); oglDrawCursor(); end;
1726 procedure onInit ();
1727 begin
1728 oglSetup2D(gScrWidth, gScrHeight);
1730 createCursorTexture();
1731 createFonts();
1732 end;
1734 procedure onDeinit ();
1735 begin
1736 resetKMState(false);
1737 if (curtexid <> 0) then glDeleteTextures(1, @curtexid);
1738 curtexid := 0;
1739 deleteFonts();
1740 curButState := 0;
1741 curModState := 0;
1742 curMsX := 0;
1743 curMsY := 0;
1744 end;
1747 // ////////////////////////////////////////////////////////////////////////// //
1748 begin
1749 evSDLCB := onSDLEvent;
1750 winFocusCB := onWinFocus;
1751 winBlurCB := onWinBlur;
1752 prerenderFrameCB := onPreRender;
1753 postrenderFrameCB := onPostRender;
1754 oglInitCB := onInit;
1755 oglDeinitCB := onDeinit;
1756 end.