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