src/flexui/fui_gfx_gl.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 {$DEFINE FUI_TEXT_ICONS}
  19 unit fui_gfx_gl;
  20
  21 interface
  22
  23 uses
  24   SysUtils, Classes,
  25   GL, GLExt, SDL2,
  26   sdlcarcass,
  27   fui_common, fui_events;
  28
  29
  30 // ////////////////////////////////////////////////////////////////////////// //
  31 type
  32   TGxFont = class
  33   protected
  34     mName: AnsiString;
  35     mHeight: Integer;
  36     mBaseLine: Integer;
  37
  38   public
  39     function charWidth (const ch: AnsiChar): Integer; virtual; abstract;
  40     function textWidth (const s: AnsiString): Integer; virtual; abstract;
  41
  42   public
  43     property name: AnsiString read mName;
  44     property height: Integer read mHeight;
  45     property baseLine: Integer read mBaseLine;
  46   end;
  47
  48   TGxContext = class
  49   public
  50     type
  51       TMarkIcon = (
  52         Checkbox,
  53         Radiobox
  54       );
  55
  56     type
  57       TWinIcon = (
  58         Close
  59       );
  60
  61   protected
  62     mActive: Boolean;
  63     mColor: TGxRGBA;
  64     mFont: TGxFont;
  65     // for active contexts
  66     mScaled: Boolean;
  67     mScale: Single;
  68     mClipRect: TGxRect;
  69     mClipOfs: TGxOfs;
  70
  71   protected
  72     function getFont (): AnsiString;
  73     procedure setFont (const aname: AnsiString);
  74
  75     procedure onActivate ();
  76     procedure onDeactivate ();
  77
  78     procedure setColor (const clr: TGxRGBA);
  79
  80     procedure realizeClip (); // setup scissoring
  81
  82     procedure setClipOfs (const aofs: TGxOfs);
  83     procedure setClipRect (const aclip: TGxRect);
  84
  85   public
  86     constructor Create ();
  87     destructor Destroy (); override;
  88
  89     procedure line (x1, y1, x2, y2: Integer);
  90     procedure hline (x, y, len: Integer);
  91     procedure vline (x, y, len: Integer);
  92     procedure rect (x, y, w, h: Integer);
  93     procedure fillRect (x, y, w, h: Integer);
  94     procedure darkenRect (x, y, w, h: Integer; a: Integer);
  95
  96     function charWidth (const ch: AnsiChar): Integer;
  97     function charHeight (const ch: AnsiChar): Integer;
  98     function textWidth (const s: AnsiString): Integer;
  99     function textHeight (const s: AnsiString): Integer;
 100     function drawChar (x, y: Integer; const ch: AnsiChar): Integer; // returns char width
 101     function drawText (x, y: Integer; const s: AnsiString): Integer; // returns text width
 102
 103     function iconMarkWidth (ic: TMarkIcon): Integer;
 104     function iconMarkHeight (ic: TMarkIcon): Integer;
 105     procedure drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean);
 106
 107     function iconWinWidth (ic: TWinIcon): Integer;
 108     function iconWinHeight (ic: TWinIcon): Integer;
 109     procedure drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean);
 110
 111     procedure resetClip ();
 112
 113     function setOffset (constref aofs: TGxOfs): TGxOfs; // returns previous offset
 114     function setClip (constref aclip: TGxRect): TGxRect; // returns previous clip
 115
 116     function combineClip (constref aclip: TGxRect): TGxRect; // returns previous clip
 117
 118   public //HACK!
 119     procedure glSetScale (ascale: Single);
 120     procedure glSetTrans (ax, ay: Single);
 121     procedure glSetScaleTrans (ascale, ax, ay: Single);
 122
 123   public
 124     property active: Boolean read mActive;
 125     property color: TGxRGBA read mColor write setColor;
 126     property font: AnsiString read getFont write setFont;
 127     property offset: TGxOfs read mClipOfs write setClipOfs;
 128     property clip: TGxRect read mClipRect write setClipRect; // clipping is unaffected by offset
 129   end;
 130
 131
 132 // set active context; `ctx` can be `nil`
 133 procedure gxSetContext (ctx: TGxContext; ascale: Single=1.0);
 134 procedure gxSetContextNoMatrix (ctx: TGxContext);
 135
 136
 137 // setup 2D OpenGL mode; will be called automatically in `glInit()`
 138 procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
 139 procedure oglSetup2DState (); // don't modify viewports and matrices
 140
 141 procedure oglDrawCursor ();
 142 procedure oglDrawCursorAt (msX, msY: Integer);
 143
 144
 145 procedure fuiGfxLoadFont (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean=false);
 146 procedure fuiGfxLoadFont (const fontname: AnsiString; st: TStream; proportional: Boolean=false);
 147
 148
 149 // ////////////////////////////////////////////////////////////////////////// //
 150 var
 151   gGfxDoClear: Boolean = true;
 152
 153
 154 implementation
 155
 156 uses
 157   fui_wadread,
 158   utils;
 159
 160
 161 // ////////////////////////////////////////////////////////////////////////// //
 162 // returns `false` if the color is transparent
 163 // returns `false` if the color is transparent
 164 function setupGLColor (constref clr: TGxRGBA): Boolean;
 165 begin
 166   if (clr.a < 255) then
 167   begin
 168     glEnable(GL_BLEND);
 169     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 170   end
 171   else
 172   begin
 173     glDisable(GL_BLEND);
 174   end;
 175   glColor4ub(clr.r, clr.g, clr.b, clr.a);
 176   result := (clr.a <> 0);
 177 end;
 178
 179 function isScaled (): Boolean;
 180 var
 181   mt: packed array [0..15] of Double;
 182 begin
 183   glGetDoublev(GL_MODELVIEW_MATRIX, @mt[0]);
 184   result := (mt[0] <> 1.0) or (mt[1*4+1] <> 1.0);
 185 end;
 186
 187
 188 // ////////////////////////////////////////////////////////////////////////// //
 189 //TODO: OpenGL framebuffers and shaders state
 190 type
 191   TSavedGLState = record
 192   public
 193     glmatmode: GLint;
 194     gltextbinding: GLint;
 195     //oldprg: GLint;
 196     //oldfbr, oldfbw: GLint;
 197     glvport: packed array [0..3] of GLint;
 198     saved: Boolean;
 199
 200   public
 201     constructor Create (dosave: Boolean);
 202     procedure save ();
 203     procedure restore ();
 204   end;
 205
 206 constructor TSavedGLState.Create (dosave: Boolean);
 207 begin
 208   FillChar(self, sizeof(self), 0);
 209   if (dosave) then save();
 210 end;
 211
 212 procedure TSavedGLState.save ();
 213 begin
 214   if (saved) then raise Exception.Create('cannot save into already saved OpenGL state');
 215   glGetIntegerv(GL_MATRIX_MODE, @glmatmode);
 216   glGetIntegerv(GL_TEXTURE_BINDING_2D, @gltextbinding);
 217   glGetIntegerv(GL_VIEWPORT, @glvport[0]);
 218   //glGetIntegerv(GL_CURRENT_PROGRAM, &oldprg);
 219   //glGetIntegerv(GL_READ_FRAMEBUFFER_BINDING, &oldfbr);
 220   //glGetIntegerv(GL_DRAW_FRAMEBUFFER_BINDING, &oldfbw);
 221   glMatrixMode(GL_PROJECTION); glPushMatrix();
 222   glMatrixMode(GL_MODELVIEW); glPushMatrix();
 223   glMatrixMode(GL_TEXTURE); glPushMatrix();
 224   glMatrixMode(GL_COLOR); glPushMatrix();
 225   glPushAttrib({GL_ENABLE_BIT|GL_COLOR_BUFFER_BIT|GL_CURRENT_BIT}GL_ALL_ATTRIB_BITS); // let's play safe
 226   saved := true;
 227 end;
 228
 229 procedure TSavedGLState.restore ();
 230 begin
 231   if (not saved) then raise Exception.Create('cannot restore unsaved OpenGL state');
 232   glPopAttrib({GL_ENABLE_BIT});
 233   glMatrixMode(GL_PROJECTION); glPopMatrix();
 234   glMatrixMode(GL_MODELVIEW); glPopMatrix();
 235   glMatrixMode(GL_TEXTURE); glPopMatrix();
 236   glMatrixMode(GL_COLOR); glPopMatrix();
 237   glMatrixMode(glmatmode);
 238   //if (glHasFunc!"glBindFramebufferEXT") glBindFramebufferEXT(GL_READ_FRAMEBUFFER_EXT, oldfbr);
 239   //if (glHasFunc!"glBindFramebufferEXT") glBindFramebufferEXT(GL_DRAW_FRAMEBUFFER_EXT, oldfbw);
 240   glBindTexture(GL_TEXTURE_2D, gltextbinding);
 241   //if (glHasFunc!"glUseProgram") glUseProgram(oldprg);
 242   glViewport(glvport[0], glvport[1], glvport[2], glvport[3]);
 243   saved := false;
 244 end;
 245
 246
 247 var
 248   curCtx: TGxContext = nil;
 249   savedGLState: TSavedGLState;
 250
 251
 252 // ////////////////////////////////////////////////////////////////////////// //
 253 // set active context; `ctx` can be `nil`
 254 procedure gxSetContextInternal (ctx: TGxContext; ascale: Single; domatrix: Boolean);
 255 var
 256   mt: packed array [0..15] of Double;
 257 begin
 258   if (savedGLState.saved) then savedGLState.restore();
 259
 260   if (curCtx <> nil) then
 261   begin
 262     curCtx.onDeactivate();
 263     curCtx.mActive := false;
 264   end;
 265
 266   curCtx := ctx;
 267   if (ctx <> nil) then
 268   begin
 269     ctx.mActive := true;
 270     savedGLState.save();
 271     if (domatrix) then
 272     begin
 273       oglSetup2D(fuiScrWdt, fuiScrHgt);
 274       glScalef(ascale, ascale, 1.0);
 275       ctx.mScaled := (ascale <> 1.0);
 276       ctx.mScale := ascale;
 277     end
 278     else
 279     begin
 280       // assume uniform scale
 281       glGetDoublev(GL_MODELVIEW_MATRIX, @mt[0]);
 282       ctx.mScaled := (mt[0] <> 1.0) or (mt[1*4+1] <> 1.0);
 283       ctx.mScale := mt[0];
 284       oglSetup2DState();
 285     end;
 286     ctx.onActivate();
 287   end;
 288 end;
 289
 290
 291 procedure gxSetContext (ctx: TGxContext; ascale: Single=1.0); begin gxSetContextInternal(ctx, ascale, true); end;
 292 procedure gxSetContextNoMatrix (ctx: TGxContext); begin gxSetContextInternal(ctx, 1, false); end;
 293
 294
 295 // ////////////////////////////////////////////////////////////////////////// //
 296 type
 297   TScissorSave = record
 298   public
 299     wassc: Boolean;
 300     scxywh: packed array[0..3] of GLint;
 301
 302   public
 303
 304   public
 305     procedure save (enableScissoring: Boolean);
 306     procedure restore ();
 307
 308     // set new scissor rect, bounded by the saved scissor rect
 309     procedure combineRect (x, y, w, h: Integer);
 310   end;
 311
 312
 313 procedure TScissorSave.save (enableScissoring: Boolean);
 314 begin
 315   wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
 316   if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
 317   //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
 318   if enableScissoring and (not wassc) then glEnable(GL_SCISSOR_TEST);
 319 end;
 320
 321 procedure TScissorSave.restore ();
 322 begin
 323   glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]);
 324   if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
 325 end;
 326
 327 procedure TScissorSave.combineRect (x, y, w, h: Integer);
 328 //var ox, oy, ow, oh: Integer;
 329 begin
 330   if (w < 1) or (h < 1) then begin glScissor(0, 0, 0, 0); exit; end;
 331   y := fuiScrHgt-(y+h);
 332   //ox := x; oy := y; ow := w; oh := h;
 333   if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then
 334   begin
 335     //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, ')');
 336     //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, '>');
 337     glScissor(0, 0, 0, 0);
 338   end
 339   else
 340   begin
 341     glScissor(x, y, w, h);
 342   end;
 343 end;
 344
 345
 346 // ////////////////////////////////////////////////////////////////////////// //
 347 type
 348   TGxBmpFont = class(TGxFont)
 349   private
 350     mTexId: GLuint; // OpenGL texture id
 351     mWidth: Integer; // <=0: proportional
 352     mFontBmp: PByte;
 353     mFontWdt: PByte;
 354     mFreeFontWdt: Boolean;
 355     mFreeFontBmp: Boolean;
 356
 357   protected
 358     procedure oglCreateTexture ();
 359     procedure oglDestroyTexture ();
 360
 361     procedure initDrawText ();
 362     procedure doneDrawText ();
 363     function drawCharInterim (x, y: Integer; const ch: AnsiChar): Integer; // return width (not including last empty pixel)
 364     function drawCharInternal (x, y: Integer; const ch: AnsiChar): Integer; // return width (not including last empty pixel)
 365     function drawTextInternal (x, y: Integer; const s: AnsiString): Integer; // return width (not including last empty pixel)
 366
 367   public
 368     constructor Create (const aname: AnsiString; st: TStream; proportional: Boolean);
 369     destructor Destroy (); override;
 370
 371     function charWidth (const ch: AnsiChar): Integer; override;
 372     function textWidth (const s: AnsiString): Integer; override;
 373   end;
 374
 375
 376 constructor TGxBmpFont.Create (const aname: AnsiString; st: TStream; proportional: Boolean);
 377 var
 378   sign: packed array [0..7] of AnsiChar;
 379   enc: packed array [0..16] of AnsiChar;
 380   b: Byte;
 381   wdt, hgt, elen: Integer;
 382   ch, dy: Integer;
 383   fntbwdt: Integer;
 384   wrd: Word;
 385 begin
 386   mFreeFontBmp := true;
 387   mFreeFontWdt := true;
 388   mName := aname;
 389   mTexId := 0;
 390   // signature
 391   st.ReadBuffer(sign[0], 8);
 392   if (sign <> 'FUIFONT0') then raise Exception.Create('FlexUI: invalid font file signature');
 393   // encoding length and width
 394   st.ReadBuffer(b, 1);
 395   wdt := (b and $0f)+1; // 16 is not supported
 396   if (wdt = 16) then raise Exception.Create('FlexUI: 16-wdt fonts aren''t supported yet');
 397   elen := ((b shr 4) and $0f);
 398   if (elen = 0) then raise Exception.CreateFmt('FlexUI: invalid font encoding length: %d', [elen]);
 399   // height
 400   st.ReadBuffer(b, 1);
 401   hgt := b;
 402   if (hgt < 2) then raise Exception.CreateFmt('FlexUI: invalid font height: %d', [hgt]);
 403   // encoding
 404   st.ReadBuffer(enc[0], elen);
 405   // check for 'cp1251' here (it can also be 'koi8')
 406   if (wdt <= 8) then fntbwdt := 1 else fntbwdt := 2;
 407   // shift and width table (hi nibble: left shift for proportional print; lo nibble: shifted character width for proportional print)
 408   GetMem(mFontWdt, 256);
 409   st.ReadBuffer(mFontWdt^, 256);
 410   // font bitmap
 411   GetMem(mFontBmp, (hgt*fntbwdt)*256);
 412   st.ReadBuffer(mFontBmp^, (hgt*fntbwdt)*256);
 413   mWidth := wdt;
 414   mHeight := hgt;
 415   mBaseLine := hgt-1; //FIXME
 416   if (proportional) then
 417   begin
 418     // shift font
 419     for ch := 0 to 255 do
 420     begin
 421       for dy := 0 to hgt-1 do
 422       begin
 423         if (fntbwdt = 1) then
 424         begin
 425           mFontBmp[ch*hgt+dy] := mFontBmp[ch*hgt+dy] shl (mFontWdt[ch] shr 4);
 426         end
 427         else
 428         begin
 429           wrd := mFontBmp[ch*(hgt*2)+(dy*2)]+256*mFontBmp[ch*(hgt*2)+(dy*2)+1];
 430           wrd := wrd shl (mFontWdt[ch] shr 4);
 431           mFontBmp[ch*(hgt*2)+(dy*2)+0] := (wrd and $ff);
 432           mFontBmp[ch*(hgt*2)+(dy*2)+1] := ((wrd shr 16) and $ff);
 433         end;
 434       end;
 435     end;
 436   end
 437   else
 438   begin
 439     FillChar(mFontWdt^, 256, wdt);
 440   end;
 441 end;
 442
 443
 444 destructor TGxBmpFont.Destroy ();
 445 begin
 446   if (mFreeFontBmp) and (mFontBmp <> nil) then FreeMem(mFontBmp);
 447   if (mFreeFontWdt) and (mFontWdt <> nil) then FreeMem(mFontWdt);
 448   mName := '';
 449   mWidth := 0;
 450   mHeight := 0;
 451   mBaseLine := 0;
 452   mFontBmp := nil;
 453   mFontWdt := nil;
 454   mFreeFontWdt := false;
 455   mFreeFontBmp := false;
 456   mTexId := 0;
 457   inherited;
 458 end;
 459
 460
 461 procedure TGxBmpFont.oglCreateTexture ();
 462 const
 463   TxWidth = 16*16;
 464   TxHeight = 16*16;
 465 var
 466   tex, tpp: PByte;
 467   b: Byte;
 468   cc: Integer;
 469   x, y, dx, dy: Integer;
 470 begin
 471   GetMem(tex, TxWidth*TxHeight*4);
 472   FillChar(tex^, TxWidth*TxHeight*4, 0);
 473
 474   for cc := 0 to 255 do
 475   begin
 476     x := (cc mod 16)*16;
 477     y := (cc div 16)*16;
 478     for dy := 0 to mHeight-1 do
 479     begin
 480       if (mWidth <= 8) then b := mFontBmp[cc*mHeight+dy] else b := mFontBmp[cc*(mHeight*2)+(dy*2)+1];
 481       //if prop then b := b shl (fontwdt[cc] shr 4);
 482       tpp := tex+((y+dy)*(TxWidth*4))+x*4;
 483       for dx := 0 to 7 do
 484       begin
 485         if ((b and $80) <> 0) then
 486         begin
 487           tpp^ := 255; Inc(tpp);
 488           tpp^ := 255; Inc(tpp);
 489           tpp^ := 255; Inc(tpp);
 490           tpp^ := 255; Inc(tpp);
 491         end
 492         else
 493         begin
 494           tpp^ := 0; Inc(tpp);
 495           tpp^ := 0; Inc(tpp);
 496           tpp^ := 0; Inc(tpp);
 497           tpp^ := 0; Inc(tpp);
 498         end;
 499         b := (b and $7f) shl 1;
 500       end;
 501       if (mWidth > 8) then
 502       begin
 503         b := mFontBmp[cc*(mHeight*2)+(dy*2)+0];
 504         for dx := 0 to 7 do
 505         begin
 506           if ((b and $80) <> 0) then
 507           begin
 508             tpp^ := 255; Inc(tpp);
 509             tpp^ := 255; Inc(tpp);
 510             tpp^ := 255; Inc(tpp);
 511             tpp^ := 255; Inc(tpp);
 512           end
 513           else
 514           begin
 515             tpp^ := 0; Inc(tpp);
 516             tpp^ := 0; Inc(tpp);
 517             tpp^ := 0; Inc(tpp);
 518             tpp^ := 0; Inc(tpp);
 519           end;
 520           b := (b and $7f) shl 1;
 521         end;
 522       end;
 523     end;
 524   end;
 525
 526   glGenTextures(1, @mTexId);
 527   if (mTexId = 0) then raise Exception.Create('can''t create FlexUI font texture');
 528
 529   glBindTexture(GL_TEXTURE_2D, mTexId);
 530   glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
 531   glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
 532   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
 533   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
 534
 535   glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, TxWidth, TxHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, tex);
 536   glFinish();
 537
 538   glBindTexture(GL_TEXTURE_2D, 0);
 539   FreeMem(tex);
 540 end;
 541
 542
 543 procedure TGxBmpFont.oglDestroyTexture ();
 544 begin
 545   if (mTexId <> 0) then
 546   begin
 547     glDeleteTextures(1, @mTexId);
 548     mTexId := 0;
 549   end;
 550 end;
 551
 552
 553 function TGxBmpFont.charWidth (const ch: AnsiChar): Integer;
 554 begin
 555   result := (mFontWdt[Byte(ch)] and $0f);
 556 end;
 557
 558
 559 function TGxBmpFont.textWidth (const s: AnsiString): Integer;
 560 var
 561   ch: AnsiChar;
 562 begin
 563   if (Length(s) > 0) then
 564   begin
 565     result := -1;
 566     for ch in s do result += (mFontWdt[Byte(ch)] and $0f)+1;
 567   end
 568   else
 569   begin
 570     result := 0;
 571   end;
 572 end;
 573
 574
 575 procedure TGxBmpFont.initDrawText ();
 576 begin
 577   glEnable(GL_ALPHA_TEST);
 578   glAlphaFunc(GL_NOTEQUAL, 0.0);
 579   glEnable(GL_TEXTURE_2D);
 580   glBindTexture(GL_TEXTURE_2D, mTexId);
 581 end;
 582
 583
 584 procedure TGxBmpFont.doneDrawText ();
 585 begin
 586   glDisable(GL_ALPHA_TEST);
 587   glDisable(GL_TEXTURE_2D);
 588   glBindTexture(GL_TEXTURE_2D, 0);
 589 end;
 590
 591
 592 function TGxBmpFont.drawCharInterim (x, y: Integer; const ch: AnsiChar): Integer;
 593 var
 594   tx, ty: Integer;
 595 begin
 596   tx := (Integer(ch) mod 16)*16;
 597   ty := (Integer(ch) div 16)*16;
 598   glBegin(GL_QUADS);
 599     glTexCoord2f((tx+0)/256.0, (ty+0)/256.0); glVertex2i(x+0, y+0); // top-left
 600     glTexCoord2f((tx+mWidth)/256.0, (ty+0)/256.0); glVertex2i(x+mWidth, y+0); // top-right
 601     glTexCoord2f((tx+mWidth)/256.0, (ty+mHeight)/256.0); glVertex2i(x+mWidth, y+mHeight); // bottom-right
 602     glTexCoord2f((tx+0)/256.0, (ty+mHeight)/256.0); glVertex2i(x+0, y+mHeight); // bottom-left
 603   glEnd();
 604   result := (mFontWdt[Byte(ch)] and $0f);
 605 end;
 606
 607
 608 function TGxBmpFont.drawCharInternal (x, y: Integer; const ch: AnsiChar): Integer;
 609 begin
 610   initDrawText();
 611   result := drawCharInterim(x, y, ch);
 612   doneDrawText();
 613 end;
 614
 615
 616 function TGxBmpFont.drawTextInternal (x, y: Integer; const s: AnsiString): Integer;
 617 var
 618   ch: AnsiChar;
 619   wdt: Integer;
 620 begin
 621   if (Length(s) = 0) then begin result := 0; exit; end;
 622   result := -1;
 623   initDrawText();
 624   for ch in s do
 625   begin
 626     wdt := drawCharInterim(x, y, ch)+1;
 627     x += wdt;
 628     result += wdt;
 629   end;
 630   doneDrawText();
 631 end;
 632
 633
 634 // ////////////////////////////////////////////////////////////////////////// //
 635 var
 636   fontList: array of TGxBmpFont = nil;
 637   defaultFontName: AnsiString = 'win14';
 638
 639
 640 function strEquCI (const s0, s1: AnsiString): Boolean;
 641 var
 642   f: Integer;
 643   c0, c1: AnsiChar;
 644 begin
 645   result := (Length(s0) = Length(s1));
 646   if (result) then
 647   begin
 648     for f := 1 to Length(s0) do
 649     begin
 650       c0 := s0[f];
 651       if (c0 >= 'a') and (c0 <= 'z') then Dec(c0, 32); // poor man's `toupper()`
 652       c1 := s1[f];
 653       if (c1 >= 'a') and (c1 <= 'z') then Dec(c1, 32); // poor man's `toupper()`
 654       if (c0 <> c1) then begin result := false; exit; end;
 655     end;
 656   end;
 657 end;
 658
 659
 660 function getFontByName (const aname: AnsiString): TGxBmpFont;
 661 var
 662   f: Integer;
 663   fname: AnsiString;
 664 begin
 665   if (Length(fontList) = 0) then raise Exception.Create('font subsystem not initialized');
 666   if (Length(aname) = 0) or (strEquCI(aname, 'default')) then fname := defaultFontName else fname := aname;
 667   for f := 0 to High(fontList) do
 668   begin
 669     result := fontList[f];
 670     if (result = nil) then continue;
 671     if (strEquCI(result.name, fname)) then exit;
 672   end;
 673   if (fontList[0] = nil) then raise Exception.Create('font subsystem not properly initialized');
 674   result := fontList[0];
 675 end;
 676
 677
 678 {
 679 procedure deleteFonts ();
 680 var
 681   f: Integer;
 682 begin
 683   for f := 0 to High(fontList) do freeAndNil(fontList[f]);
 684   fontList := nil;
 685 end;
 686 }
 687
 688
 689 procedure fuiGfxLoadFont (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean=false);
 690 var
 691   st: TStream;
 692 begin
 693   if (Length(fontname) = 0) then raise Exception.Create('FlexUI: cannot load nameless font '''+fontFile+'''');
 694   st := fuiOpenFile(fontFile);
 695   if (st = nil) then raise Exception.Create('FlexUI: cannot load font '''+fontFile+'''');
 696   try
 697     fuiGfxLoadFont(fontname, st, proportional);
 698   except on e: Exception do
 699     begin
 700       writeln('FlexUI font loadin error: ', e.message);
 701       FreeAndNil(st);
 702       raise Exception.Create('FlexUI: cannot load font '''+fontFile+'''');
 703     end;
 704   else
 705     raise;
 706   end;
 707   FreeAndNil(st);
 708 end;
 709
 710
 711 procedure fuiGfxLoadFont (const fontname: AnsiString; st: TStream; proportional: Boolean=false);
 712 var
 713   fnt: TGxBmpFont = nil;
 714   f: Integer;
 715 begin
 716   if (Length(fontname) = 0) then raise Exception.Create('FlexUI: cannot load nameless font');
 717   fnt := TGxBmpFont.Create(fontname, st, proportional);
 718   try
 719     for f := 0 to High(fontList) do
 720     begin
 721       if (strEquCI(fontList[f].name, fontname)) then
 722       begin
 723         if (fontList[f].mTexId <> 0) then raise Exception.Create('FlexUI: cannot reload generated font named '''+fontname+'''');
 724         FreeAndNil(fontList[f]);
 725         fontList[f] := fnt;
 726         exit;
 727       end;
 728     end;
 729     SetLength(fontList, Length(fontList)+1);
 730     fontList[High(fontList)] := fnt;
 731   except
 732     FreeAndNil(fnt);
 733     raise;
 734   end;
 735 end;
 736
 737
 738 procedure oglInitFonts ();
 739 var
 740   f: Integer;
 741 begin
 742   for f := 0 to High(fontList) do if (fontList[f] <> nil) then fontList[f].oglCreateTexture();
 743 end;
 744
 745
 746 procedure oglDeinitFonts ();
 747 var
 748   f: Integer;
 749 begin
 750   for f := 0 to High(fontList) do if (fontList[f] <> nil) then fontList[f].oglDestroyTexture();
 751 end;
 752
 753
 754 // ////////////////////////////////////////////////////////////////////////// //
 755 procedure oglSetup2DState ();
 756 begin
 757   glDisable(GL_BLEND);
 758   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 759   glDisable(GL_LINE_SMOOTH);
 760   glDisable(GL_POLYGON_SMOOTH);
 761   glDisable(GL_POINT_SMOOTH);
 762   glDisable(GL_DEPTH_TEST);
 763   glDisable(GL_TEXTURE_2D);
 764   glDisable(GL_LIGHTING);
 765   glDisable(GL_DITHER);
 766   glDisable(GL_STENCIL_TEST);
 767   glDisable(GL_SCISSOR_TEST);
 768   glDisable(GL_CULL_FACE);
 769   glDisable(GL_ALPHA_TEST);
 770
 771   glClearColor(0, 0, 0, 0);
 772   glColor4f(1, 1, 1, 1);
 773 end;
 774
 775
 776 procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
 777 begin
 778   glViewport(0, 0, winWidth, winHeight);
 779
 780   oglSetup2DState();
 781
 782   glMatrixMode(GL_TEXTURE);
 783   glLoadIdentity();
 784
 785   glMatrixMode(GL_COLOR);
 786   glLoadIdentity();
 787
 788   glMatrixMode(GL_PROJECTION);
 789   glLoadIdentity();
 790   if (upsideDown) then
 791   begin
 792     glOrtho(0, winWidth, 0, winHeight, -1, 1); // set origin to bottom left
 793   end
 794   else
 795   begin
 796     glOrtho(0, winWidth, winHeight, 0, -1, 1); // set origin to top left
 797   end;
 798
 799   glMatrixMode(GL_MODELVIEW);
 800   glLoadIdentity();
 801 end;
 802
 803
 804 // ////////////////////////////////////////////////////////////////////////// //
 805 {$INCLUDE fui_gfx_gl_cursor.inc}
 806
 807 procedure oglDrawCursor (); begin oglDrawCursorAt(fuiMouseX, fuiMouseY); end;
 808
 809
 810 // ////////////////////////////////////////////////////////////////////////// //
 811 constructor TGxContext.Create ();
 812 begin
 813   mActive := false;
 814   mColor := TGxRGBA.Create(255, 255, 255);
 815   mFont := getFontByName('default');
 816   mScaled := false;
 817   mScale := 1.0;
 818   mClipRect := TGxRect.Create(0, 0, 8192, 8192);
 819   mClipOfs := TGxOfs.Create(0, 0);
 820 end;
 821
 822
 823 destructor TGxContext.Destroy ();
 824 begin
 825   if (mActive) then gxSetContext(nil);
 826   inherited;
 827 end;
 828
 829
 830 function TGxContext.getFont (): AnsiString;
 831 begin
 832   result := mFont.name;
 833 end;
 834
 835 procedure TGxContext.setFont (const aname: AnsiString);
 836 begin
 837   mFont := getFontByName(aname);
 838 end;
 839
 840
 841 procedure TGxContext.onActivate ();
 842 begin
 843   setupGLColor(mColor);
 844   realizeClip();
 845 end;
 846
 847 procedure TGxContext.onDeactivate ();
 848 begin
 849 end;
 850
 851
 852 procedure TGxContext.setColor (const clr: TGxRGBA);
 853 begin
 854   mColor := clr;
 855   if (mActive) then setupGLColor(mColor);
 856 end;
 857
 858
 859 procedure TGxContext.realizeClip ();
 860 var
 861   sx, sy, sw, sh: Integer;
 862 begin
 863   if (not mActive) then exit; // just in case
 864   if (mClipRect.w <= 0) or (mClipRect.h <= 0) then
 865   begin
 866     glEnable(GL_SCISSOR_TEST);
 867     glScissor(0, 0, 0, 0);
 868   end
 869   else
 870   begin
 871     if (mScaled) then
 872     begin
 873       sx := trunc(mClipRect.x*mScale);
 874       sy := trunc(mClipRect.y*mScale);
 875       sw := trunc(mClipRect.w*mScale);
 876       sh := trunc(mClipRect.h*mScale);
 877     end
 878     else
 879     begin
 880       sx := mClipRect.x;
 881       sy := mClipRect.y;
 882       sw := mClipRect.w;
 883       sh := mClipRect.h;
 884     end;
 885     if (not intersectRect(sx, sy, sw, sh, 0, 0, fuiScrWdt, fuiScrHgt)) then
 886     begin
 887       glEnable(GL_SCISSOR_TEST);
 888       glScissor(0, 0, 0, 0);
 889     end
 890     else if (sx = 0) and (sy = 0) and (sw = fuiScrWdt) and (sh = fuiScrHgt) then
 891     begin
 892       glDisable(GL_SCISSOR_TEST);
 893     end
 894     else
 895     begin
 896       glEnable(GL_SCISSOR_TEST);
 897       sy := fuiScrHgt-(sy+sh);
 898       glScissor(sx, sy, sw, sh);
 899     end;
 900   end;
 901 end;
 902
 903
 904 procedure TGxContext.resetClip ();
 905 begin
 906   mClipRect := TGxRect.Create(0, 0, 8192, 8192);
 907   if (mActive) then realizeClip();
 908 end;
 909
 910
 911 procedure TGxContext.setClipOfs (const aofs: TGxOfs);
 912 begin
 913   mClipOfs := aofs;
 914 end;
 915
 916
 917 procedure TGxContext.setClipRect (const aclip: TGxRect);
 918 begin
 919   mClipRect := aclip;
 920   if (mActive) then realizeClip();
 921 end;
 922
 923
 924 function TGxContext.setOffset (constref aofs: TGxOfs): TGxOfs;
 925 begin
 926   result := mClipOfs;
 927   mClipOfs := aofs;
 928 end;
 929
 930
 931 function TGxContext.setClip (constref aclip: TGxRect): TGxRect;
 932 begin
 933   result := mClipRect;
 934   mClipRect := aclip;
 935   if (mActive) then realizeClip();
 936 end;
 937
 938
 939 function TGxContext.combineClip (constref aclip: TGxRect): TGxRect;
 940 begin
 941   result := mClipRect;
 942   mClipRect.intersect(aclip);
 943   if (mActive) then realizeClip();
 944 end;
 945
 946
 947 procedure TGxContext.line (x1, y1, x2, y2: Integer);
 948 begin
 949   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
 950
 951   if (not mScaled) then
 952   begin
 953     glLineWidth(1);
 954     glBegin(GL_LINES);
 955       glVertex2f(x1+0.375, y1+0.375);
 956       glVertex2f(x2+0.375, y2+0.375);
 957     glEnd();
 958
 959     if (x1 <> x2) or (y1 <> y2) then
 960     begin
 961       glPointSize(1);
 962       glBegin(GL_POINTS);
 963         glVertex2f(x2+0.375, y2+0.375);
 964       glEnd();
 965     end;
 966   end
 967   else
 968   begin
 969     glLineWidth(1);
 970     glBegin(GL_LINES);
 971       glVertex2i(x1, y1);
 972       glVertex2i(x2, y2);
 973       // draw last point
 974       glVertex2i(x2, y2);
 975       glVertex2i(x2+1, y2+1);
 976     glEnd();
 977   end;
 978 end;
 979
 980
 981 procedure TGxContext.hline (x, y, len: Integer);
 982 begin
 983   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
 984   if (len < 1) then exit;
 985   if (not mScaled) then
 986   begin
 987     glLineWidth(1);
 988     glBegin(GL_LINES);
 989       glVertex2f(x+0.375, y+0.375);
 990       glVertex2f(x+len+0.375, y+0.375);
 991     glEnd();
 992   end
 993   else if (mScale > 1.0) then
 994   begin
 995     glBegin(GL_QUADS);
 996       glVertex2i(x, y);
 997       glVertex2i(x+len, y);
 998       glVertex2i(x+len, y+1);
 999       glVertex2i(x, y+1);
1000     glEnd();
1001   end
1002   else
1003   begin
1004     glPointSize(1);
1005     glBegin(GL_POINTS);
1006       while (len > 0) do begin glVertex2i(x, y); Inc(x); Dec(len); end;
1007     glEnd();
1008   end;
1009 end;
1010
1011
1012 procedure TGxContext.vline (x, y, len: Integer);
1013 begin
1014   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
1015   if (len < 1) then exit;
1016   if (not mScaled) then
1017   begin
1018     glLineWidth(1);
1019     glBegin(GL_LINES);
1020       glVertex2f(x+0.375, y+0.375);
1021       glVertex2f(x+0.375, y+len+0.375);
1022     glEnd();
1023   end
1024   else if (mScale > 1.0) then
1025   begin
1026     glBegin(GL_QUADS);
1027       glVertex2i(x, y);
1028       glVertex2i(x, y+len);
1029       glVertex2i(x+1, y+len);
1030       glVertex2i(x+1, y);
1031     glEnd();
1032   end
1033   else
1034   begin
1035     glPointSize(1);
1036     glBegin(GL_POINTS);
1037       while (len > 0) do begin glVertex2i(x, y); Inc(y); Dec(len); end;
1038     glEnd();
1039   end;
1040 end;
1041
1042
1043 procedure TGxContext.rect (x, y, w, h: Integer);
1044 begin
1045   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
1046   if (w < 0) or (h < 0) then exit;
1047   if (w = 1) and (h = 1) then
1048   begin
1049     glPointSize(1);
1050     glBegin(GL_POINTS);
1051       if mScaled then glVertex2i(x, y) else glVertex2f(x+0.375, y+0.375);
1052     glEnd();
1053   end
1054   else
1055   begin
1056     if (not mScaled) then
1057     begin
1058       glLineWidth(1);
1059       glBegin(GL_LINES);
1060         glVertex2i(x, y); glVertex2i(x+w, y); // top
1061         glVertex2i(x, y+h-1); glVertex2i(x+w, y+h-1); // bottom
1062         glVertex2f(x+0.375, y+1); glVertex2f(x+0.375, y+h-1); // left
1063         glVertex2f(x+w-1+0.375, y+1); glVertex2f(x+w-1+0.375, y+h-1); // right
1064       glEnd();
1065     end
1066     else
1067     begin
1068       hline(x, y, w);
1069       hline(x, y+h-1, w);
1070       vline(x, y+1, h-2);
1071       vline(x+w-1, y+1, h-2);
1072     end;
1073   end;
1074 end;
1075
1076
1077 procedure TGxContext.fillRect (x, y, w, h: Integer);
1078 begin
1079   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
1080   if (w < 0) or (h < 0) then exit;
1081   glBegin(GL_QUADS);
1082     glVertex2f(x, y);
1083     glVertex2f(x+w, y);
1084     glVertex2f(x+w, y+h);
1085     glVertex2f(x, y+h);
1086   glEnd();
1087 end;
1088
1089
1090 procedure TGxContext.darkenRect (x, y, w, h: Integer; a: Integer);
1091 begin
1092   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (a >= 255) then exit;
1093   if (w < 0) or (h < 0) then exit;
1094   if (a < 0) then a := 0;
1095   glEnable(GL_BLEND);
1096   glBlendFunc(GL_ZERO, GL_SRC_ALPHA);
1097   glColor4f(0.0, 0.0, 0.0, a/255.0);
1098   glBegin(GL_QUADS);
1099     glVertex2i(x, y);
1100     glVertex2i(x+w, y);
1101     glVertex2i(x+w, y+h);
1102     glVertex2i(x, y+h);
1103   glEnd();
1104   setupGLColor(mColor);
1105 end;
1106
1107
1108 function TGxContext.charWidth (const ch: AnsiChar): Integer;
1109 begin
1110   result := mFont.charWidth(ch);
1111 end;
1112
1113 function TGxContext.charHeight (const ch: AnsiChar): Integer;
1114 begin
1115   result := mFont.height;
1116 end;
1117
1118
1119 function TGxContext.textWidth (const s: AnsiString): Integer;
1120 begin
1121   result := mFont.textWidth(s);
1122 end;
1123
1124 function TGxContext.textHeight (const s: AnsiString): Integer;
1125 begin
1126   result := mFont.height;
1127 end;
1128
1129
1130 function TGxContext.drawChar (x, y: Integer; const ch: AnsiChar): Integer; // returns char width
1131 begin
1132   result := mFont.charWidth(ch);
1133   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
1134   TGxBmpFont(mFont).drawCharInternal(x, y, ch);
1135 end;
1136
1137 function TGxContext.drawText (x, y: Integer; const s: AnsiString): Integer; // returns text width
1138 begin
1139   result := mFont.textWidth(s);
1140   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) or (Length(s) = 0) then exit;
1141   TGxBmpFont(mFont).drawTextInternal(x, y, s);
1142 end;
1143
1144
1145 function TGxContext.iconMarkWidth (ic: TMarkIcon): Integer;
1146 begin
1147   {$IFDEF FUI_TEXT_ICONS}
1148   case ic of
1149     TMarkIcon.Checkbox: result := textWidth('[x]');
1150     TMarkIcon.Radiobox: result := textWidth('(*)');
1151     else result := textWidth('[x]');
1152   end;
1153   {$ELSE}
1154   result := 11;
1155   {$ENDIF}
1156 end;
1157
1158 function TGxContext.iconMarkHeight (ic: TMarkIcon): Integer;
1159 begin
1160   {$IFDEF FUI_TEXT_ICONS}
1161   case ic of
1162     TMarkIcon.Checkbox: result := textHeight('[x]');
1163     TMarkIcon.Radiobox: result := textHeight('(*)');
1164     else result := textHeight('[x]');
1165   end;
1166   {$ELSE}
1167   result := 8;
1168   {$ENDIF}
1169 end;
1170
1171 procedure TGxContext.drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean);
1172 var
1173   {$IFDEF FUI_TEXT_ICONS}
1174   xstr: AnsiString;
1175   {$ELSE}
1176   f: Integer;
1177   {$ENDIF}
1178 begin
1179   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
1180   {$IFDEF FUI_TEXT_ICONS}
1181   case ic of
1182     TMarkIcon.Checkbox: xstr := '[x]';
1183     TMarkIcon.Radiobox: xstr := '(*)';
1184     else exit;
1185   end;
1186   if (marked) then
1187   begin
1188     drawText(x, y, xstr);
1189   end
1190   else
1191   begin
1192     drawChar(x, y, xstr[1]);
1193     drawChar(x+textWidth(xstr)-charWidth(xstr[3]), y, xstr[3]);
1194   end;
1195   {$ELSE}
1196   if (ic = TMarkIcon.Checkbox) then
1197   begin
1198     vline(x, y, 7);
1199     vline(x+10, y, 7);
1200     hline(x+1, y, 1);
1201     hline(x+1, y+6, 1);
1202     hline(x+9, y, 1);
1203     hline(x+9, y+6, 1);
1204   end
1205   else
1206   begin
1207     vline(x, y+1, 5);
1208     vline(x+10, y+1, 5);
1209     hline(x+1, y, 1);
1210     hline(x+1, y+6, 1);
1211     hline(x+9, y, 1);
1212     hline(x+9, y+6, 1);
1213   end;
1214   if (not marked) then exit;
1215   case ic of
1216     TMarkIcon.Checkbox:
1217       begin
1218         for f := 0 to 4 do
1219         begin
1220           vline(x+3+f, y+1+f, 1);
1221           vline(x+7-f, y+1+f, 1);
1222         end;
1223       end;
1224     TMarkIcon.Radiobox:
1225       begin
1226         hline(x+4, y+1, 3);
1227         hline(x+3, y+2, 5);
1228         hline(x+3, y+3, 5);
1229         hline(x+3, y+4, 5);
1230         hline(x+4, y+5, 3);
1231       end;
1232   end;
1233   {$ENDIF}
1234 end;
1235
1236
1237 function TGxContext.iconWinWidth (ic: TWinIcon): Integer;
1238 begin
1239   {$IFDEF FUI_TEXT_ICONS}
1240   case ic of
1241     TWinIcon.Close: result := nmax(textWidth('[x]'), textWidth('[#]'));
1242     else result := nmax(textWidth('[x]'), textWidth('[#]'));
1243   end;
1244   {$ELSE}
1245   result := 9;
1246   {$ENDIF}
1247 end;
1248
1249 function TGxContext.iconWinHeight (ic: TWinIcon): Integer;
1250 begin
1251   {$IFDEF FUI_TEXT_ICONS}
1252   case ic of
1253     TWinIcon.Close: result := nmax(textHeight('[x]'), textHeight('[#]'));
1254     else result := nmax(textHeight('[x]'), textHeight('[#]'));
1255   end;
1256   {$ELSE}
1257   result := 8;
1258   {$ENDIF}
1259 end;
1260
1261 procedure TGxContext.drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean);
1262 var
1263   {$IFDEF FUI_TEXT_ICONS}
1264   xstr: AnsiString;
1265   wdt: Integer;
1266   {$ELSE}
1267   f: Integer;
1268   {$ENDIF}
1269 begin
1270   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
1271   {$IFDEF FUI_TEXT_ICONS}
1272   case ic of
1273     TWinIcon.Close: if (pressed) then xstr := '[#]' else xstr := '[x]';
1274     else exit;
1275   end;
1276   wdt := nmax(textWidth('[x]'), textWidth('[#]'));
1277   drawChar(x, y, xstr[1]);
1278   drawChar(x+wdt-charWidth(xstr[3]), y, xstr[3]);
1279   drawChar(x+((wdt-charWidth(xstr[2])) div 2), y, xstr[2]);
1280   {$ELSE}
1281   if pressed then rect(x, y, 9, 8);
1282   for f := 1 to 5 do
1283   begin
1284     vline(x+1+f, y+f, 1);
1285     vline(x+1+6-f, y+f, 1);
1286   end;
1287   {$ENDIF}
1288 end;
1289
1290
1291 procedure TGxContext.glSetScale (ascale: Single);
1292 begin
1293   if (ascale < 0.01) then ascale := 0.01;
1294   glLoadIdentity();
1295   glScalef(ascale, ascale, 1.0);
1296   mScale := ascale;
1297   mScaled := (ascale <> 1.0);
1298 end;
1299
1300 procedure TGxContext.glSetTrans (ax, ay: Single);
1301 begin
1302   glLoadIdentity();
1303   glScalef(mScale, mScale, 1.0);
1304   glTranslatef(ax, ay, 0);
1305 end;
1306
1307
1308 procedure TGxContext.glSetScaleTrans (ascale, ax, ay: Single);
1309 begin
1310   glSetScale(ascale);
1311   glTranslatef(ax, ay, 0);
1312 end;
1313
1314
1315 // ////////////////////////////////////////////////////////////////////////// //
1316 (*
1317 procedure oglRestoreMode (doClear: Boolean);
1318 begin
1319   oglSetup2D(fuiScrWdt, fuiScrHgt);
1320   glScissor(0, 0, fuiScrWdt, fuiScrHgt);
1321
1322   glBindTexture(GL_TEXTURE_2D, 0);
1323   glDisable(GL_BLEND);
1324   glDisable(GL_TEXTURE_2D);
1325   glDisable(GL_STENCIL_TEST);
1326   glDisable(GL_SCISSOR_TEST);
1327   glDisable(GL_LIGHTING);
1328   glDisable(GL_DEPTH_TEST);
1329   glDisable(GL_CULL_FACE);
1330   glDisable(GL_LINE_SMOOTH);
1331   glDisable(GL_POINT_SMOOTH);
1332   glLineWidth(1);
1333   glPointSize(1);
1334   glColor4f(1, 1, 1, 1);
1335
1336   if doClear then
1337   begin
1338     glClearColor(0, 0, 0, 0);
1339     glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_ACCUM_BUFFER_BIT or GL_STENCIL_BUFFER_BIT);
1340   end;
1341
1342   // scale everything
1343   glMatrixMode(GL_MODELVIEW);
1344   glLoadIdentity();
1345   //glScalef(4, 4, 1);
1346 end;
1347 *)
1348
1349
1350 //procedure onWinFocus (); begin end;
1351 //procedure onWinBlur (); begin fuiResetKMState(true); end;
1352
1353 //procedure onPreRender (); begin oglRestoreMode(gGfxDoClear); end;
1354 procedure onPostRender (); begin oglDrawCursor(); end;
1355
1356 procedure onInit ();
1357 begin
1358   //oglSetup2D(fuiScrWdt, fuiScrHgt);
1359   createCursorTexture();
1360   oglInitFonts();
1361 end;
1362
1363 procedure onDeinit ();
1364 begin
1365   fuiResetKMState(false);
1366   if (curtexid <> 0) then glDeleteTextures(1, @curtexid);
1367   curtexid := 0;
1368   oglDeinitFonts();
1369   fuiSetButState(0);
1370   fuiSetModState(0);
1371   fuiSetMouseX(0);
1372   fuiSetMouseY(0);
1373 end;
1374
1375
1376 // ////////////////////////////////////////////////////////////////////////// //
1377 initialization
1378   savedGLState := TSavedGLState.Create(false);
1379   //createFonts();
1380   //winFocusCB := onWinFocus;
1381   //winBlurCB := onWinBlur;
1382   //prerenderFrameCB := onPreRender;
1383   postrenderFrameCB := onPostRender;
1384   oglInitCB := onInit;
1385   oglDeinitCB := onDeinit;
1386 end.