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