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