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