src/gx/glgfx.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 unit glgfx;
  18
  19 interface
  20
  21 uses
  22   SysUtils, Classes,
  23   GL, GLExt, SDL2,
  24   sdlcarcass;
  25
  26
  27 // ////////////////////////////////////////////////////////////////////////// //
  28 type
  29   THMouseEvent = record
  30   public
  31     const
  32       // both for but and for bstate
  33       None = 0;
  34       Left = $0001;
  35       Right = $0002;
  36       Middle = $0004;
  37       WheelUp = $0008;
  38       WheelDown = $0010;
  39
  40     // event types
  41     type
  42       TKind = (Release, Press, Motion);
  43
  44   public
  45     kind: TKind; // motion, press, release
  46     x, y: Integer; // current mouse position
  47     dx, dy: Integer; // for wheel this is wheel motion, otherwise this is relative mouse motion
  48     but: Word; // current pressed/released button, or 0 for motion
  49     bstate: Word; // button state BEFORE event (i.e. press/release modifications aren't done yet)
  50     kstate: Word; // keyboard state (see THKeyEvent);
  51
  52   public
  53     function press (): Boolean; inline;
  54     function release (): Boolean; inline;
  55     function motion (): Boolean; inline;
  56   end;
  57
  58   THKeyEvent = record
  59   public
  60     const
  61       // modifiers
  62       ModCtrl = $0001;
  63       ModAlt = $0002;
  64       ModShift = $0004;
  65       ModHyper = $0008;
  66
  67     // event types
  68     type
  69       TKind = (Release, Press);
  70
  71   public
  72     kind: TKind;
  73     scan: Word; // SDL_SCANCODE_XXX
  74     sym: LongWord; // SDLK_XXX
  75     x, y: Integer; // current mouse position
  76     bstate: Word; // button state
  77     kstate: Word; // keyboard state BEFORE event (i.e. press/release modifications aren't done yet)
  78
  79   public
  80     function press (): Boolean; inline;
  81     function release (): Boolean; inline;
  82   end;
  83
  84
  85 // ////////////////////////////////////////////////////////////////////////// //
  86 // setup 2D OpenGL mode; will be called automatically in `glInit()`
  87 procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
  88
  89 type
  90   TScissorSave = record
  91   public
  92     wassc: Boolean;
  93     scxywh: packed array[0..3] of GLint;
  94
  95   public
  96
  97   public
  98     procedure save (enableScissoring: Boolean);
  99     procedure restore ();
 100
 101     // set new scissor rect, bounded by the saved scissor rect
 102     procedure setRect (x, y, w, h: Integer);
 103   end;
 104
 105
 106 procedure oglDrawCursor ();
 107 procedure oglDrawCursorAt (msX, msY: Integer);
 108
 109 // return `false` if destination rect is empty
 110 // modifies rect0
 111 function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
 112
 113 procedure normRGBA (var r, g, b, a: Integer); inline;
 114 function setupGLColor (r, g, b, a: Integer): Boolean;
 115 function isScaled (): Boolean;
 116
 117 function textWidth6 (const s: AnsiString): Integer;
 118 function textWidth8 (const s: AnsiString): Integer;
 119 // return width (including last empty pixel)
 120 function drawTextInternal (wdt, x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer; tid: GLuint; constref fontwdt: array of Byte; prop: Boolean): Integer;
 121 procedure drawLine (x1, y1, x2, y2: Integer; r, g, b: Integer; a: Integer=255);
 122 procedure drawVLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255);
 123 procedure drawHLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255);
 124 procedure drawRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255);
 125 procedure drawRectUI (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255);
 126 procedure darkenRect (x, y, w, h: Integer; a: Integer);
 127 procedure fillRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255);
 128 function drawText6 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
 129 function drawText8 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
 130 function drawText6Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
 131 function drawText8Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
 132 // x-centered at `x`
 133 function drawText6XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
 134 function drawText8XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
 135 function drawText6PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
 136 function drawText8PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
 137
 138
 139 // ////////////////////////////////////////////////////////////////////////// //
 140 // event handlers
 141 var
 142   evMouseCB: function (var ev: THMouseEvent): Boolean = nil; // `true`: event eaten
 143   evKeyCB: function (var ev: THKeyEvent): Boolean = nil; // `true`: event eaten
 144
 145
 146 // ////////////////////////////////////////////////////////////////////////// //
 147 function getMouseX (): Integer; inline;
 148 function getMouseY (): Integer; inline;
 149 function getButState (): Word; inline;
 150 function getModState (): Word; inline;
 151
 152
 153 // ////////////////////////////////////////////////////////////////////////// //
 154 property
 155   gMouseX: Integer read getMouseX;
 156   gMouseY: Integer read getMouseY;
 157   gButState: Word read getButState;
 158   gModState: Word read getModState;
 159
 160 var
 161   gGfxDoClear: Boolean = true;
 162
 163
 164 // ////////////////////////////////////////////////////////////////////////// //
 165 // any mods = 255: nothing was defined
 166 function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString;
 167
 168 operator = (constref ev: THKeyEvent; const s: AnsiString): Boolean;
 169 operator = (const s: AnsiString; constref ev: THKeyEvent): Boolean;
 170
 171 operator = (constref ev: THMouseEvent; const s: AnsiString): Boolean;
 172 operator = (const s: AnsiString; constref ev: THMouseEvent): Boolean;
 173
 174
 175 implementation
 176
 177
 178 var
 179   curButState: Word = 0;
 180   curModState: Word = 0;
 181   curMsX: Integer = 0;
 182   curMsY: Integer = 0;
 183
 184
 185 // ////////////////////////////////////////////////////////////////////////// //
 186 function strEquCI (const s0, s1: AnsiString): Boolean;
 187 var
 188   f: Integer;
 189   c0, c1: AnsiChar;
 190 begin
 191   result := (Length(s0) = Length(s1));
 192   if result then
 193   begin
 194     for f := 1 to Length(s0) do
 195     begin
 196       c0 := s0[f];
 197       if (c0 >= 'a') and (c0 <= 'z') then Dec(c0, 32); // poor man's `toupper()`
 198       c1 := s1[f];
 199       if (c1 >= 'a') and (c1 <= 'z') then Dec(c1, 32); // poor man's `toupper()`
 200       if (c0 <> c1) then begin result := false; exit; end;
 201     end;
 202   end;
 203 end;
 204
 205
 206 // ////////////////////////////////////////////////////////////////////////// //
 207 function getMouseX (): Integer; inline; begin result := curMsX; end;
 208 function getMouseY (): Integer; inline; begin result := curMsY; end;
 209 function getButState (): Word; inline; begin result := curButState; end;
 210 function getModState (): Word; inline; begin result := curModState; end;
 211
 212
 213 // ////////////////////////////////////////////////////////////////////////// //
 214 function THMouseEvent.press (): Boolean; inline; begin result := (kind = TKind.Press); end;
 215 function THMouseEvent.release (): Boolean; inline; begin result := (kind = TKind.Release); end;
 216 function THMouseEvent.motion (): Boolean; inline; begin result := (kind = TKind.Motion); end;
 217
 218 function THKeyEvent.press (): Boolean; inline; begin result := (kind = TKind.Press); end;
 219 function THKeyEvent.release (): Boolean; inline; begin result := (kind = TKind.Release); end;
 220
 221
 222 // ////////////////////////////////////////////////////////////////////////// //
 223 // any mods = 255: nothing was defined
 224 function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString;
 225 var
 226   pos, epos: Integer;
 227 begin
 228   kmods := 255;
 229   mbuts := 255;
 230   pos := 1;
 231   //while (pos <= Length(s)) and (s[pos] <= ' ') do Inc(pos);
 232   if (pos < Length(s)) and ((s[pos] = '+') or (s[pos] = '-') or (s[pos] = '*')) then Inc(pos);
 233   while (pos < Length(s)) do
 234   begin
 235     if (Length(s)-pos >= 2) and (s[pos+1] = '-') then
 236     begin
 237       case s[pos] of
 238         'C', 'c': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModCtrl; Inc(pos, 2); continue; end;
 239         'M', 'm': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModAlt; Inc(pos, 2); continue; end;
 240         'S', 's': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModShift; Inc(pos, 2); continue; end;
 241       end;
 242       break;
 243     end;
 244     if (Length(s)-pos >= 4) and ((s[pos+1] = 'M') or (s[pos+1] = 'm')) and ((s[pos+2] = 'B') or (s[pos+1] = 'b')) and (s[pos+3] = '-') then
 245     begin
 246       case s[pos] of
 247         'L', 'l': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Left; Inc(pos, 4); continue; end;
 248         'R', 'r': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Right; Inc(pos, 4); continue; end;
 249         'M', 'm': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Middle; Inc(pos, 4); continue; end;
 250       end;
 251       break;
 252     end;
 253     break;
 254   end;
 255   epos := Length(s)+1;
 256   while (epos > pos) and (s[epos-1] <= ' ') do Dec(epos);
 257   if (epos > pos) then result := Copy(s, pos, epos-pos) else result := '';
 258 end;
 259
 260
 261 operator = (constref ev: THKeyEvent; const s: AnsiString): Boolean;
 262 var
 263   f: Integer;
 264   kmods: Byte = 255;
 265   mbuts: Byte = 255;
 266   kname: AnsiString;
 267 begin
 268   result := false;
 269   if (Length(s) > 0) then
 270   begin
 271          if (s[1] = '+') then begin if (not ev.press) then exit; end
 272     else if (s[1] = '-') then begin if (not ev.release) then exit; end
 273     else if (s[1] = '*') then begin end
 274     else if (not ev.press) then exit;
 275   end;
 276   kname := parseModKeys(s, kmods, mbuts);
 277   if (kmods = 255) then kmods := 0;
 278   if (ev.kstate <> kmods) then exit;
 279   if (mbuts <> 255) and (ev.bstate <> mbuts) then exit;
 280
 281   if (strEquCI(kname, 'Enter')) then kname := 'RETURN';
 282
 283   for f := 0 to SDL_NUM_SCANCODES-1 do
 284   begin
 285     if strEquCI(kname, SDL_GetScancodeName(f)) then
 286     begin
 287       result := (ev.scan = f);
 288       exit;
 289     end;
 290   end;
 291 end;
 292
 293
 294 operator = (const s: AnsiString; constref ev: THKeyEvent): Boolean;
 295 begin
 296   result := (ev = s);
 297 end;
 298
 299
 300 operator = (constref ev: THMouseEvent; const s: AnsiString): Boolean;
 301 var
 302   kmods: Byte = 255;
 303   mbuts: Byte = 255;
 304   kname: AnsiString;
 305   but: Integer = -1;
 306 begin
 307   result := false;
 308
 309   if (Length(s) > 0) then
 310   begin
 311          if (s[1] = '+') then begin if (not ev.press) then exit; end
 312     else if (s[1] = '-') then begin if (not ev.release) then exit; end
 313     else if (s[1] = '*') then begin if (not ev.motion) then exit; end
 314     else if (not ev.press) then exit;
 315   end;
 316
 317   kname := parseModKeys(s, kmods, mbuts);
 318        if strEquCI(kname, 'LMB') then but := THMouseEvent.Left
 319   else if strEquCI(kname, 'RMB') then but := THMouseEvent.Right
 320   else if strEquCI(kname, 'MMB') then but := THMouseEvent.Middle
 321   else if strEquCI(kname, 'WheelUp') or strEquCI(kname, 'WUP') then but := THMouseEvent.WheelUp
 322   else if strEquCI(kname, 'WheelDown') or strEquCI(kname, 'WDN') or strEquCI(kname, 'WDOWN') then but := THMouseEvent.WheelDown
 323   else if strEquCI(kname, 'None') then but := 0
 324   else exit;
 325
 326   if (mbuts = 255) then mbuts := 0;
 327   if (kmods = 255) then kmods := 0;
 328   if (ev.kstate <> kmods) then exit;
 329
 330   result := (ev.bstate = mbuts) and (ev.but = but);
 331 end;
 332
 333
 334 operator = (const s: AnsiString; constref ev: THMouseEvent): Boolean;
 335 begin
 336   result := (ev = s);
 337 end;
 338
 339
 340 // ////////////////////////////////////////////////////////////////////////// //
 341 procedure resetKMState (sendEvents: Boolean=true);
 342 var
 343   mask: Word;
 344   mev: THMouseEvent;
 345   kev: THKeyEvent;
 346 begin
 347   // generate mouse release events
 348   if (curButState <> 0) then
 349   begin
 350     if sendEvents then
 351     begin
 352       mask := 1;
 353       while (mask <> 0) do
 354       begin
 355         // checked each time, 'cause `evMouseCB` can be changed from the handler
 356         if ((curButState and mask) <> 0) and assigned(evMouseCB) then
 357         begin
 358           mev.kind := mev.TKind.Release;
 359           mev.x := curMsX;
 360           mev.y := curMsY;
 361           mev.dx := 0;
 362           mev.dy := 0;
 363           mev.but := mask;
 364           mev.bstate := curButState;
 365           mev.kstate := curModState;
 366           curButState := curButState and (not mask);
 367           evMouseCB(mev);
 368         end;
 369         mask := mask shl 1;
 370       end;
 371     end;
 372     curButState := 0;
 373   end;
 374
 375   // generate modifier release events
 376   if (curModState <> 0) then
 377   begin
 378     if sendEvents then
 379     begin
 380       mask := 1;
 381       while (mask <= 8) do
 382       begin
 383         // checked each time, 'cause `evMouseCB` can be changed from the handler
 384         if ((curModState and mask) <> 0) and assigned(evKeyCB) then
 385         begin
 386           kev.kind := kev.TKind.Release;
 387           case mask of
 388             THKeyEvent.ModCtrl: begin kev.scan := SDL_SCANCODE_LCTRL; kev.sym := SDLK_LCTRL;{arbitrary} end;
 389             THKeyEvent.ModAlt: begin kev.scan := SDL_SCANCODE_LALT; kev.sym := SDLK_LALT;{arbitrary} end;
 390             THKeyEvent.ModShift: begin kev.scan := SDL_SCANCODE_LSHIFT; kev.sym := SDLK_LSHIFT;{arbitrary} end;
 391             THKeyEvent.ModHyper: begin kev.scan := SDL_SCANCODE_LGUI; kev.sym := SDLK_LGUI;{arbitrary} end;
 392             else assert(false);
 393           end;
 394           kev.x := curMsX;
 395           kev.y := curMsY;
 396           mev.bstate := 0{curMsButState}; // anyway
 397           mev.kstate := curModState;
 398           curModState := curModState and (not mask);
 399           evKeyCB(kev);
 400         end;
 401         mask := mask shl 1;
 402       end;
 403     end;
 404     curModState := 0;
 405   end;
 406 end;
 407
 408
 409 function onSDLEvent (var ev: TSDL_Event): Boolean;
 410 var
 411   mev: THMouseEvent;
 412   kev: THKeyEvent;
 413
 414   function buildBut (b: Byte): Word;
 415   begin
 416     result := 0;
 417     case b of
 418       SDL_BUTTON_LEFT: result := result or THMouseEvent.Left;
 419       SDL_BUTTON_MIDDLE: result := result or THMouseEvent.Middle;
 420       SDL_BUTTON_RIGHT: result := result or THMouseEvent.Right;
 421     end;
 422   end;
 423
 424 begin
 425   result := false;
 426
 427   case ev.type_ of
 428     SDL_KEYDOWN, SDL_KEYUP:
 429       begin
 430         // fix left/right modifiers
 431         if (ev.type_ = SDL_KEYDOWN) then kev.kind := THKeyEvent.TKind.Press else kev.kind := THKeyEvent.TKind.Release;
 432         kev.scan := ev.key.keysym.scancode;
 433         kev.sym := ev.key.keysym.sym;
 434
 435         if (kev.scan = SDL_SCANCODE_RCTRL) then kev.scan := SDL_SCANCODE_LCTRL;
 436         if (kev.scan = SDL_SCANCODE_RALT) then kev.scan := SDL_SCANCODE_LALT;
 437         if (kev.scan = SDL_SCANCODE_RSHIFT) then kev.scan := SDL_SCANCODE_LSHIFT;
 438         if (kev.scan = SDL_SCANCODE_RGUI) then kev.scan := SDL_SCANCODE_LGUI;
 439
 440         if (kev.sym = SDLK_RCTRL) then kev.sym := SDLK_LCTRL;
 441         if (kev.sym = SDLK_RALT) then kev.sym := SDLK_LALT;
 442         if (kev.sym = SDLK_RSHIFT) then kev.sym := SDLK_LSHIFT;
 443         if (kev.sym = SDLK_RGUI) then kev.sym := SDLK_LGUI;
 444
 445         kev.x := curMsX;
 446         kev.y := curMsY;
 447         kev.bstate := curButState;
 448         kev.kstate := curModState;
 449
 450         case kev.scan of
 451           SDL_SCANCODE_LCTRL: if (kev.press) then curModState := curModState or THKeyEvent.ModCtrl else curModState := curModState and (not THKeyEvent.ModCtrl);
 452           SDL_SCANCODE_LALT: if (kev.press) then curModState := curModState or THKeyEvent.ModAlt else curModState := curModState and (not THKeyEvent.ModAlt);
 453           SDL_SCANCODE_LSHIFT: if (kev.press) then curModState := curModState or THKeyEvent.ModShift else curModState := curModState and (not THKeyEvent.ModShift);
 454         end;
 455
 456         if assigned(evKeyCB) then result := evKeyCB(kev);
 457       end;
 458
 459     SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP:
 460       begin
 461         mev.dx := ev.button.x-curMsX;
 462         mev.dy := ev.button.y-curMsY;
 463         curMsX := ev.button.x;
 464         curMsY := ev.button.y;
 465         if (ev.type_ = SDL_MOUSEBUTTONDOWN) then mev.kind := THMouseEvent.TKind.Press else mev.kind := THMouseEvent.TKind.Release;
 466         mev.but := buildBut(ev.button.button);
 467         mev.x := curMsX;
 468         mev.y := curMsY;
 469         mev.bstate := curButState;
 470         mev.kstate := curModState;
 471         if (mev.but <> 0) then
 472         begin
 473           // ev.button.clicks: Byte
 474           if (ev.type_ = SDL_MOUSEBUTTONDOWN) then curButState := curButState or mev.but else curButState := curButState and (not mev.but);
 475           if assigned(evMouseCB) then result := evMouseCB(mev);
 476         end;
 477       end;
 478     SDL_MOUSEWHEEL:
 479       begin
 480         if (ev.wheel.y <> 0) then
 481         begin
 482           mev.dx := 0;
 483           mev.dy := ev.wheel.y;
 484           mev.kind := THMouseEvent.TKind.Press;
 485           if (ev.wheel.y < 0) then mev.but := THMouseEvent.WheelUp else mev.but := THMouseEvent.WheelDown;
 486           mev.x := curMsX;
 487           mev.y := curMsY;
 488           mev.bstate := curButState;
 489           mev.kstate := curModState;
 490           if assigned(evMouseCB) then result := evMouseCB(mev);
 491         end;
 492       end;
 493     SDL_MOUSEMOTION:
 494       begin
 495         mev.dx := ev.button.x-curMsX;
 496         mev.dy := ev.button.y-curMsY;
 497         curMsX := ev.button.x;
 498         curMsY := ev.button.y;
 499         mev.kind := THMouseEvent.TKind.Motion;
 500         mev.but := 0;
 501         mev.x := curMsX;
 502         mev.y := curMsY;
 503         mev.bstate := curButState;
 504         mev.kstate := curModState;
 505         if assigned(evMouseCB) then result := evMouseCB(mev);
 506       end;
 507
 508     {
 509     SDL_TEXTINPUT:
 510       begin
 511         Utf8ToUnicode(@uc, PChar(ev.text.text), 1);
 512         keychr := Word(uc);
 513         if (keychr > 127) then keychr := Word(wchar2win(WideChar(keychr)));
 514         CharPress(AnsiChar(keychr));
 515       end;
 516     }
 517   end;
 518 end;
 519
 520
 521 // ////////////////////////////////////////////////////////////////////////// //
 522 procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
 523 begin
 524   glViewport(0, 0, winWidth, winHeight);
 525
 526   glDisable(GL_BLEND);
 527   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 528   glDisable(GL_LINE_SMOOTH);
 529   glDisable(GL_POINT_SMOOTH);
 530   glDisable(GL_DEPTH_TEST);
 531   glDisable(GL_TEXTURE_2D);
 532   glDisable(GL_LIGHTING);
 533   glDisable(GL_DITHER);
 534   glDisable(GL_STENCIL_TEST);
 535   glDisable(GL_SCISSOR_TEST);
 536   glDisable(GL_CULL_FACE);
 537
 538   glMatrixMode(GL_PROJECTION);
 539   glLoadIdentity();
 540   if (upsideDown) then
 541   begin
 542     glOrtho(0, winWidth, 0, winHeight, -1, 1); // set origin to bottom left
 543   end
 544   else
 545   begin
 546     glOrtho(0, winWidth, winHeight, 0, -1, 1); // set origin to top left
 547   end;
 548
 549   glMatrixMode(GL_MODELVIEW);
 550   glLoadIdentity();
 551
 552   glClearColor(0, 0, 0, 0);
 553   glColor4f(1, 1, 1, 1);
 554 end;
 555
 556
 557 // ////////////////////////////////////////////////////////////////////////// //
 558 // cursor (hi, Death Track!)
 559 const curTexWidth = 32;
 560 const curTexHeight = 32;
 561 const curWidth = 17;
 562 const curHeight = 23;
 563
 564 const cursorImg: array[0..curWidth*curHeight-1] of Byte = (
 565   2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 566   3,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 567   3,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 568   3,3,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,
 569   3,3,4,2,2,0,0,0,0,0,0,0,0,0,0,0,0,
 570   3,3,4,4,2,2,0,0,0,0,0,0,0,0,0,0,0,
 571   3,3,4,4,4,2,2,0,0,0,0,0,0,0,0,0,0,
 572   3,3,4,4,4,4,2,2,0,0,0,0,0,0,0,0,0,
 573   3,3,4,4,4,5,6,2,2,0,0,0,0,0,0,0,0,
 574   3,3,4,4,5,6,7,5,2,2,0,0,0,0,0,0,0,
 575   3,3,4,5,6,7,5,4,5,2,2,0,0,0,0,0,0,
 576   3,3,5,6,7,5,4,5,6,7,2,2,0,0,0,0,0,
 577   3,3,6,7,5,4,5,6,7,7,7,2,2,0,0,0,0,
 578   3,3,7,5,4,5,6,7,7,7,7,7,2,2,0,0,0,
 579   3,3,5,4,5,6,8,8,8,8,8,8,8,8,2,0,0,
 580   3,3,4,5,6,3,8,8,8,8,8,8,8,8,8,0,0,
 581   3,3,5,6,3,3,0,0,0,0,0,0,0,0,0,0,0,
 582   3,3,6,3,3,0,0,0,0,0,0,0,0,0,0,0,0,
 583   3,3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0,
 584   3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 585   3,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 586   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 587   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 588 );
 589 const cursorPal: array[0..9*4-1] of Byte = (
 590     0,  0,  0,  0,
 591     0,  0,  0,163,
 592    85,255,255,255,
 593    85, 85,255,255,
 594   255, 85, 85,255,
 595   170,  0,170,255,
 596    85, 85, 85,255,
 597     0,  0,  0,255,
 598     0,  0,170,255
 599 );
 600
 601
 602 var
 603   curtexid: GLuint = 0;
 604
 605 procedure createCursorTexture ();
 606 var
 607   tex, tpp: PByte;
 608   c: Integer;
 609   x, y: Integer;
 610 begin
 611   if (curtexid <> 0) then exit; //begin glDeleteTextures(1, @curtexid); curtexid := 0; end;
 612
 613   GetMem(tex, curTexWidth*curTexHeight*4);
 614   try
 615     FillChar(tex^, curTexWidth*curTexHeight*4, 0);
 616
 617     // draw shadow
 618     for y := 0 to curHeight-1 do
 619     begin
 620       for x := 0 to curWidth-1 do
 621       begin
 622         if (cursorImg[y*curWidth+x] <> 0) then
 623         begin
 624           c := 1*4;
 625           tpp := tex+((y+1)*(curTexWidth*4)+(x+3)*4);
 626           tpp^ := cursorPal[c+0]; Inc(tpp);
 627           tpp^ := cursorPal[c+1]; Inc(tpp);
 628           tpp^ := cursorPal[c+2]; Inc(tpp);
 629           tpp^ := cursorPal[c+3]; Inc(tpp);
 630           tpp^ := cursorPal[c+0]; Inc(tpp);
 631           tpp^ := cursorPal[c+1]; Inc(tpp);
 632           tpp^ := cursorPal[c+2]; Inc(tpp);
 633           tpp^ := cursorPal[c+3]; Inc(tpp);
 634         end;
 635       end;
 636     end;
 637
 638     // draw cursor
 639     for y := 0 to curHeight-1 do
 640     begin
 641       for x := 0 to curWidth-1 do
 642       begin
 643         c := cursorImg[y*curWidth+x]*4;
 644         if (c <> 0) then
 645         begin
 646           tpp := tex+(y*(curTexWidth*4)+x*4);
 647           tpp^ := cursorPal[c+0]; Inc(tpp);
 648           tpp^ := cursorPal[c+1]; Inc(tpp);
 649           tpp^ := cursorPal[c+2]; Inc(tpp);
 650           tpp^ := cursorPal[c+3]; Inc(tpp);
 651         end;
 652       end;
 653     end;
 654
 655     glGenTextures(1, @curtexid);
 656     if (curtexid = 0) then raise Exception.Create('can''t create cursor texture');
 657
 658     glBindTexture(GL_TEXTURE_2D, curtexid);
 659     glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
 660     glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
 661     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
 662     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
 663
 664     //GLfloat[4] bclr = 0.0;
 665     //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr);
 666
 667     glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, curTexWidth, curTexHeight, 0, GL_RGBA{gltt}, GL_UNSIGNED_BYTE, tex);
 668     glFlush();
 669   finally
 670     FreeMem(tex);
 671   end;
 672 end;
 673
 674 procedure oglDrawCursorAt (msX, msY: Integer);
 675 begin
 676   //if (curtexid = 0) then createCursorTexture() else glBindTexture(GL_TEXTURE_2D, curtexid);
 677   glBindTexture(GL_TEXTURE_2D, curtexid);
 678   // blend it
 679   glEnable(GL_BLEND);
 680   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 681   glEnable(GL_TEXTURE_2D);
 682   glDisable(GL_STENCIL_TEST);
 683   glDisable(GL_SCISSOR_TEST);
 684   glDisable(GL_LIGHTING);
 685   glDisable(GL_DEPTH_TEST);
 686   glDisable(GL_CULL_FACE);
 687   // color and opacity
 688   glColor4f(1, 1, 1, 0.9);
 689   //Dec(msX, 2);
 690   glBegin(GL_QUADS);
 691     glTexCoord2f(0.0, 0.0); glVertex2i(msX, msY); // top-left
 692     glTexCoord2f(1.0, 0.0); glVertex2i(msX+curTexWidth, msY); // top-right
 693     glTexCoord2f(1.0, 1.0); glVertex2i(msX+curTexWidth, msY+curTexHeight); // bottom-right
 694     glTexCoord2f(0.0, 1.0); glVertex2i(msX, msY+curTexHeight); // bottom-left
 695   glEnd();
 696   //Inc(msX, 2);
 697   glDisable(GL_BLEND);
 698   glDisable(GL_TEXTURE_2D);
 699   glColor4f(1, 1, 1, 1);
 700   glBindTexture(GL_TEXTURE_2D, 0);
 701 end;
 702
 703 procedure oglDrawCursor (); begin oglDrawCursorAt(curMsX, curMsY); end;
 704
 705
 706 // ////////////////////////////////////////////////////////////////////////// //
 707 // fonts
 708 const kgiFont6: array[0..256*8-1] of Byte  = (
 709 $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,
 710 $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,
 711 $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,
 712 $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,
 713 $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,
 714 $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,
 715 $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,
 716 $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,
 717 $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,
 718 $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,
 719 $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,
 720 $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,
 721 $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,
 722 $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,
 723 $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,
 724 $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,
 725 $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,
 726 $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,
 727 $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,
 728 $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,
 729 $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,
 730 $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,
 731 $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,
 732 $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,
 733 $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,
 734 $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,
 735 $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,
 736 $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,
 737 $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,
 738 $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,
 739 $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,
 740 $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,
 741 $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,
 742 $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,
 743 $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,
 744 $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,
 745 $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,
 746 $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,
 747 $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,
 748 $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,
 749 $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,
 750 $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,
 751 $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,
 752 $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,
 753 $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,
 754 $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,
 755 $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,
 756 $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,
 757 $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,
 758 $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,
 759 $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,
 760 $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,
 761 $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,
 762 $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,
 763 $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,
 764 $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,
 765 $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,
 766 $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,
 767 $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,
 768 $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,
 769 $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,
 770 $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,
 771 $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,
 772 $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,
 773 $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,
 774 $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,
 775 $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,
 776 $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,
 777 $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,
 778 $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,
 779 $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,
 780 $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,
 781 $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,
 782 $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,
 783 $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,
 784 $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,
 785 $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,
 786 $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,
 787 $a8,$f8,$08,$00,$88,$88,$88,$88,$78,$08,$08,$00,$c0,$40,$40,$70,$48,$48,$70,$00
 788 );
 789
 790 const kgiFont8: array[0..256*8-1] of Byte  = (
 791 $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,
 792 $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,
 793 $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,
 794 $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,
 795 $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,
 796 $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,
 797 $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,
 798 $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,
 799 $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,
 800 $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,
 801 $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,
 802 $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,
 803 $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,
 804 $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,
 805 $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,
 806 $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,
 807 $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,
 808 $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,
 809 $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,
 810 $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,
 811 $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,
 812 $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,
 813 $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,
 814 $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,
 815 $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,
 816 $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,
 817 $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,
 818 $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,
 819 $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,
 820 $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,
 821 $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,
 822 $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,
 823 $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,
 824 $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,
 825 $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,
 826 $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,
 827 $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,
 828 $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,
 829 $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,
 830 $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,
 831 $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,
 832 $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,
 833 $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,
 834 $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,
 835 $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,
 836 $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,
 837 $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,
 838 $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,
 839 $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,
 840 $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,
 841 $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,
 842 $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,
 843 $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,
 844 $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,
 845 $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,
 846 $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,
 847 $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,
 848 $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,
 849 $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,
 850 $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,
 851 $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,
 852 $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,
 853 $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,
 854 $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,
 855 $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,
 856 $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,
 857 $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,
 858 $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,
 859 $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,
 860 $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,
 861 $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,
 862 $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,
 863 $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,
 864 $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,
 865 $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,
 866 $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,
 867 $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,
 868 $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,
 869 $7c,$00,$00,$00,$00,$00,$3c,$3c,$3c,$3c,$00,$00,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff
 870 );
 871
 872 const kgiFont6PropWidth: array[0..256-1] of Byte = (
 873   $08,$08,$08,$07,$07,$07,$07,$04,$08,$07,$08,$08,$06,$06,$06,$07,
 874   $06,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,
 875   $85,$21,$13,$05,$05,$05,$05,$13,$13,$13,$05,$05,$12,$14,$12,$05,
 876   $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$21,$12,$05,$05,$05,$05,
 877   $05,$05,$05,$05,$05,$05,$05,$05,$05,$13,$05,$05,$05,$05,$05,$05,
 878   $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$13,$05,$13,$05,$05,
 879   $13,$05,$05,$05,$05,$05,$05,$05,$05,$13,$04,$14,$13,$05,$05,$05,
 880   $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$14,$21,$04,$05,$08,
 881   $08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$04,
 882   $44,$08,$08,$08,$08,$08,$08,$08,$05,$04,$05,$08,$08,$08,$08,$08,
 883   $05,$05,$05,$05,$05,$05,$13,$13,$05,$05,$05,$04,$05,$05,$05,$05,
 884   $05,$05,$05,$05,$05,$03,$04,$04,$06,$05,$04,$07,$04,$03,$05,$08,
 885   $05,$05,$05,$05,$05,$05,$05,$14,$05,$05,$05,$04,$05,$05,$05,$05,
 886   $14,$05,$05,$05,$05,$05,$05,$05,$14,$05,$05,$05,$05,$05,$14,$05,
 887   $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,
 888   $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05
 889 );
 890
 891 const kgiFont8PropWidth: array[0..256-1] of Byte = (
 892   $08,$08,$08,$07,$07,$07,$07,$06,$08,$07,$08,$08,$07,$08,$08,$08,
 893   $07,$07,$07,$07,$08,$08,$07,$08,$07,$07,$07,$07,$07,$08,$08,$08,
 894   $85,$14,$15,$07,$06,$07,$07,$03,$14,$14,$08,$06,$13,$06,$22,$07,
 895   $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$22,$13,$05,$06,$15,$06,
 896   $07,$06,$07,$07,$07,$07,$07,$07,$06,$14,$07,$07,$07,$07,$07,$07,
 897   $07,$06,$07,$06,$06,$06,$06,$07,$07,$06,$07,$14,$07,$14,$07,$08,
 898   $23,$07,$07,$06,$07,$06,$06,$07,$07,$14,$05,$07,$14,$07,$06,$06,
 899   $07,$07,$06,$06,$15,$07,$06,$07,$07,$06,$06,$06,$32,$06,$07,$07,
 900   $06,$07,$06,$08,$07,$07,$07,$07,$08,$06,$06,$06,$07,$05,$06,$06,
 901   $06,$08,$07,$06,$06,$06,$07,$07,$06,$07,$06,$07,$07,$06,$07,$08,
 902   $07,$05,$06,$07,$06,$06,$16,$16,$06,$06,$06,$08,$08,$06,$08,$08,
 903   $08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,
 904   $38,$08,$08,$38,$08,$08,$38,$28,$28,$28,$08,$08,$28,$08,$08,$08,
 905   $08,$08,$08,$28,$38,$38,$28,$08,$08,$08,$38,$08,$08,$08,$48,$08,
 906   $07,$06,$07,$07,$07,$07,$07,$07,$06,$07,$07,$06,$08,$08,$06,$06,
 907   $06,$06,$06,$06,$35,$05,$06,$07,$15,$32,$32,$08,$15,$15,$24,$08
 908 );
 909
 910
 911 function createFontTexture (constref font: array of Byte; constref fontwdt: array of Byte; prop: Boolean): GLuint;
 912 const
 913   Width = 16*8;
 914   Height = 16*8;
 915 var
 916   tex, tpp: PByte;
 917   b: Byte;
 918   cc: Integer;
 919   x, y, dx, dy: Integer;
 920 begin
 921   GetMem(tex, Width*Height*4);
 922
 923   for cc := 0 to 255 do
 924   begin
 925     x := (cc mod 16)*8;
 926     y := (cc div 16)*8;
 927     for dy := 0 to 7 do
 928     begin
 929       b := font[cc*8+dy];
 930       if prop then b := b shl (fontwdt[cc] shr 4);
 931       tpp := tex+((y+dy)*(Width*4))+x*4;
 932       for dx := 0 to 7 do
 933       begin
 934         if ((b and $80) <> 0) then
 935         begin
 936           tpp^ := 255; Inc(tpp);
 937           tpp^ := 255; Inc(tpp);
 938           tpp^ := 255; Inc(tpp);
 939           tpp^ := 255; Inc(tpp);
 940         end
 941         else
 942         begin
 943           tpp^ := 0; Inc(tpp);
 944           tpp^ := 0; Inc(tpp);
 945           tpp^ := 0; Inc(tpp);
 946           tpp^ := 0; Inc(tpp);
 947         end;
 948         b := (b and $7f) shl 1;
 949       end;
 950     end;
 951   end;
 952
 953   glGenTextures(1, @result);
 954   if (result = 0) then raise Exception.Create('can''t create Holmes font texture');
 955
 956   glBindTexture(GL_TEXTURE_2D, result);
 957   glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
 958   glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
 959   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
 960   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
 961
 962   //GLfloat[4] bclr = 0.0;
 963   //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr);
 964
 965   glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Width, Height, 0, GL_RGBA{gltt}, GL_UNSIGNED_BYTE, tex);
 966   glFlush();
 967
 968   //FreeMem(tex);
 969 end;
 970
 971
 972 var
 973   font6texid: GLuint = 0;
 974   font8texid: GLuint = 0;
 975   prfont6texid: GLuint = 0;
 976   prfont8texid: GLuint = 0;
 977
 978
 979 procedure deleteFonts ();
 980 begin
 981   if (font6texid <> 0) then glDeleteTextures(1, @font6texid);
 982   if (font8texid <> 0) then glDeleteTextures(1, @font8texid);
 983   if (prfont6texid <> 0) then glDeleteTextures(1, @prfont6texid);
 984   if (prfont8texid <> 0) then glDeleteTextures(1, @prfont8texid);
 985   font6texid := 0;
 986   font8texid := 0;
 987   prfont6texid := 0;
 988   prfont8texid := 0;
 989 end;
 990
 991
 992 procedure createFonts ();
 993 begin
 994   if (font6texid = 0) then font6texid := createFontTexture(kgiFont6, kgiFont6PropWidth, false);
 995   if (font8texid = 0) then font8texid := createFontTexture(kgiFont8, kgiFont8PropWidth, false);
 996   if (prfont6texid = 0) then prfont6texid := createFontTexture(kgiFont6, kgiFont6PropWidth, true);
 997   if (prfont8texid = 0) then prfont8texid := createFontTexture(kgiFont8, kgiFont8PropWidth, true);
 998 end;
 999
