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