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, mHeight, (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)*16;
 466     glBegin(GL_QUADS);
 467       glTexCoord2f((tx+0)/128.0, (ty+0)/256.0); glVertex2i(x+0, y+0); // top-left
 468       glTexCoord2f((tx+8)/128.0, (ty+0)/256.0); glVertex2i(x+8, y+0); // top-right
 469       glTexCoord2f((tx+8)/128.0, (ty+mHeight)/256.0); glVertex2i(x+8, y+mHeight); // bottom-right
 470       glTexCoord2f((tx+0)/128.0, (ty+mHeight)/256.0); glVertex2i(x+0, y+mHeight); // 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, 10);
 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   fontList[4] := TGxBmpFont.Create('win8', 8, 8, @kgiWFont8[0], @kgiWFont8Wdt[0]);
 544   fontList[5] := TGxBmpFont.Create('win8-prop', 0, 8, @kgiWFont8[0], @kgiWFont8Wdt[0]);
 545   fontList[6] := TGxBmpFont.Create('win14', 8, 14, @kgiFont14[0], @kgiFont14Wdt[0]);
 546   fontList[7] := TGxBmpFont.Create('win14-prop', 0, 14, @kgiFont14[0], @kgiFont14Wdt[0]);
 547   fontList[8] := TGxBmpFont.Create('win16', 8, 16, @kgiFont16[0], @kgiFont16Wdt[0]);
 548   fontList[9] := TGxBmpFont.Create('win16-prop', 0, 16, @kgiFont16[0], @kgiFont16Wdt[0]);
 549 end;
 550
 551
 552 procedure oglInitFonts ();
 553 var
 554   f: Integer;
 555 begin
 556   for f := 0 to High(fontList) do if (fontList[f] <> nil) then fontList[f].oglCreateTexture();
 557 end;
 558
 559
 560 procedure oglDeinitFonts ();
 561 var
 562   f: Integer;
 563 begin
 564   for f := 0 to High(fontList) do if (fontList[f] <> nil) then fontList[f].oglDestroyTexture();
 565 end;
 566
 567
 568 // ////////////////////////////////////////////////////////////////////////// //
 569 procedure oglSetup2DState ();
 570 begin
 571   glDisable(GL_BLEND);
 572   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 573   glDisable(GL_LINE_SMOOTH);
 574   glDisable(GL_POLYGON_SMOOTH);
 575   glDisable(GL_POINT_SMOOTH);
 576   glDisable(GL_DEPTH_TEST);
 577   glDisable(GL_TEXTURE_2D);
 578   glDisable(GL_LIGHTING);
 579   glDisable(GL_DITHER);
 580   glDisable(GL_STENCIL_TEST);
 581   glDisable(GL_SCISSOR_TEST);
 582   glDisable(GL_CULL_FACE);
 583   glDisable(GL_ALPHA_TEST);
 584
 585   glClearColor(0, 0, 0, 0);
 586   glColor4f(1, 1, 1, 1);
 587 end;
 588
 589
 590 procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
 591 begin
 592   glViewport(0, 0, winWidth, winHeight);
 593
 594   oglSetup2DState();
 595
 596   glMatrixMode(GL_TEXTURE);
 597   glLoadIdentity();
 598
 599   glMatrixMode(GL_COLOR);
 600   glLoadIdentity();
 601
 602   glMatrixMode(GL_PROJECTION);
 603   glLoadIdentity();
 604   if (upsideDown) then
 605   begin
 606     glOrtho(0, winWidth, 0, winHeight, -1, 1); // set origin to bottom left
 607   end
 608   else
 609   begin
 610     glOrtho(0, winWidth, winHeight, 0, -1, 1); // set origin to top left
 611   end;
 612
 613   glMatrixMode(GL_MODELVIEW);
 614   glLoadIdentity();
 615 end;
 616
 617
 618 // ////////////////////////////////////////////////////////////////////////// //
 619 {$INCLUDE fui_gfx_gl_cursor.inc}
 620
 621 procedure oglDrawCursor (); begin oglDrawCursorAt(fuiMouseX, fuiMouseY); end;
 622
 623
 624 // ////////////////////////////////////////////////////////////////////////// //
 625 constructor TGxContext.Create ();
 626 begin
 627   mActive := false;
 628   mColor := TGxRGBA.Create(255, 255, 255);
 629   mFont := getFontByName('default');
 630   mScaled := false;
 631   mScale := 1.0;
 632   mClipRect := TGxRect.Create(0, 0, 8192, 8192);
 633   mClipOfs := TGxOfs.Create(0, 0);
 634 end;
 635
 636
 637 destructor TGxContext.Destroy ();
 638 begin
 639   if (mActive) then gxSetContext(nil);
 640   inherited;
 641 end;
 642
 643
 644 function TGxContext.getFont (): AnsiString;
 645 begin
 646   result := mFont.name;
 647 end;
 648
 649 procedure TGxContext.setFont (const aname: AnsiString);
 650 begin
 651   mFont := getFontByName(aname);
 652 end;
 653
 654
 655 procedure TGxContext.onActivate ();
 656 begin
 657   setupGLColor(mColor);
 658   realizeClip();
 659 end;
 660
 661 procedure TGxContext.onDeactivate ();
 662 begin
 663 end;
 664
 665
 666 procedure TGxContext.setColor (const clr: TGxRGBA);
 667 begin
 668   mColor := clr;
 669   if (mActive) then setupGLColor(mColor);
 670 end;
 671
 672
 673 procedure TGxContext.realizeClip ();
 674 var
 675   sx, sy, sw, sh: Integer;
 676 begin
 677   if (not mActive) then exit; // just in case
 678   if (mClipRect.w <= 0) or (mClipRect.h <= 0) then
 679   begin
 680     glEnable(GL_SCISSOR_TEST);
 681     glScissor(0, 0, 0, 0);
 682   end
 683   else
 684   begin
 685     if (mScaled) then
 686     begin
 687       sx := trunc(mClipRect.x*mScale);
 688       sy := trunc(mClipRect.y*mScale);
 689       sw := trunc(mClipRect.w*mScale);
 690       sh := trunc(mClipRect.h*mScale);
 691     end
 692     else
 693     begin
 694       sx := mClipRect.x;
 695       sy := mClipRect.y;
 696       sw := mClipRect.w;
 697       sh := mClipRect.h;
 698     end;
 699     if (not intersectRect(sx, sy, sw, sh, 0, 0, fuiScrWdt, fuiScrHgt)) then
 700     begin
 701       glEnable(GL_SCISSOR_TEST);
 702       glScissor(0, 0, 0, 0);
 703     end
 704     else if (sx = 0) and (sy = 0) and (sw = fuiScrWdt) and (sh = fuiScrHgt) then
 705     begin
 706       glDisable(GL_SCISSOR_TEST);
 707     end
 708     else
 709     begin
 710       glEnable(GL_SCISSOR_TEST);
 711       sy := fuiScrHgt-(sy+sh);
 712       glScissor(sx, sy, sw, sh);
 713     end;
 714   end;
 715 end;
 716
 717
 718 procedure TGxContext.resetClip ();
 719 begin
 720   mClipRect := TGxRect.Create(0, 0, 8192, 8192);
 721   if (mActive) then realizeClip();
 722 end;
 723
 724
 725 procedure TGxContext.setClipOfs (const aofs: TGxOfs);
 726 begin
 727   mClipOfs := aofs;
 728 end;
 729
 730
 731 procedure TGxContext.setClipRect (const aclip: TGxRect);
 732 begin
 733   mClipRect := aclip;
 734   if (mActive) then realizeClip();
 735 end;
 736
 737
 738 function TGxContext.setOffset (constref aofs: TGxOfs): TGxOfs;
 739 begin
 740   result := mClipOfs;
 741   mClipOfs := aofs;
 742 end;
 743
 744
 745 function TGxContext.setClip (constref aclip: TGxRect): TGxRect;
 746 begin
 747   result := mClipRect;
 748   mClipRect := aclip;
 749   if (mActive) then realizeClip();
 750 end;
 751
 752
 753 function TGxContext.combineClip (constref aclip: TGxRect): TGxRect;
 754 begin
 755   result := mClipRect;
 756   mClipRect.intersect(aclip);
 757   if (mActive) then realizeClip();
 758 end;
 759
 760
 761 procedure TGxContext.line (x1, y1, x2, y2: Integer);
 762 begin
 763   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
 764
 765   if (not mScaled) then
 766   begin
 767     glLineWidth(1);
 768     glBegin(GL_LINES);
 769       glVertex2f(x1+0.375, y1+0.375);
 770       glVertex2f(x2+0.375, y2+0.375);
 771     glEnd();
 772
 773     if (x1 <> x2) or (y1 <> y2) then
 774     begin
 775       glPointSize(1);
 776       glBegin(GL_POINTS);
 777         glVertex2f(x2+0.375, y2+0.375);
 778       glEnd();
 779     end;
 780   end
 781   else
 782   begin
 783     glLineWidth(1);
 784     glBegin(GL_LINES);
 785       glVertex2i(x1, y1);
 786       glVertex2i(x2, y2);
 787       // draw last point
 788       glVertex2i(x2, y2);
 789       glVertex2i(x2+1, y2+1);
 790     glEnd();
 791   end;
 792 end;
 793
 794
 795 procedure TGxContext.hline (x, y, len: Integer);
 796 begin
 797   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
 798   if (len < 1) then exit;
 799   if (not mScaled) then
 800   begin
 801     glLineWidth(1);
 802     glBegin(GL_LINES);
 803       glVertex2f(x+0.375, y+0.375);
 804       glVertex2f(x+len+0.375, y+0.375);
 805     glEnd();
 806   end
 807   else if (mScale > 1.0) then
 808   begin
 809     glBegin(GL_QUADS);
 810       glVertex2i(x, y);
 811       glVertex2i(x+len, y);
 812       glVertex2i(x+len, y+1);
 813       glVertex2i(x, y+1);
 814     glEnd();
 815   end
 816   else
 817   begin
 818     glPointSize(1);
 819     glBegin(GL_POINTS);
 820       while (len > 0) do begin glVertex2i(x, y); Inc(x); Dec(len); end;
 821     glEnd();
 822   end;
 823 end;
 824
 825
 826 procedure TGxContext.vline (x, y, len: Integer);
 827 begin
 828   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
 829   if (len < 1) then exit;
 830   if (not mScaled) then
 831   begin
 832     glLineWidth(1);
 833     glBegin(GL_LINES);
 834       glVertex2f(x+0.375, y+0.375);
 835       glVertex2f(x+0.375, y+len+0.375);
 836     glEnd();
 837   end
 838   else if (mScale > 1.0) then
 839   begin
 840     glBegin(GL_QUADS);
 841       glVertex2i(x, y);
 842       glVertex2i(x, y+len);
 843       glVertex2i(x+1, y+len);
 844       glVertex2i(x+1, y);
 845     glEnd();
 846   end
 847   else
 848   begin
 849     glPointSize(1);
 850     glBegin(GL_POINTS);
 851       while (len > 0) do begin glVertex2i(x, y); Inc(y); Dec(len); end;
 852     glEnd();
 853   end;
 854 end;
 855
 856
 857 procedure TGxContext.rect (x, y, w, h: Integer);
 858 begin
 859   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
 860   if (w < 0) or (h < 0) then exit;
 861   if (w = 1) and (h = 1) then
 862   begin
 863     glPointSize(1);
 864     glBegin(GL_POINTS);
 865       if mScaled then glVertex2i(x, y) else glVertex2f(x+0.375, y+0.375);
 866     glEnd();
 867   end
 868   else
 869   begin
 870     if (not mScaled) then
 871     begin
 872       glLineWidth(1);
 873       glBegin(GL_LINES);
 874         glVertex2i(x, y); glVertex2i(x+w, y); // top
 875         glVertex2i(x, y+h-1); glVertex2i(x+w, y+h-1); // bottom
 876         glVertex2f(x+0.375, y+1); glVertex2f(x+0.375, y+h-1); // left
 877         glVertex2f(x+w-1+0.375, y+1); glVertex2f(x+w-1+0.375, y+h-1); // right
 878       glEnd();
 879     end
 880     else
 881     begin
 882       hline(x, y, w);
 883       hline(x, y+h-1, w);
 884       vline(x, y+1, h-2);
 885       vline(x+w-1, y+1, h-2);
 886     end;
 887   end;
 888 end;
 889
 890
 891 procedure TGxContext.fillRect (x, y, w, h: Integer);
 892 begin
 893   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
 894   if (w < 0) or (h < 0) then exit;
 895   glBegin(GL_QUADS);
 896     glVertex2f(x, y);
 897     glVertex2f(x+w, y);
 898     glVertex2f(x+w, y+h);
 899     glVertex2f(x, y+h);
 900   glEnd();
 901 end;
 902
 903
 904 procedure TGxContext.darkenRect (x, y, w, h: Integer; a: Integer);
 905 begin
 906   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (a >= 255) then exit;
 907   if (w < 0) or (h < 0) then exit;
 908   if (a < 0) then a := 0;
 909   glEnable(GL_BLEND);
 910   glBlendFunc(GL_ZERO, GL_SRC_ALPHA);
 911   glColor4f(0.0, 0.0, 0.0, a/255.0);
 912   glBegin(GL_QUADS);
 913     glVertex2i(x, y);
 914     glVertex2i(x+w, y);
 915     glVertex2i(x+w, y+h);
 916     glVertex2i(x, y+h);
 917   glEnd();
 918   setupGLColor(mColor);
 919 end;
 920
 921
 922 function TGxContext.charWidth (const ch: AnsiChar): Integer;
 923 begin
 924   result := mFont.charWidth(ch);
 925 end;
 926
 927 function TGxContext.charHeight (const ch: AnsiChar): Integer;
 928 begin
 929   result := mFont.height;
 930 end;
 931
 932
 933 function TGxContext.textWidth (const s: AnsiString): Integer;
 934 begin
 935   result := mFont.textWidth(s);
 936 end;
 937
 938 function TGxContext.textHeight (const s: AnsiString): Integer;
 939 begin
 940   result := mFont.height;
 941 end;
 942
 943
 944 function TGxContext.drawChar (x, y: Integer; const ch: AnsiChar): Integer; // returns char width
 945 begin
 946   result := mFont.charWidth(ch);
 947   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
 948   TGxBmpFont(mFont).drawTextInternal(x, y, ch);
 949 end;
 950
 951 function TGxContext.drawText (x, y: Integer; const s: AnsiString): Integer; // returns text width
 952 begin
 953   result := mFont.textWidth(s);
 954   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) or (Length(s) = 0) then exit;
 955   TGxBmpFont(mFont).drawTextInternal(x, y, s);
 956 end;
 957
 958
 959 function TGxContext.iconMarkWidth (ic: TMarkIcon): Integer; begin result := 11; end;
 960 function TGxContext.iconMarkHeight (ic: TMarkIcon): Integer; begin result := 8; end;
 961
 962 procedure TGxContext.drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean);
 963 var
 964   f: Integer;
 965 begin
 966   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
 967   if (ic = TMarkIcon.Checkbox) then
 968   begin
 969     vline(x, y, 7);
 970     vline(x+10, y, 7);
 971     hline(x+1, y, 1);
 972     hline(x+1, y+6, 1);
 973     hline(x+9, y, 1);
 974     hline(x+9, y+6, 1);
 975   end
 976   else
 977   begin
 978     vline(x, y+1, 5);
 979     vline(x+10, y+1, 5);
 980     hline(x+1, y, 1);
 981     hline(x+1, y+6, 1);
 982     hline(x+9, y, 1);
 983     hline(x+9, y+6, 1);
 984   end;
 985   if (not marked) then exit;
 986   case ic of
 987     TMarkIcon.Checkbox:
 988       begin
 989         for f := 0 to 4 do
 990         begin
 991           vline(x+3+f, y+1+f, 1);
 992           vline(x+7-f, y+1+f, 1);
 993         end;
 994       end;
 995     TMarkIcon.Radiobox:
 996       begin
 997         hline(x+4, y+1, 3);
 998         hline(x+3, y+2, 5);
 999         hline(x+3, y+3, 5);
