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