1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
2 * Understanding is not required. Only obedience.
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.
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.
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/>.
17 {$INCLUDE ../shared/a_modes.inc}
18 {$DEFINE FUI_TEXT_ICONS}
32 fui_common
, fui_events
;
35 // ////////////////////////////////////////////////////////////////////////// //
44 function charWidth (const ch
: AnsiChar): Integer; virtual; abstract;
45 function textWidth (const s
: AnsiString): Integer; virtual; abstract;
48 property name
: AnsiString read mName
;
49 property height
: Integer read mHeight
;
50 property baseLine
: Integer read mBaseLine
;
70 // for active contexts
77 function getFont (): AnsiString;
78 procedure setFont (const aname
: AnsiString);
80 procedure onActivate ();
81 procedure onDeactivate ();
83 procedure setColor (const clr
: TGxRGBA
);
85 procedure realizeClip (); // setup scissoring
87 procedure setClipOfs (const aofs
: TGxOfs
);
88 procedure setClipRect (const aclip
: TGxRect
);
91 constructor Create ();
92 destructor Destroy (); override;
94 procedure line (x1
, y1
, x2
, y2
: Integer);
95 procedure hline (x
, y
, len
: Integer);
96 procedure vline (x
, y
, len
: Integer);
97 procedure rect (x
, y
, w
, h
: Integer);
98 procedure fillRect (x
, y
, w
, h
: Integer);
99 procedure darkenRect (x
, y
, w
, h
: Integer; a
: Integer);
101 function charWidth (const ch
: AnsiChar): Integer;
102 function charHeight (const ch
: AnsiChar): Integer;
103 function textWidth (const s
: AnsiString): Integer;
104 function textHeight (const s
: AnsiString): Integer;
105 function drawChar (x
, y
: Integer; const ch
: AnsiChar): Integer; // returns char width
106 function drawText (x
, y
: Integer; const s
: AnsiString): Integer; // returns text width
108 function iconMarkWidth (ic
: TMarkIcon
): Integer;
109 function iconMarkHeight (ic
: TMarkIcon
): Integer;
110 procedure drawIconMark (ic
: TMarkIcon
; x
, y
: Integer; marked
: Boolean);
112 function iconWinWidth (ic
: TWinIcon
): Integer;
113 function iconWinHeight (ic
: TWinIcon
): Integer;
114 procedure drawIconWin (ic
: TWinIcon
; x
, y
: Integer; pressed
: Boolean);
116 procedure resetClip ();
118 function setOffset (constref aofs
: TGxOfs
): TGxOfs
; // returns previous offset
119 function setClip (constref aclip
: TGxRect
): TGxRect
; // returns previous clip
121 function combineClip (constref aclip
: TGxRect
): TGxRect
; // returns previous clip
123 // vertical scrollbar
124 procedure drawVSBar (x
, y
, wdt
, hgt
: Integer; cur
, min
, max
: Integer; constref clrfull
, clrempty
: TGxRGBA
);
125 // horizontal scrollbar
126 procedure drawHSBar (x
, y
, wdt
, hgt
: Integer; cur
, min
, max
: Integer; constref clrfull
, clrempty
: TGxRGBA
);
128 class function sbarFilled (wh
: Integer; cur
, min
, max
: Integer): Integer;
129 class function sbarPos (cxy
: Integer; xy
, wh
: Integer; min
, max
: Integer): Integer;
132 procedure glSetScale (ascale
: Single);
133 procedure glSetTrans (ax
, ay
: Single);
134 procedure glSetScaleTrans (ascale
, ax
, ay
: Single);
137 property active
: Boolean read mActive
;
138 property color
: TGxRGBA read mColor write setColor
;
139 property font
: AnsiString read getFont write setFont
;
140 property offset
: TGxOfs read mClipOfs write setClipOfs
;
141 property clip
: TGxRect read mClipRect write setClipRect
; // clipping is unaffected by offset
145 // set active context; `ctx` can be `nil`
146 procedure gxSetContext (ctx
: TGxContext
; ascale
: Single=1.0);
147 procedure gxSetContextNoMatrix (ctx
: TGxContext
);
150 // setup 2D OpenGL mode; will be called automatically in `glInit()`
151 procedure oglSetup2D (winWidth
, winHeight
: Integer; upsideDown
: Boolean=false);
152 procedure oglSetup2DState (); // don't modify viewports and matrices
154 procedure oglDrawCursor ();
155 procedure oglDrawCursorAt (msX
, msY
: Integer);
158 procedure fuiGfxLoadFont (const fontname
: AnsiString; const fontFile
: AnsiString; proportional
: Boolean=false);
159 procedure fuiGfxLoadFont (const fontname
: AnsiString; st
: TStream
; proportional
: Boolean=false);
162 // ////////////////////////////////////////////////////////////////////////// //
164 gGfxDoClear
: Boolean = true;
174 // ////////////////////////////////////////////////////////////////////////// //
175 // returns `false` if the color is transparent
176 // returns `false` if the color is transparent
177 function setupGLColor (constref clr
: TGxRGBA
): Boolean;
179 if (clr
.a
< 255) then
182 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
188 glColor4ub(clr
.r
, clr
.g
, clr
.b
, clr
.a
);
189 result
:= (clr
.a
<> 0);
192 function isScaled (): Boolean;
194 mt
: packed array [0..15] of GLfloat
;
196 glGetFloatv(GL_MODELVIEW_MATRIX
, @mt
[0]);
197 result
:= (mt
[0] <> 1.0) or (mt
[1*4+1] <> 1.0);
201 // ////////////////////////////////////////////////////////////////////////// //
202 //TODO: OpenGL framebuffers and shaders state
204 TSavedGLState
= record
207 gltextbinding
: GLint
;
209 //oldfbr, oldfbw: GLint;
210 glvport
: packed array [0..3] of GLint
;
214 constructor Create (dosave
: Boolean);
216 procedure restore ();
219 constructor TSavedGLState
.Create (dosave
: Boolean);
221 FillChar(self
, sizeof(self
), 0);
222 if (dosave
) then save();
225 procedure TSavedGLState
.save ();
227 if (saved
) then raise Exception
.Create('cannot save into already saved OpenGL state');
228 glGetIntegerv(GL_MATRIX_MODE
, @glmatmode
);
229 glGetIntegerv(GL_TEXTURE_BINDING_2D
, @gltextbinding
);
230 glGetIntegerv(GL_VIEWPORT
, @glvport
[0]);
231 //glGetIntegerv(GL_CURRENT_PROGRAM, &oldprg);
232 //glGetIntegerv(GL_READ_FRAMEBUFFER_BINDING, &oldfbr);
233 //glGetIntegerv(GL_DRAW_FRAMEBUFFER_BINDING, &oldfbw);
234 glMatrixMode(GL_PROJECTION
); glPushMatrix();
235 glMatrixMode(GL_MODELVIEW
); glPushMatrix();
236 glMatrixMode(GL_TEXTURE
); glPushMatrix();
237 glMatrixMode(GL_COLOR
); glPushMatrix();
238 {$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support glPushAttrib
239 glPushAttrib({GL_ENABLE_BIT|GL_COLOR_BUFFER_BIT|GL_CURRENT_BIT}GL_ALL_ATTRIB_BITS
); // let's play safe
244 procedure TSavedGLState
.restore ();
246 if (not saved
) then raise Exception
.Create('cannot restore unsaved OpenGL state');
247 {$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support glPopAttrib
248 glPopAttrib({GL_ENABLE_BIT});
250 glMatrixMode(GL_PROJECTION
); glPopMatrix();
251 glMatrixMode(GL_MODELVIEW
); glPopMatrix();
252 glMatrixMode(GL_TEXTURE
); glPopMatrix();
253 glMatrixMode(GL_COLOR
); glPopMatrix();
254 glMatrixMode(glmatmode
);
255 //if (glHasFunc!"glBindFramebufferEXT") glBindFramebufferEXT(GL_READ_FRAMEBUFFER_EXT, oldfbr);
256 //if (glHasFunc!"glBindFramebufferEXT") glBindFramebufferEXT(GL_DRAW_FRAMEBUFFER_EXT, oldfbw);
257 glBindTexture(GL_TEXTURE_2D
, gltextbinding
);
258 //if (glHasFunc!"glUseProgram") glUseProgram(oldprg);
259 glViewport(glvport
[0], glvport
[1], glvport
[2], glvport
[3]);
265 curCtx
: TGxContext
= nil;
266 savedGLState
: TSavedGLState
;
269 // ////////////////////////////////////////////////////////////////////////// //
270 // set active context; `ctx` can be `nil`
271 procedure gxSetContextInternal (ctx
: TGxContext
; ascale
: Single; domatrix
: Boolean);
273 mt
: packed array [0..15] of GLfloat
;
275 if (savedGLState
.saved
) then savedGLState
.restore();
277 if (curCtx
<> nil) then
279 curCtx
.onDeactivate();
280 curCtx
.mActive
:= false;
290 oglSetup2D(fuiScrWdt
, fuiScrHgt
);
291 glScalef(ascale
, ascale
, 1.0);
292 ctx
.mScaled
:= (ascale
<> 1.0);
293 ctx
.mScale
:= ascale
;
297 // assume uniform scale
298 glGetFloatv(GL_MODELVIEW_MATRIX
, @mt
[0]);
299 ctx
.mScaled
:= (mt
[0] <> 1.0) or (mt
[1*4+1] <> 1.0);
308 procedure gxSetContext (ctx
: TGxContext
; ascale
: Single=1.0); begin gxSetContextInternal(ctx
, ascale
, true); end;
309 procedure gxSetContextNoMatrix (ctx
: TGxContext
); begin gxSetContextInternal(ctx
, 1, false); end;
312 // ////////////////////////////////////////////////////////////////////////// //
314 TScissorSave
= record
317 scxywh
: packed array[0..3] of GLint
;
322 procedure save (enableScissoring
: Boolean);
323 procedure restore ();
325 // set new scissor rect, bounded by the saved scissor rect
326 procedure combineRect (x
, y
, w
, h
: Integer);
330 procedure TScissorSave
.save (enableScissoring
: Boolean);
332 {$IFDEF USE_NANOGL} // FIXIT: nanoGL doesn't support glIsEnabled
335 wassc
:= (glIsEnabled(GL_SCISSOR_TEST
) <> 0);
337 if wassc
then glGetIntegerv(GL_SCISSOR_BOX
, @scxywh
[0]) else glGetIntegerv(GL_VIEWPORT
, @scxywh
[0]);
338 //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
339 if enableScissoring
and (not wassc
) then glEnable(GL_SCISSOR_TEST
);
342 procedure TScissorSave
.restore ();
344 glScissor(scxywh
[0], scxywh
[1], scxywh
[2], scxywh
[3]);
345 if wassc
then glEnable(GL_SCISSOR_TEST
) else glDisable(GL_SCISSOR_TEST
);
348 procedure TScissorSave
.combineRect (x
, y
, w
, h
: Integer);
349 //var ox, oy, ow, oh: Integer;
351 if (w
< 1) or (h
< 1) then begin glScissor(0, 0, 0, 0); exit
; end;
352 y
:= fuiScrHgt
-(y
+h
);
353 //ox := x; oy := y; ow := w; oh := h;
354 if not intersectRect(x
, y
, w
, h
, scxywh
[0], scxywh
[1], scxywh
[2], scxywh
[3]) then
356 //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, ')');
357 //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, '>');
358 glScissor(0, 0, 0, 0);
362 glScissor(x
, y
, w
, h
);
367 // ////////////////////////////////////////////////////////////////////////// //
369 TGxBmpFont
= class(TGxFont
)
371 mTexId
: GLuint
; // OpenGL texture id
372 mWidth
: Integer; // <=0: proportional
375 mFreeFontWdt
: Boolean;
376 mFreeFontBmp
: Boolean;
379 procedure oglCreateTexture ();
380 procedure oglDestroyTexture ();
382 procedure initDrawText ();
383 procedure doneDrawText ();
384 function drawCharInterim (x
, y
: Integer; const ch
: AnsiChar): Integer; // return width (not including last empty pixel)
385 function drawCharInternal (x
, y
: Integer; const ch
: AnsiChar): Integer; // return width (not including last empty pixel)
386 function drawTextInternal (x
, y
: Integer; const s
: AnsiString): Integer; // return width (not including last empty pixel)
389 constructor Create (const aname
: AnsiString; st
: TStream
; proportional
: Boolean);
390 destructor Destroy (); override;
392 function charWidth (const ch
: AnsiChar): Integer; override;
393 function textWidth (const s
: AnsiString): Integer; override;
397 constructor TGxBmpFont
.Create (const aname
: AnsiString; st
: TStream
; proportional
: Boolean);
399 sign
: packed array [0..7] of AnsiChar;
400 enc
: packed array [0..16] of AnsiChar;
402 wdt
, hgt
, elen
: Integer;
407 mFreeFontBmp
:= true;
408 mFreeFontWdt
:= true;
412 st
.ReadBuffer(sign
[0], 8);
413 if (sign
<> 'FUIFONT0') then raise Exception
.Create('FlexUI: invalid font file signature');
414 // encoding length and width
416 wdt
:= (b
and $0f)+1; // 16 is not supported
417 if (wdt
= 16) then raise Exception
.Create('FlexUI: 16-wdt fonts aren''t supported yet');
418 elen
:= ((b
shr 4) and $0f);
419 if (elen
= 0) then raise Exception
.CreateFmt('FlexUI: invalid font encoding length: %d', [elen
]);
423 if (hgt
< 2) then raise Exception
.CreateFmt('FlexUI: invalid font height: %d', [hgt
]);
425 st
.ReadBuffer(enc
[0], elen
);
426 // check for 'cp1251' here (it can also be 'koi8')
427 if (wdt
<= 8) then fntbwdt
:= 1 else fntbwdt
:= 2;
428 // shift and width table (hi nibble: left shift for proportional print; lo nibble: shifted character width for proportional print)
429 GetMem(mFontWdt
, 256);
430 st
.ReadBuffer(mFontWdt
^, 256);
432 GetMem(mFontBmp
, (hgt
*fntbwdt
)*256);
433 st
.ReadBuffer(mFontBmp
^, (hgt
*fntbwdt
)*256);
436 mBaseLine
:= hgt
-1; //FIXME
437 if (proportional
) then
440 for ch
:= 0 to 255 do
442 for dy
:= 0 to hgt
-1 do
444 if (fntbwdt
= 1) then
446 mFontBmp
[ch
*hgt
+dy
] := mFontBmp
[ch
*hgt
+dy
] shl (mFontWdt
[ch
] shr 4);
450 wrd
:= mFontBmp
[ch
*(hgt
*2)+(dy
*2)]+256*mFontBmp
[ch
*(hgt
*2)+(dy
*2)+1];
451 wrd
:= wrd
shl (mFontWdt
[ch
] shr 4);
452 mFontBmp
[ch
*(hgt
*2)+(dy
*2)+0] := (wrd
and $ff);
453 mFontBmp
[ch
*(hgt
*2)+(dy
*2)+1] := ((wrd
shr 16) and $ff);
460 FillChar(mFontWdt
^, 256, wdt
);
465 destructor TGxBmpFont
.Destroy ();
467 if (mFreeFontBmp
) and (mFontBmp
<> nil) then FreeMem(mFontBmp
);
468 if (mFreeFontWdt
) and (mFontWdt
<> nil) then FreeMem(mFontWdt
);
475 mFreeFontWdt
:= false;
476 mFreeFontBmp
:= false;
482 procedure TGxBmpFont
.oglCreateTexture ();
490 x
, y
, dx
, dy
: Integer;
492 GetMem(tex
, TxWidth
*TxHeight
*4);
493 FillChar(tex
^, TxWidth
*TxHeight
*4, 0);
495 for cc
:= 0 to 255 do
499 for dy
:= 0 to mHeight
-1 do
501 if (mWidth
<= 8) then b
:= mFontBmp
[cc
*mHeight
+dy
] else b
:= mFontBmp
[cc
*(mHeight
*2)+(dy
*2)+1];
502 //if prop then b := b shl (fontwdt[cc] shr 4);
503 tpp
:= tex
+((y
+dy
)*(TxWidth
*4))+x
*4;
506 if ((b
and $80) <> 0) then
508 tpp
^ := 255; Inc(tpp
);
509 tpp
^ := 255; Inc(tpp
);
510 tpp
^ := 255; Inc(tpp
);
511 tpp
^ := 255; Inc(tpp
);
520 b
:= (b
and $7f) shl 1;
524 b
:= mFontBmp
[cc
*(mHeight
*2)+(dy
*2)+0];
527 if ((b
and $80) <> 0) then
529 tpp
^ := 255; Inc(tpp
);
530 tpp
^ := 255; Inc(tpp
);
531 tpp
^ := 255; Inc(tpp
);
532 tpp
^ := 255; Inc(tpp
);
541 b
:= (b
and $7f) shl 1;
547 glGenTextures(1, @mTexId
);
548 if (mTexId
= 0) then raise Exception
.Create('can''t create FlexUI font texture');
550 glBindTexture(GL_TEXTURE_2D
, mTexId
);
551 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_S
, GL_REPEAT
);
552 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_T
, GL_REPEAT
);
553 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, GL_NEAREST
);
554 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, GL_NEAREST
);
556 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGBA
, TxWidth
, TxHeight
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, tex
);
559 glBindTexture(GL_TEXTURE_2D
, 0);
564 procedure TGxBmpFont
.oglDestroyTexture ();
566 if (mTexId
<> 0) then
568 glDeleteTextures(1, @mTexId
);
574 function TGxBmpFont
.charWidth (const ch
: AnsiChar): Integer;
576 result
:= (mFontWdt
[Byte(ch
)] and $0f);
580 function TGxBmpFont
.textWidth (const s
: AnsiString): Integer;
584 if (Length(s
) > 0) then
587 for ch
in s
do result
+= (mFontWdt
[Byte(ch
)] and $0f)+1;
596 procedure TGxBmpFont
.initDrawText ();
598 glEnable(GL_ALPHA_TEST
);
599 glAlphaFunc(GL_NOTEQUAL
, 0.0);
600 glEnable(GL_TEXTURE_2D
);
601 glBindTexture(GL_TEXTURE_2D
, mTexId
);
605 procedure TGxBmpFont
.doneDrawText ();
607 glDisable(GL_ALPHA_TEST
);
608 glDisable(GL_TEXTURE_2D
);
609 glBindTexture(GL_TEXTURE_2D
, 0);
613 function TGxBmpFont
.drawCharInterim (x
, y
: Integer; const ch
: AnsiChar): Integer;
617 tx
:= (Integer(ch
) mod 16)*16;
618 ty
:= (Integer(ch
) div 16)*16;
620 glTexCoord2f((tx
+0)/256.0, (ty
+0)/256.0); glVertex2i(x
+0, y
+0); // top-left
621 glTexCoord2f((tx
+mWidth
)/256.0, (ty
+0)/256.0); glVertex2i(x
+mWidth
, y
+0); // top-right
622 glTexCoord2f((tx
+mWidth
)/256.0, (ty
+mHeight
)/256.0); glVertex2i(x
+mWidth
, y
+mHeight
); // bottom-right
623 glTexCoord2f((tx
+0)/256.0, (ty
+mHeight
)/256.0); glVertex2i(x
+0, y
+mHeight
); // bottom-left
625 result
:= (mFontWdt
[Byte(ch
)] and $0f);
629 function TGxBmpFont
.drawCharInternal (x
, y
: Integer; const ch
: AnsiChar): Integer;
632 result
:= drawCharInterim(x
, y
, ch
);
637 function TGxBmpFont
.drawTextInternal (x
, y
: Integer; const s
: AnsiString): Integer;
642 if (Length(s
) = 0) then begin result
:= 0; exit
; end;
647 wdt
:= drawCharInterim(x
, y
, ch
)+1;
655 // ////////////////////////////////////////////////////////////////////////// //
657 fontList
: array of TGxBmpFont
= nil;
658 defaultFontName
: AnsiString = 'win14';
661 function strEquCI (const s0
, s1
: AnsiString): Boolean;
666 result
:= (Length(s0
) = Length(s1
));
669 for f
:= 1 to Length(s0
) do
672 if (c0
>= 'a') and (c0
<= 'z') then Dec(c0
, 32); // poor man's `toupper()`
674 if (c1
>= 'a') and (c1
<= 'z') then Dec(c1
, 32); // poor man's `toupper()`
675 if (c0
<> c1
) then begin result
:= false; exit
; end;
681 function getFontByName (const aname
: AnsiString): TGxBmpFont
;
686 if (Length(fontList
) = 0) then raise Exception
.Create('font subsystem not initialized');
687 if (Length(aname
) = 0) or (strEquCI(aname
, 'default')) then fname
:= defaultFontName
else fname
:= aname
;
688 for f
:= 0 to High(fontList
) do
690 result
:= fontList
[f
];
691 if (result
= nil) then continue
;
692 if (strEquCI(result
.name
, fname
)) then exit
;
694 if (fontList
[0] = nil) then raise Exception
.Create('font subsystem not properly initialized');
695 result
:= fontList
[0];
700 procedure deleteFonts ();
704 for f := 0 to High(fontList) do freeAndNil(fontList[f]);
710 procedure fuiGfxLoadFont (const fontname
: AnsiString; const fontFile
: AnsiString; proportional
: Boolean=false);
714 if (Length(fontname
) = 0) then raise Exception
.Create('FlexUI: cannot load nameless font '''+fontFile
+'''');
715 st
:= fuiOpenFile(fontFile
);
716 if (st
= nil) then raise Exception
.Create('FlexUI: cannot load font '''+fontFile
+'''');
718 fuiGfxLoadFont(fontname
, st
, proportional
);
719 except on e
: Exception
do
721 writeln('FlexUI font loadin error: ', e
.message);
723 raise Exception
.Create('FlexUI: cannot load font '''+fontFile
+'''');
732 procedure fuiGfxLoadFont (const fontname
: AnsiString; st
: TStream
; proportional
: Boolean=false);
734 fnt
: TGxBmpFont
= nil;
737 if (Length(fontname
) = 0) then raise Exception
.Create('FlexUI: cannot load nameless font');
738 fnt
:= TGxBmpFont
.Create(fontname
, st
, proportional
);
740 for f
:= 0 to High(fontList
) do
742 if (strEquCI(fontList
[f
].name
, fontname
)) then
744 if (fontList
[f
].mTexId
<> 0) then raise Exception
.Create('FlexUI: cannot reload generated font named '''+fontname
+'''');
745 FreeAndNil(fontList
[f
]);
750 SetLength(fontList
, Length(fontList
)+1);
751 fontList
[High(fontList
)] := fnt
;
759 procedure oglInitFonts ();
763 for f
:= 0 to High(fontList
) do if (fontList
[f
] <> nil) then fontList
[f
].oglCreateTexture();
767 procedure oglDeinitFonts ();
771 for f
:= 0 to High(fontList
) do if (fontList
[f
] <> nil) then fontList
[f
].oglDestroyTexture();
775 // ////////////////////////////////////////////////////////////////////////// //
776 procedure oglSetup2DState ();
779 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
780 glDisable(GL_LINE_SMOOTH
);
781 glDisable(GL_POLYGON_SMOOTH
);
782 glDisable(GL_POINT_SMOOTH
);
783 glDisable(GL_DEPTH_TEST
);
784 glDisable(GL_TEXTURE_2D
);
785 glDisable(GL_LIGHTING
);
786 glDisable(GL_DITHER
);
787 glDisable(GL_STENCIL_TEST
);
788 glDisable(GL_SCISSOR_TEST
);
789 glDisable(GL_CULL_FACE
);
790 glDisable(GL_ALPHA_TEST
);
792 glClearColor(0, 0, 0, 0);
793 glColor4f(1, 1, 1, 1);
797 procedure oglSetup2D (winWidth
, winHeight
: Integer; upsideDown
: Boolean=false);
799 glViewport(0, 0, winWidth
, winHeight
);
803 glMatrixMode(GL_TEXTURE
);
806 glMatrixMode(GL_COLOR
);
809 glMatrixMode(GL_PROJECTION
);
813 glOrtho(0, winWidth
, 0, winHeight
, -1, 1); // set origin to bottom left
817 glOrtho(0, winWidth
, winHeight
, 0, -1, 1); // set origin to top left
820 glMatrixMode(GL_MODELVIEW
);
825 // ////////////////////////////////////////////////////////////////////////// //
826 {$INCLUDE fui_gfx_gl_cursor.inc}
828 procedure oglDrawCursor (); begin oglDrawCursorAt(fuiMouseX
, fuiMouseY
); end;
831 // ////////////////////////////////////////////////////////////////////////// //
832 constructor TGxContext
.Create ();
835 mColor
:= TGxRGBA
.Create(255, 255, 255);
836 mFont
:= getFontByName('default');
839 mClipRect
:= TGxRect
.Create(0, 0, 8192, 8192);
840 mClipOfs
:= TGxOfs
.Create(0, 0);
844 destructor TGxContext
.Destroy ();
846 if (mActive
) then gxSetContext(nil);
851 function TGxContext
.getFont (): AnsiString;
853 result
:= mFont
.name
;
856 procedure TGxContext
.setFont (const aname
: AnsiString);
858 mFont
:= getFontByName(aname
);
862 procedure TGxContext
.onActivate ();
864 setupGLColor(mColor
);
868 procedure TGxContext
.onDeactivate ();
873 procedure TGxContext
.setColor (const clr
: TGxRGBA
);
876 if (mActive
) then setupGLColor(mColor
);
880 procedure TGxContext
.realizeClip ();
882 sx
, sy
, sw
, sh
: Integer;
884 if (not mActive
) then exit
; // just in case
885 if (mClipRect
.w
<= 0) or (mClipRect
.h
<= 0) then
887 glEnable(GL_SCISSOR_TEST
);
888 glScissor(0, 0, 0, 0);
894 sx
:= trunc(mClipRect
.x
*mScale
);
895 sy
:= trunc(mClipRect
.y
*mScale
);
896 sw
:= trunc(mClipRect
.w
*mScale
);
897 sh
:= trunc(mClipRect
.h
*mScale
);
906 if (not intersectRect(sx
, sy
, sw
, sh
, 0, 0, fuiScrWdt
, fuiScrHgt
)) then
908 glEnable(GL_SCISSOR_TEST
);
909 glScissor(0, 0, 0, 0);
911 else if (sx
= 0) and (sy
= 0) and (sw
= fuiScrWdt
) and (sh
= fuiScrHgt
) then
913 glDisable(GL_SCISSOR_TEST
);
917 glEnable(GL_SCISSOR_TEST
);
918 sy
:= fuiScrHgt
-(sy
+sh
);
919 glScissor(sx
, sy
, sw
, sh
);
925 procedure TGxContext
.resetClip ();
927 mClipRect
:= TGxRect
.Create(0, 0, 8192, 8192);
928 if (mActive
) then realizeClip();
932 procedure TGxContext
.setClipOfs (const aofs
: TGxOfs
);
938 procedure TGxContext
.setClipRect (const aclip
: TGxRect
);
941 if (mActive
) then realizeClip();
945 function TGxContext
.setOffset (constref aofs
: TGxOfs
): TGxOfs
;
952 function TGxContext
.setClip (constref aclip
: TGxRect
): TGxRect
;
956 if (mActive
) then realizeClip();
960 function TGxContext
.combineClip (constref aclip
: TGxRect
): TGxRect
;
963 mClipRect
.intersect(aclip
);
964 if (mActive
) then realizeClip();
968 procedure TGxContext
.line (x1
, y1
, x2
, y2
: Integer);
970 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
972 if (not mScaled
) then
976 glVertex2f(x1
+0.375, y1
+0.375);
977 glVertex2f(x2
+0.375, y2
+0.375);
980 if (x1
<> x2
) or (y1
<> y2
) then
984 glVertex2f(x2
+0.375, y2
+0.375);
996 glVertex2i(x2
+1, y2
+1);
1002 procedure TGxContext
.hline (x
, y
, len
: Integer);
1004 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1005 if (len
< 1) then exit
;
1006 if (not mScaled
) then
1010 glVertex2f(x
+0.375, y
+0.375);
1011 glVertex2f(x
+len
+0.375, y
+0.375);
1014 else if (mScale
> 1.0) then
1018 glVertex2i(x
+len
, y
);
1019 glVertex2i(x
+len
, y
+1);
1027 while (len
> 0) do begin glVertex2i(x
, y
); Inc(x
); Dec(len
); end;
1033 procedure TGxContext
.vline (x
, y
, len
: Integer);
1035 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1036 if (len
< 1) then exit
;
1037 if (not mScaled
) then
1041 glVertex2f(x
+0.375, y
+0.375);
1042 glVertex2f(x
+0.375, y
+len
+0.375);
1045 else if (mScale
> 1.0) then
1049 glVertex2i(x
, y
+len
);
1050 glVertex2i(x
+1, y
+len
);
1058 while (len
> 0) do begin glVertex2i(x
, y
); Inc(y
); Dec(len
); end;
1064 procedure TGxContext
.rect (x
, y
, w
, h
: Integer);
1066 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1067 if (w
< 0) or (h
< 0) then exit
;
1068 if (w
= 1) and (h
= 1) then
1072 if mScaled
then glVertex2i(x
, y
) else glVertex2f(x
+0.375, y
+0.375);
1077 if (not mScaled
) then
1081 glVertex2i(x
, y
); glVertex2i(x
+w
, y
); // top
1082 glVertex2i(x
, y
+h
-1); glVertex2i(x
+w
, y
+h
-1); // bottom
1083 glVertex2f(x
+0.375, y
+1); glVertex2f(x
+0.375, y
+h
-1); // left
1084 glVertex2f(x
+w
-1+0.375, y
+1); glVertex2f(x
+w
-1+0.375, y
+h
-1); // right
1092 vline(x
+w
-1, y
+1, h
-2);
1098 procedure TGxContext
.fillRect (x
, y
, w
, h
: Integer);
1100 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1101 if (w
< 0) or (h
< 0) then exit
;
1105 glVertex2f(x
+w
, y
+h
);
1111 procedure TGxContext
.darkenRect (x
, y
, w
, h
: Integer; a
: Integer);
1113 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (a
>= 255) then exit
;
1114 if (w
< 0) or (h
< 0) then exit
;
1115 if (a
< 0) then a
:= 0;
1117 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
1118 glColor4f(0.0, 0.0, 0.0, a
/255.0);
1122 glVertex2i(x
+w
, y
+h
);
1125 setupGLColor(mColor
);
1129 function TGxContext
.charWidth (const ch
: AnsiChar): Integer;
1131 result
:= mFont
.charWidth(ch
);
1134 function TGxContext
.charHeight (const ch
: AnsiChar): Integer;
1136 result
:= mFont
.height
;
1140 function TGxContext
.textWidth (const s
: AnsiString): Integer;
1142 result
:= mFont
.textWidth(s
);
1145 function TGxContext
.textHeight (const s
: AnsiString): Integer;
1147 result
:= mFont
.height
;
1151 function TGxContext
.drawChar (x
, y
: Integer; const ch
: AnsiChar): Integer; // returns char width
1153 result
:= mFont
.charWidth(ch
);
1154 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1155 TGxBmpFont(mFont
).drawCharInternal(x
, y
, ch
);
1158 function TGxContext
.drawText (x
, y
: Integer; const s
: AnsiString): Integer; // returns text width
1160 result
:= mFont
.textWidth(s
);
1161 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) or (Length(s
) = 0) then exit
;
1162 TGxBmpFont(mFont
).drawTextInternal(x
, y
, s
);
1166 function TGxContext
.iconMarkWidth (ic
: TMarkIcon
): Integer;
1168 {$IFDEF FUI_TEXT_ICONS}
1170 TMarkIcon
.Checkbox
: result
:= textWidth('[x]');
1171 TMarkIcon
.Radiobox
: result
:= textWidth('(*)');
1172 else result
:= textWidth('[x]');
1179 function TGxContext
.iconMarkHeight (ic
: TMarkIcon
): Integer;
1181 {$IFDEF FUI_TEXT_ICONS}
1183 TMarkIcon
.Checkbox
: result
:= textHeight('[x]');
1184 TMarkIcon
.Radiobox
: result
:= textHeight('(*)');
1185 else result
:= textHeight('[x]');
1192 procedure TGxContext
.drawIconMark (ic
: TMarkIcon
; x
, y
: Integer; marked
: Boolean);
1194 {$IFDEF FUI_TEXT_ICONS}
1200 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1201 {$IFDEF FUI_TEXT_ICONS}
1203 TMarkIcon
.Checkbox
: xstr
:= '[x]';
1204 TMarkIcon
.Radiobox
: xstr
:= '(*)';
1209 drawText(x
, y
, xstr
);
1213 drawChar(x
, y
, xstr
[1]);
1214 drawChar(x
+textWidth(xstr
)-charWidth(xstr
[3]), y
, xstr
[3]);
1217 if (ic
= TMarkIcon
.Checkbox
) then
1229 vline(x
+10, y
+1, 5);
1235 if (not marked
) then exit
;
1241 vline(x
+3+f
, y
+1+f
, 1);
1242 vline(x
+7-f
, y
+1+f
, 1);
1258 function TGxContext
.iconWinWidth (ic
: TWinIcon
): Integer;
1260 {$IFDEF FUI_TEXT_ICONS}
1262 TWinIcon
.Close
: result
:= nmax(textWidth('[x]'), textWidth('[#]'));
1263 else result
:= nmax(textWidth('[x]'), textWidth('[#]'));
1270 function TGxContext
.iconWinHeight (ic
: TWinIcon
): Integer;
1272 {$IFDEF FUI_TEXT_ICONS}
1274 TWinIcon
.Close
: result
:= nmax(textHeight('[x]'), textHeight('[#]'));
1275 else result
:= nmax(textHeight('[x]'), textHeight('[#]'));
1282 procedure TGxContext
.drawIconWin (ic
: TWinIcon
; x
, y
: Integer; pressed
: Boolean);
1284 {$IFDEF FUI_TEXT_ICONS}
1291 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1292 {$IFDEF FUI_TEXT_ICONS}
1294 TWinIcon
.Close
: if (pressed
) then xstr
:= '[#]' else xstr
:= '[x]';
1297 wdt
:= nmax(textWidth('[x]'), textWidth('[#]'));
1298 drawChar(x
, y
, xstr
[1]);
1299 drawChar(x
+wdt
-charWidth(xstr
[3]), y
, xstr
[3]);
1300 drawChar(x
+((wdt
-charWidth(xstr
[2])) div 2), y
, xstr
[2]);
1302 if pressed
then rect(x
, y
, 9, 8);
1305 vline(x
+1+f
, y
+f
, 1);
1306 vline(x
+1+6-f
, y
+f
, 1);
1312 procedure TGxContext
.glSetScale (ascale
: Single);
1314 if (ascale
< 0.01) then ascale
:= 0.01;
1316 glScalef(ascale
, ascale
, 1.0);
1318 mScaled
:= (ascale
<> 1.0);
1321 procedure TGxContext
.glSetTrans (ax
, ay
: Single);
1324 glScalef(mScale
, mScale
, 1.0);
1325 glTranslatef(ax
, ay
, 0);
1329 procedure TGxContext
.glSetScaleTrans (ascale
, ax
, ay
: Single);
1332 glTranslatef(ax
, ay
, 0);
1336 // vertical scroll bar
1337 procedure TGxContext
.drawVSBar (x
, y
, wdt
, hgt
: Integer; cur
, min
, max
: Integer; constref clrfull
, clrempty
: TGxRGBA
);
1341 if (wdt
< 1) or (hgt
< 1) then exit
;
1342 filled
:= sbarFilled(hgt
, cur
, min
, max
);
1344 fillRect(x
, y
, wdt
, filled
);
1346 fillRect(x
, y
+filled
, wdt
, hgt
-filled
);
1350 // horizontal scrollbar
1351 procedure TGxContext
.drawHSBar (x
, y
, wdt
, hgt
: Integer; cur
, min
, max
: Integer; constref clrfull
, clrempty
: TGxRGBA
);
1355 if (wdt
< 1) or (hgt
< 1) then exit
;
1356 filled
:= sbarFilled(wdt
, cur
, min
, max
);
1358 fillRect(x
, y
, filled
, hgt
);
1360 fillRect(x
+filled
, y
, wdt
-filled
, hgt
);
1364 class function TGxContext
.sbarFilled (wh
: Integer; cur
, min
, max
: Integer): Integer;
1366 if (wh
< 1) then result
:= 0
1367 else if (min
> max
) then result
:= 0
1368 else if (min
= max
) then result
:= wh
1371 if (cur
< min
) then cur
:= min
else if (cur
> max
) then cur
:= max
;
1372 result
:= wh
*(cur
-min
) div (max
-min
);
1377 class function TGxContext
.sbarPos (cxy
: Integer; xy
, wh
: Integer; min
, max
: Integer): Integer;
1379 if (wh
< 1) then begin result
:= 0; exit
; end;
1380 if (min
> max
) then begin result
:= 0; exit
; end;
1381 if (min
= max
) then begin result
:= max
; exit
; end;
1382 if (cxy
< xy
) then begin result
:= min
; exit
; end;
1383 if (cxy
>= xy
+wh
) then begin result
:= max
; exit
; end;
1384 result
:= min
+((max
-min
)*(cxy
-xy
) div wh
);
1385 assert((result
>= min
) and (result
<= max
));
1391 // ////////////////////////////////////////////////////////////////////////// //
1393 procedure oglRestoreMode (doClear: Boolean);
1395 oglSetup2D(fuiScrWdt, fuiScrHgt);
1396 glScissor(0, 0, fuiScrWdt, fuiScrHgt);
1398 glBindTexture(GL_TEXTURE_2D, 0);
1399 glDisable(GL_BLEND);
1400 glDisable(GL_TEXTURE_2D);
1401 glDisable(GL_STENCIL_TEST);
1402 glDisable(GL_SCISSOR_TEST);
1403 glDisable(GL_LIGHTING);
1404 glDisable(GL_DEPTH_TEST);
1405 glDisable(GL_CULL_FACE);
1406 glDisable(GL_LINE_SMOOTH);
1407 glDisable(GL_POINT_SMOOTH);
1410 glColor4f(1, 1, 1, 1);
1414 glClearColor(0, 0, 0, 0);
1415 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_ACCUM_BUFFER_BIT or GL_STENCIL_BUFFER_BIT);
1419 glMatrixMode(GL_MODELVIEW);
1421 //glScalef(4, 4, 1);
1426 //procedure onWinFocus (); begin uiFocus(); end;
1427 //procedure onWinBlur (); begin fuiResetKMState(true); uiBlur(); end;
1429 //procedure onPreRender (); begin oglRestoreMode(gGfxDoClear); end;
1430 procedure onPostRender (); begin oglDrawCursor(); end;
1432 procedure onInit ();
1434 //oglSetup2D(fuiScrWdt, fuiScrHgt);
1435 createCursorTexture();
1439 procedure onDeinit ();
1441 fuiResetKMState(false);
1442 if (curtexid
<> 0) then glDeleteTextures(1, @curtexid
);
1452 // ////////////////////////////////////////////////////////////////////////// //
1454 savedGLState
:= TSavedGLState
.Create(false);
1456 //winFocusCB := onWinFocus;
1457 //winBlurCB := onWinBlur;
1458 //prerenderFrameCB := onPreRender;
1459 postrenderFrameCB
:= onPostRender
;
1460 oglInitCB
:= onInit
;
1461 oglDeinitCB
:= onDeinit
;