1000         hline(x+3, y+4, 5);
1001         hline(x+4, y+5, 3);
1002       end;
1003   end;
1004 end;
1005
1006
1007 function TGxContext.iconWinWidth (ic: TWinIcon): Integer; begin result := 9; end;
1008 function TGxContext.iconWinHeight (ic: TWinIcon): Integer; begin result := 8; end;
1009
1010 procedure TGxContext.drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean);
1011 var
1012   f: Integer;
1013 begin
1014   if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
1015   if pressed then rect(x, y, 9, 8);
1016   for f := 1 to 5 do
1017   begin
1018     vline(x+1+f, y+f, 1);
1019     vline(x+1+6-f, y+f, 1);
1020   end;
1021 end;
1022
1023
1024 procedure TGxContext.glSetScale (ascale: Single);
1025 begin
1026   if (ascale < 0.01) then ascale := 0.01;
1027   glLoadIdentity();
1028   glScalef(ascale, ascale, 1.0);
1029   mScale := ascale;
1030   mScaled := (ascale <> 1.0);
1031 end;
1032
1033 procedure TGxContext.glSetTrans (ax, ay: Single);
1034 begin
1035   glLoadIdentity();
1036   glScalef(mScale, mScale, 1.0);
1037   glTranslatef(ax, ay, 0);
1038 end;
1039
1040
1041 procedure TGxContext.glSetScaleTrans (ascale, ax, ay: Single);
1042 begin
1043   glSetScale(ascale);
1044   glTranslatef(ax, ay, 0);
1045 end;
1046
1047
1048 // ////////////////////////////////////////////////////////////////////////// //
1049 (*
1050 procedure oglRestoreMode (doClear: Boolean);
1051 begin
1052   oglSetup2D(fuiScrWdt, fuiScrHgt);
1053   glScissor(0, 0, fuiScrWdt, fuiScrHgt);
1054
1055   glBindTexture(GL_TEXTURE_2D, 0);
1056   glDisable(GL_BLEND);
1057   glDisable(GL_TEXTURE_2D);
1058   glDisable(GL_STENCIL_TEST);
1059   glDisable(GL_SCISSOR_TEST);
1060   glDisable(GL_LIGHTING);
1061   glDisable(GL_DEPTH_TEST);
1062   glDisable(GL_CULL_FACE);
1063   glDisable(GL_LINE_SMOOTH);
1064   glDisable(GL_POINT_SMOOTH);
1065   glLineWidth(1);
1066   glPointSize(1);
1067   glColor4f(1, 1, 1, 1);
1068
1069   if doClear then
1070   begin
1071     glClearColor(0, 0, 0, 0);
1072     glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_ACCUM_BUFFER_BIT or GL_STENCIL_BUFFER_BIT);
1073   end;
1074
1075   // scale everything
1076   glMatrixMode(GL_MODELVIEW);
1077   glLoadIdentity();
1078   //glScalef(4, 4, 1);
1079 end;
1080 *)
1081
1082
1083 //procedure onWinFocus (); begin end;
1084 //procedure onWinBlur (); begin fuiResetKMState(true); end;
1085
1086 //procedure onPreRender (); begin oglRestoreMode(gGfxDoClear); end;
1087 procedure onPostRender (); begin oglDrawCursor(); end;
1088
1089 procedure onInit ();
1090 begin
1091   //oglSetup2D(fuiScrWdt, fuiScrHgt);
1092   createCursorTexture();
1093   oglInitFonts();
1094 end;
1095
1096 procedure onDeinit ();
1097 begin
1098   fuiResetKMState(false);
1099   if (curtexid <> 0) then glDeleteTextures(1, @curtexid);
1100   curtexid := 0;
1101   oglDeinitFonts();
1102   fuiSetButState(0);
1103   fuiSetModState(0);
1104   fuiSetMouseX(0);
1105   fuiSetMouseY(0);
1106 end;
1107
1108
1109 // ////////////////////////////////////////////////////////////////////////// //
1110 initialization
1111   savedGLState := TSavedGLState.Create(false);
1112   createFonts();
1113   //winFocusCB := onWinFocus;
1114   //winBlurCB := onWinBlur;
1115   //prerenderFrameCB := onPreRender;
1116   postrenderFrameCB := onPostRender;
1117   oglInitCB := onInit;
1118   oglDeinitCB := onDeinit;
1119 end.