src/flexui/fui_gfx_gl.pas

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