1000
1001 // ////////////////////////////////////////////////////////////////////////// //
1002 procedure TScissorSave.save (enableScissoring: Boolean);
1003 begin
1004   wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
1005   if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
1006   //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
1007   if enableScissoring then glEnable(GL_SCISSOR_TEST);
1008 end;
1009
1010 procedure TScissorSave.restore ();
1011 begin
1012   glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]);
1013   if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
1014 end;
1015
1016 procedure TScissorSave.setRect (x, y, w, h: Integer);
1017 begin
1018   if (w < 1) or (h < 1) then begin glScissor(0, 0, 0, 0); exit; end;
1019   y := gScrHeight-(y+h);
1020   if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then glScissor(0, 0, 0, 0) else glScissor(x, y, w, h);
1021 end;
1022
1023 //TODO: overflow checks
1024 function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
1025 var
1026   ex0, ey0: Integer;
1027 begin
1028   result := false;
1029   if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit;
1030   // check for intersection
1031   if (x0+w0 <= x1) or (y0+h0 <= y1) or (x1+w1 <= x0) or (y1+h1 <= y0) then exit;
1032   if (x0 >= x1+w1) or (y0 >= y1+h1) or (x1 >= x0+h0) or (y1 >= y0+h0) then exit;
1033   // ok, intersects
1034   ex0 := x0+w0;
1035   ey0 := y0+h0;
1036   if (x0 < x1) then x0 := x1;
1037   if (y0 < y1) then y0 := y1;
1038   if (ex0 > x1+w1) then ex0 := x1+w1;
1039   if (ey0 > y1+h1) then ey0 := y1+h1;
1040   w0 := ex0-x0;
1041   h0 := ey0-y0;
1042   result := (w0 > 0) and (h0 > 0);
1043 end;
1044
1045
1046 // ////////////////////////////////////////////////////////////////////////// //
1047 procedure normRGBA (var r, g, b, a: Integer); inline;
1048 begin
1049   if (a < 0) then a := 0 else if (a > 255) then a := 255;
1050   if (r < 0) then r := 0 else if (r > 255) then r := 255;
1051   if (g < 0) then g := 0 else if (g > 255) then g := 255;
1052   if (b < 0) then b := 0 else if (b > 255) then b := 255;
1053 end;
1054
1055 // returns `false` if the color is transparent
1056 function setupGLColor (r, g, b, a: Integer): Boolean;
1057 begin
1058   normRGBA(r, g, b, a);
1059   if (a < 255) then
1060   begin
1061     if (a = 0) then begin result := false; exit; end;
1062     glEnable(GL_BLEND);
1063     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1064   end
1065   else
1066   begin
1067     glDisable(GL_BLEND);
1068   end;
1069   glColor4ub(Byte(r), Byte(g), Byte(b), Byte(a));
1070   result := true;
1071 end;
1072
1073 function isScaled (): Boolean;
1074 var
1075   mt: packed array [0..15] of Double;
1076 begin
1077   glGetDoublev(GL_MODELVIEW_MATRIX, @mt[0]);
1078   result := (mt[0] <> 1.0) or (mt[1*4+1] <> 1.0);
1079 end;
1080
1081
1082 // ////////////////////////////////////////////////////////////////////////// //
1083 function textWidth6 (const s: AnsiString): Integer;
1084 var
1085   f: Integer;
1086 begin
1087   result := 0;
1088   for f := 1 to Length(s) do Inc(result, Integer(kgiFont6PropWidth[Integer(s[f])] and $0f)+1);
1089   if (result > 0) then Dec(result); // don't count last empty pixel
1090 end;
1091
1092
1093 function textWidth8 (const s: AnsiString): Integer;
1094 var
1095   f: Integer;
1096 begin
1097   result := 0;
1098   for f := 1 to Length(s) do Inc(result, Integer(kgiFont8PropWidth[Integer(s[f])] and $0f)+1);
1099   if (result > 0) then Dec(result); // don't count last empty pixel
1100 end;
1101
1102
1103 // return width (including last empty pixel)
1104 function drawTextInternal (wdt, x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer; tid: GLuint; constref fontwdt: array of Byte; prop: Boolean): Integer;
1105 var
1106   f, c: Integer;
1107   tx, ty: Integer;
1108 begin
1109   result := 0;
1110   if (Length(s) = 0) then exit;
1111   if not setupGLColor(r, g, b, a) then exit;
1112
1113   glEnable(GL_ALPHA_TEST);
1114   glAlphaFunc(GL_NOTEQUAL, 0.0);
1115   glEnable(GL_TEXTURE_2D);
1116   glBindTexture(GL_TEXTURE_2D, tid);
1117
1118   for f := 1 to Length(s) do
1119   begin
1120     c := Integer(s[f]) and $ff;
1121     tx := (c mod 16)*8;
1122     ty := (c div 16)*8;
1123     glBegin(GL_QUADS);
1124       glTexCoord2f((tx+0)/128.0, (ty+0)/128.0); glVertex2i(x+0, y+0); // top-left
1125       glTexCoord2f((tx+8)/128.0, (ty+0)/128.0); glVertex2i(x+8, y+0); // top-right
1126       glTexCoord2f((tx+8)/128.0, (ty+8)/128.0); glVertex2i(x+8, y+8); // bottom-right
1127       glTexCoord2f((tx+0)/128.0, (ty+8)/128.0); glVertex2i(x+0, y+8); // bottom-left
1128     glEnd();
1129     if prop then
1130     begin
1131       x += Integer(fontwdt[c] and $0f)+1;
1132       result += Integer(fontwdt[c] and $0f)+1;
1133     end
1134     else
1135     begin
1136       x += wdt;
1137       result += wdt;
1138     end;
1139   end;
1140
1141   glDisable(GL_ALPHA_TEST);
1142   glDisable(GL_BLEND);
1143   glDisable(GL_TEXTURE_2D);
1144   glColor4f(1, 1, 1, 1);
1145   glBindTexture(GL_TEXTURE_2D, 0);
1146 end;
1147
1148
1149 // ////////////////////////////////////////////////////////////////////////// //
1150 procedure drawHLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255);
1151 begin
1152   if (len < 1) then exit;
1153   if not setupGLColor(r, g, b, a) then exit;
1154   glDisable(GL_TEXTURE_2D);
1155   if (not isScaled) then
1156   begin
1157     glBegin(GL_LINES);
1158       glVertex2f(x+0.375, y+0.375);
1159       glVertex2f(x+len+0.375, y+0.375);
1160     glEnd();
1161   end
1162   else
1163   begin
1164     glBegin(GL_QUADS);
1165       glVertex2i(x, y);
1166       glVertex2i(x+len, y);
1167       glVertex2i(x+len, y+1);
1168       glVertex2i(x, y+1);
1169     glEnd();
1170   end;
1171 end;
1172
1173
1174 procedure drawVLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255);
1175 begin
1176   if (len < 1) then exit;
1177   if not setupGLColor(r, g, b, a) then exit;
1178   glDisable(GL_TEXTURE_2D);
1179   if (not isScaled) then
1180   begin
1181     glBegin(GL_LINES);
1182       glVertex2f(x+0.375, y+0.375);
1183       glVertex2f(x+0.375, y+len+0.375);
1184     glEnd();
1185   end
1186   else
1187   begin
1188     glBegin(GL_QUADS);
1189       glVertex2i(x, y);
1190       glVertex2i(x, y+len);
1191       glVertex2i(x+1, y+len);
1192       glVertex2i(x+1, y);
1193     glEnd();
1194   end;
1195 end;
1196
1197
1198 procedure drawLine (x1, y1, x2, y2: Integer; r, g, b: Integer; a: Integer=255);
1199 begin
1200   if not setupGLColor(r, g, b, a) then exit;
1201
1202   glDisable(GL_TEXTURE_2D);
1203
1204   glLineWidth(1);
1205   glPointSize(1);
1206
1207   if (not isScaled) then
1208   begin
1209     glBegin(GL_LINES);
1210       glVertex2f(x1+0.375, y1+0.375);
1211       glVertex2f(x2+0.375, y2+0.375);
1212     glEnd();
1213
1214     if (x1 <> x2) or (y1 <> y2) then
1215     begin
1216       glBegin(GL_POINTS);
1217         glVertex2f(x2+0.375, y2+0.375);
1218       glEnd();
1219     end;
1220   end
1221   else
1222   begin
1223     glBegin(GL_LINES);
1224       glVertex2i(x1, y1);
1225       glVertex2i(x2, y2);
1226       // draw last point
1227       glVertex2i(x2, y2);
1228       glVertex2i(x2+1, y2+1);
1229     glEnd();
1230   end;
1231
1232   glColor4f(1, 1, 1, 1);
1233   glDisable(GL_BLEND);
1234 end;
1235
1236
1237 procedure drawRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255);
1238 begin
1239   if (w < 0) or (h < 0) then exit;
1240   if not setupGLColor(r, g, b, a) then exit;
1241   glDisable(GL_TEXTURE_2D);
1242   glLineWidth(1);
1243   glDisable(GL_LINE_SMOOTH);
1244   glDisable(GL_POLYGON_SMOOTH);
1245   if (w = 1) and (h = 1) then
1246   begin
1247     glBegin(GL_POINTS);
1248       glVertex2f(x+0.375, y+0.375);
1249     glEnd();
1250   end
1251   else
1252   begin
1253     glBegin(GL_LINES);
1254       glVertex2i(x, y); glVertex2i(x+w, y); // top
1255       glVertex2i(x, y+h-1); glVertex2i(x+w, y+h-1); // bottom
1256       glVertex2f(x+0.375, y+1); glVertex2f(x+0.375, y+h-1); // left
1257       glVertex2f(x+w-1+0.375, y+1); glVertex2f(x+w-1+0.375, y+h-1); // right
1258     glEnd();
1259   end;
1260   //glRect(x, y, x+w, y+h);
1261   glColor4f(1, 1, 1, 1);
1262   glDisable(GL_BLEND);
1263 end;
1264
1265
1266 procedure drawRectUI (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255);
1267   procedure hline (x, y, len: Integer);
1268   begin
1269     if (len < 1) then exit;
1270     glBegin(GL_QUADS);
1271       glVertex2i(x, y);
1272       glVertex2i(x+len, y);
1273       glVertex2i(x+len, y+1);
1274       glVertex2i(x, y+1);
1275     glEnd();
1276   end;
1277
1278   procedure vline (x, y, len: Integer);
1279   begin
1280     if (len < 1) then exit;
1281     glBegin(GL_QUADS);
1282       glVertex2i(x, y);
1283       glVertex2i(x, y+len);
1284       glVertex2i(x+1, y+len);
1285       glVertex2i(x+1, y);
1286     glEnd();
1287   end;
1288
1289 var
1290   scaled: Boolean;
1291 begin
1292   if (w < 0) or (h < 0) then exit;
1293   if not setupGLColor(r, g, b, a) then exit;
1294   glDisable(GL_TEXTURE_2D);
1295   glLineWidth(1);
1296   glDisable(GL_LINE_SMOOTH);
1297   glDisable(GL_POLYGON_SMOOTH);
1298   scaled := isScaled();
1299   if (w = 1) and (h = 1) then
1300   begin
1301     glBegin(GL_POINTS);
1302       if scaled then glVertex2i(x, y) else glVertex2f(x+0.375, y+0.375);
1303     glEnd();
1304   end
1305   else
1306   begin
1307     if not scaled then
1308     begin
1309       glBegin(GL_LINES);
1310         glVertex2i(x, y); glVertex2i(x+w, y); // top
1311         glVertex2i(x, y+h-1); glVertex2i(x+w, y+h-1); // bottom
1312         glVertex2f(x+0.375, y+1); glVertex2f(x+0.375, y+h-1); // left
1313         glVertex2f(x+w-1+0.375, y+1); glVertex2f(x+w-1+0.375, y+h-1); // right
1314       glEnd();
1315     end
1316     else
1317     begin
1318       hline(x, y, w);
1319       hline(x, y+h-1, w);
1320       vline(x, y+1, h-2);
1321       vline(x+w-1, y+1, h-2);
1322     end;
1323   end;
1324   //glRect(x, y, x+w, y+h);
1325   glColor4f(1, 1, 1, 1);
1326   glDisable(GL_BLEND);
1327 end;
1328
1329
1330 procedure darkenRect (x, y, w, h: Integer; a: Integer);
1331 begin
1332   if (w < 0) or (h < 0) then exit;
1333   if (a < 0) then a := 0;
1334   if (a >= 255) then exit;
1335   glEnable(GL_BLEND);
1336   glBlendFunc(GL_ZERO, GL_SRC_ALPHA);
1337   glDisable(GL_LINE_SMOOTH);
1338   glDisable(GL_POLYGON_SMOOTH);
1339   glDisable(GL_TEXTURE_2D);
1340   glColor4f(0.0, 0.0, 0.0, a/255.0);
1341   glBegin(GL_QUADS);
1342     glVertex2i(x, y);
1343     glVertex2i(x+w, y);
1344     glVertex2i(x+w, y+h);
1345     glVertex2i(x, y+h);
1346   glEnd();
1347   //glRect(x, y, x+w, y+h);
1348   glColor4f(1, 1, 1, 1);
1349   glDisable(GL_BLEND);
1350   //glBlendEquation(GL_FUNC_ADD);
1351 end;
1352
1353
1354 procedure fillRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255);
1355 begin
1356   if (w < 0) or (h < 0) then exit;
1357   if not setupGLColor(r, g, b, a) then exit;
1358   glDisable(GL_LINE_SMOOTH);
1359   glDisable(GL_POLYGON_SMOOTH);
1360   glDisable(GL_TEXTURE_2D);
1361   glBegin(GL_QUADS);
1362     glVertex2f(x, y);
1363     glVertex2f(x+w, y);
1364     glVertex2f(x+w, y+h);
1365     glVertex2f(x, y+h);
1366   glEnd();
1367   glColor4f(1, 1, 1, 1);
1368   glDisable(GL_BLEND);
1369 end;
1370
1371
1372 // ////////////////////////////////////////////////////////////////////////// //
1373 function drawText6 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
1374 begin
1375   if (font6texid = 0) then createFonts();
1376   drawTextInternal(6, x, y, s, r, g, b, a, font6texid, kgiFont6PropWidth, false);
1377   result := Length(s)*6;
1378 end;
1379
1380 function drawText8 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
1381 begin
1382   if (font8texid = 0) then createFonts();
1383   drawTextInternal(8, x, y, s, r, g, b, a, font8texid, kgiFont8PropWidth, false);
1384   result := Length(s)*8;
1385 end;
1386
1387 function drawText6Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
1388 begin
1389   if (prfont6texid = 0) then createFonts();
1390   result := drawTextInternal(6, x, y, s, r, g, b, a, prfont6texid, kgiFont6PropWidth, true);
1391 end;
1392
1393 function drawText8Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
1394 begin
1395   if (prfont8texid = 0) then createFonts();
1396   result := drawTextInternal(8, x, y, s, r, g, b, a, prfont8texid, kgiFont8PropWidth, true);
1397 end;
1398
1399
1400 // ////////////////////////////////////////////////////////////////////////// //
1401 // x-centered at `x`
1402 function drawText6XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
1403 begin
1404   if (font6texid = 0) then createFonts();
1405   x -= Length(s)*6 div 2;
1406   drawTextInternal(6, x, y, s, r, g, b, a, font6texid, kgiFont6PropWidth, false);
1407   result := Length(s)*6;
1408 end;
1409
1410 function drawText8XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
1411 begin
1412   if (font8texid = 0) then createFonts();
1413   x -= Length(s)*8 div 2;
1414   drawTextInternal(8, x, y, s, r, g, b, a, font8texid, kgiFont8PropWidth, false);
1415   result := Length(s)*8;
1416 end;
1417
1418 function drawText6PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
1419 begin
1420   if (prfont6texid = 0) then createFonts();
1421   x -= textWidth6(s) div 2;
1422   result := drawTextInternal(6, x, y, s, r, g, b, a, prfont6texid, kgiFont6PropWidth, true);
1423 end;
1424
1425 function drawText8PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
1426 begin
1427   if (prfont8texid = 0) then createFonts();
1428   x -= textWidth8(s) div 2;
1429   result := drawTextInternal(8, x, y, s, r, g, b, a, prfont8texid, kgiFont8PropWidth, true);
1430 end;
1431
1432
1433 // ////////////////////////////////////////////////////////////////////////// //
1434 procedure oglRestoreMode (doClear: Boolean);
1435 begin
1436   oglSetup2D(gScrWidth, gScrHeight);
1437   glScissor(0, 0, gScrWidth, gScrHeight);
1438
1439   glBindTexture(GL_TEXTURE_2D, 0);
1440   glDisable(GL_BLEND);
1441   glDisable(GL_TEXTURE_2D);
1442   glDisable(GL_STENCIL_TEST);
1443   glDisable(GL_SCISSOR_TEST);
1444   glDisable(GL_LIGHTING);
1445   glDisable(GL_DEPTH_TEST);
1446   glDisable(GL_CULL_FACE);
1447   glDisable(GL_LINE_SMOOTH);
1448   glDisable(GL_POINT_SMOOTH);
1449   glLineWidth(1);
1450   glPointSize(1);
1451   glColor4f(1, 1, 1, 1);
1452
1453   if doClear then
1454   begin
1455     glClearColor(0, 0, 0, 0);
1456     glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_ACCUM_BUFFER_BIT or GL_STENCIL_BUFFER_BIT);
1457   end;
1458
1459   // scale everything
1460   glMatrixMode(GL_MODELVIEW);
1461   glLoadIdentity();
1462   //glScalef(4, 4, 1);
1463 end;
1464
1465
1466 procedure onWinFocus (); begin end;
1467
1468 procedure onWinBlur (); begin resetKMState(true); end;
1469
1470 procedure onPreRender (); begin oglRestoreMode(gGfxDoClear); end;
1471
1472 procedure onPostRender (); begin oglRestoreMode(false); oglDrawCursor(); end;
1473
1474 procedure onInit ();
1475 begin
1476   oglSetup2D(gScrWidth, gScrHeight);
1477
1478   createCursorTexture();
1479   createFonts();
1480 end;
1481
1482 procedure onDeinit ();
1483 begin
1484   resetKMState(false);
1485   if (curtexid <> 0) then glDeleteTextures(1, @curtexid);
1486   curtexid := 0;
1487   deleteFonts();
1488   curButState := 0;
1489   curModState := 0;
1490   curMsX := 0;
1491   curMsY := 0;
1492 end;
1493
1494
1495 // ////////////////////////////////////////////////////////////////////////// //
1496 begin
1497   evSDLCB := onSDLEvent;
1498   winFocusCB := onWinFocus;
1499   winBlurCB := onWinBlur;
1500   prerenderFrameCB := onPreRender;
1501   postrenderFrameCB := onPostRender;
1502   oglInitCB := onInit;
1503   oglDeinitCB := onDeinit;
1504 end.