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