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, version 3 of the License ONLY.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE ../shared/a_modes.inc}
17 {$DEFINE FUI_TEXT_ICONS}
21 {$FATAL Desktop OpenGL required for current flexui implementation}
29 fui_common
, fui_events
;
32 // ////////////////////////////////////////////////////////////////////////// //
41 function charWidth (const ch
: AnsiChar): Integer; virtual; abstract;
42 function textWidth (const s
: AnsiString): Integer; virtual; abstract;
45 property name
: AnsiString read mName
;
46 property height
: Integer read mHeight
;
47 property baseLine
: Integer read mBaseLine
;
50 TGxContext
= class (fui_gfx
.TGxContext
)
54 // for active contexts
61 procedure realizeClip (); // setup scissoring
62 procedure setClipOfs (const aofs
: TGxOfs
); // !!!
65 function setOffset (constref aofs
: TGxOfs
): TGxOfs
; // returns previous offset
66 function setClip (constref aclip
: TGxRect
): TGxRect
; // returns previous clip
69 function getFont (): AnsiString; override;
70 procedure setFont (const aname
: AnsiString); override;
72 procedure onActivate (); override;
73 procedure onDeactivate (); override;
75 function getColor (): TGxRGBA
; override;
76 procedure setColor (const clr
: TGxRGBA
); override;
78 function getClipRect (): TGxRect
; override;
79 procedure setClipRect (const aclip
: TGxRect
); override;
82 constructor Create ();
83 destructor Destroy (); override;
85 procedure line (x1
, y1
, x2
, y2
: Integer); override;
86 procedure hline (x
, y
, len
: Integer); override;
87 procedure vline (x
, y
, len
: Integer); override;
88 procedure rect (x
, y
, w
, h
: Integer); override;
89 procedure fillRect (x
, y
, w
, h
: Integer); override;
90 procedure darkenRect (x
, y
, w
, h
: Integer; a
: Integer); override;
92 function charWidth (const ch
: AnsiChar): Integer; override;
93 function charHeight (const ch
: AnsiChar): Integer; override;
94 function textWidth (const s
: AnsiString): Integer; override;
95 function textHeight (const s
: AnsiString): Integer; override;
96 function drawChar (x
, y
: Integer; const ch
: AnsiChar): Integer; override; // returns char width
97 function drawText (x
, y
: Integer; const s
: AnsiString): Integer; override; // returns text width
99 function iconMarkWidth (ic
: TMarkIcon
): Integer; override;
100 function iconMarkHeight (ic
: TMarkIcon
): Integer; override;
101 procedure drawIconMark (ic
: TMarkIcon
; x
, y
: Integer; marked
: Boolean); override;
103 function iconWinWidth (ic
: TWinIcon
): Integer; override;
104 function iconWinHeight (ic
: TWinIcon
): Integer; override;
105 procedure drawIconWin (ic
: TWinIcon
; x
, y
: Integer; pressed
: Boolean); override;
107 procedure resetClip (); override;
109 function combineClip (constref aclip
: TGxRect
): TGxRect
; override; // returns previous clip
111 // vertical scrollbar
112 procedure drawVSBar (x
, y
, wdt
, hgt
: Integer; cur
, min
, max
: Integer; constref clrfull
, clrempty
: TGxRGBA
); override;
113 // horizontal scrollbar
114 procedure drawHSBar (x
, y
, wdt
, hgt
: Integer; cur
, min
, max
: Integer; constref clrfull
, clrempty
: TGxRGBA
); override;
117 procedure glSetScale (ascale
: Single);
118 procedure glSetTrans (ax
, ay
: Single);
119 procedure glSetScaleTrans (ascale
, ax
, ay
: Single);
122 property color
: TGxRGBA read mColor write setColor
;
123 property offset
: TGxOfs read mClipOfs write setClipOfs
;
124 property clip
: TGxRect read mClipRect write setClipRect
; // clipping is unaffected by offset
128 // setup 2D OpenGL mode; will be called automatically in `glInit()`
129 //procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
130 //procedure oglSetup2DState (); // don't modify viewports and matrices
132 //procedure oglDrawCursor ();
133 //procedure oglDrawCursorAt (msX, msY: Integer);
136 //procedure fuiGfxLoadFont (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean=false);
137 //procedure fuiGfxLoadFont (const fontname: AnsiString; st: TStream; proportional: Boolean=false);
140 // ////////////////////////////////////////////////////////////////////////// //
142 gGfxDoClear
: Boolean = true;
148 {$INCLUDE ../nogl/noGLuses.inc}
154 // ////////////////////////////////////////////////////////////////////////// //
155 // returns `false` if the color is transparent
156 // returns `false` if the color is transparent
157 function setupGLColor (constref clr
: TGxRGBA
): Boolean;
159 if (clr
.a
< 255) then
162 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
168 glColor4ub(clr
.r
, clr
.g
, clr
.b
, clr
.a
);
169 result
:= (clr
.a
<> 0);
172 function isScaled (): Boolean;
174 mt
: packed array [0..15] of GLfloat
;
176 glGetFloatv(GL_MODELVIEW_MATRIX
, @mt
[0]);
177 result
:= (mt
[0] <> 1.0) or (mt
[1*4+1] <> 1.0);
181 // ////////////////////////////////////////////////////////////////////////// //
182 //TODO: OpenGL framebuffers and shaders state
184 TSavedGLState
= record
187 gltextbinding
: GLint
;
189 //oldfbr, oldfbw: GLint;
190 glvport
: packed array [0..3] of GLint
;
194 constructor Create (dosave
: Boolean);
196 procedure restore ();
199 constructor TSavedGLState
.Create (dosave
: Boolean);
201 FillChar(self
, sizeof(self
), 0);
202 if (dosave
) then save();
205 procedure TSavedGLState
.save ();
207 if (saved
) then raise Exception
.Create('cannot save into already saved OpenGL state');
208 glGetIntegerv(GL_MATRIX_MODE
, @glmatmode
);
209 glGetIntegerv(GL_TEXTURE_BINDING_2D
, @gltextbinding
);
210 glGetIntegerv(GL_VIEWPORT
, @glvport
[0]);
211 //glGetIntegerv(GL_CURRENT_PROGRAM, &oldprg);
212 //glGetIntegerv(GL_READ_FRAMEBUFFER_BINDING, &oldfbr);
213 //glGetIntegerv(GL_DRAW_FRAMEBUFFER_BINDING, &oldfbw);
214 glMatrixMode(GL_PROJECTION
); glPushMatrix();
215 glMatrixMode(GL_MODELVIEW
); glPushMatrix();
216 glMatrixMode(GL_TEXTURE
); glPushMatrix();
217 glMatrixMode(GL_COLOR
); glPushMatrix();
218 glPushAttrib({GL_ENABLE_BIT|GL_COLOR_BUFFER_BIT|GL_CURRENT_BIT}GL_ALL_ATTRIB_BITS
); // let's play safe
222 procedure TSavedGLState
.restore ();
224 if (not saved
) then raise Exception
.Create('cannot restore unsaved OpenGL state');
225 glPopAttrib({GL_ENABLE_BIT});
226 glMatrixMode(GL_PROJECTION
); glPopMatrix();
227 glMatrixMode(GL_MODELVIEW
); glPopMatrix();
228 glMatrixMode(GL_TEXTURE
); glPopMatrix();
229 glMatrixMode(GL_COLOR
); glPopMatrix();
230 glMatrixMode(glmatmode
);
231 //if (glHasFunc!"glBindFramebufferEXT") glBindFramebufferEXT(GL_READ_FRAMEBUFFER_EXT, oldfbr);
232 //if (glHasFunc!"glBindFramebufferEXT") glBindFramebufferEXT(GL_DRAW_FRAMEBUFFER_EXT, oldfbw);
233 glBindTexture(GL_TEXTURE_2D
, gltextbinding
);
234 //if (glHasFunc!"glUseProgram") glUseProgram(oldprg);
235 glViewport(glvport
[0], glvport
[1], glvport
[2], glvport
[3]);
241 savedGLState
: TSavedGLState
;
243 procedure gxGLPreSetContextCallback
;
245 if (savedGLState
.saved
) then savedGLState
.restore();
248 function gxGLCreateContextCallback (): fui_gfx
.TGxContext
;
250 result
:= TGxContext
.Create();
253 // ////////////////////////////////////////////////////////////////////////// //
255 TScissorSave
= record
258 scxywh
: packed array[0..3] of GLint
;
263 procedure save (enableScissoring
: Boolean);
264 procedure restore ();
266 // set new scissor rect, bounded by the saved scissor rect
267 procedure combineRect (x
, y
, w
, h
: Integer);
271 procedure TScissorSave
.save (enableScissoring
: Boolean);
273 wassc
:= (glIsEnabled(GL_SCISSOR_TEST
) <> 0);
274 if wassc
then glGetIntegerv(GL_SCISSOR_BOX
, @scxywh
[0]) else glGetIntegerv(GL_VIEWPORT
, @scxywh
[0]);
275 //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
276 if enableScissoring
and (not wassc
) then glEnable(GL_SCISSOR_TEST
);
279 procedure TScissorSave
.restore ();
281 glScissor(scxywh
[0], scxywh
[1], scxywh
[2], scxywh
[3]);
282 if wassc
then glEnable(GL_SCISSOR_TEST
) else glDisable(GL_SCISSOR_TEST
);
285 procedure TScissorSave
.combineRect (x
, y
, w
, h
: Integer);
286 //var ox, oy, ow, oh: Integer;
288 if (w
< 1) or (h
< 1) then begin glScissor(0, 0, 0, 0); exit
; end;
289 y
:= fuiScrHgt
-(y
+h
);
290 //ox := x; oy := y; ow := w; oh := h;
291 if not intersectRect(x
, y
, w
, h
, scxywh
[0], scxywh
[1], scxywh
[2], scxywh
[3]) then
293 //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, ')');
294 //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, '>');
295 glScissor(0, 0, 0, 0);
299 glScissor(x
, y
, w
, h
);
304 // ////////////////////////////////////////////////////////////////////////// //
306 TGxBmpFont
= class(TGxFont
)
308 mTexId
: GLuint
; // OpenGL texture id
309 mWidth
: Integer; // <=0: proportional
312 mFreeFontWdt
: Boolean;
313 mFreeFontBmp
: Boolean;
316 procedure oglCreateTexture ();
317 procedure oglDestroyTexture ();
319 procedure initDrawText ();
320 procedure doneDrawText ();
321 function drawCharInterim (x
, y
: Integer; const ch
: AnsiChar): Integer; // return width (not including last empty pixel)
322 function drawCharInternal (x
, y
: Integer; const ch
: AnsiChar): Integer; // return width (not including last empty pixel)
323 function drawTextInternal (x
, y
: Integer; const s
: AnsiString): Integer; // return width (not including last empty pixel)
326 constructor Create (const aname
: AnsiString; st
: TStream
; proportional
: Boolean);
327 destructor Destroy (); override;
329 function charWidth (const ch
: AnsiChar): Integer; override;
330 function textWidth (const s
: AnsiString): Integer; override;
334 constructor TGxBmpFont
.Create (const aname
: AnsiString; st
: TStream
; proportional
: Boolean);
336 sign
: packed array [0..7] of AnsiChar;
337 enc
: packed array [0..16] of AnsiChar;
339 wdt
, hgt
, elen
: Integer;
344 mFreeFontBmp
:= true;
345 mFreeFontWdt
:= true;
349 st
.ReadBuffer(sign
[0], 8);
350 if (sign
<> 'FUIFONT0') then raise Exception
.Create('FlexUI: invalid font file signature');
351 // encoding length and width
353 wdt
:= (b
and $0f)+1; // 16 is not supported
354 if (wdt
= 16) then raise Exception
.Create('FlexUI: 16-wdt fonts aren''t supported yet');
355 elen
:= ((b
shr 4) and $0f);
356 if (elen
= 0) then raise Exception
.CreateFmt('FlexUI: invalid font encoding length: %d', [elen
]);
360 if (hgt
< 2) then raise Exception
.CreateFmt('FlexUI: invalid font height: %d', [hgt
]);
362 st
.ReadBuffer(enc
[0], elen
);
363 // check for 'cp1251' here (it can also be 'koi8')
364 if (wdt
<= 8) then fntbwdt
:= 1 else fntbwdt
:= 2;
365 // shift and width table (hi nibble: left shift for proportional print; lo nibble: shifted character width for proportional print)
366 GetMem(mFontWdt
, 256);
367 st
.ReadBuffer(mFontWdt
^, 256);
369 GetMem(mFontBmp
, (hgt
*fntbwdt
)*256);
370 st
.ReadBuffer(mFontBmp
^, (hgt
*fntbwdt
)*256);
373 mBaseLine
:= hgt
-1; //FIXME
374 if (proportional
) then
377 for ch
:= 0 to 255 do
379 for dy
:= 0 to hgt
-1 do
381 if (fntbwdt
= 1) then
383 mFontBmp
[ch
*hgt
+dy
] := mFontBmp
[ch
*hgt
+dy
] shl (mFontWdt
[ch
] shr 4);
387 wrd
:= mFontBmp
[ch
*(hgt
*2)+(dy
*2)]+256*mFontBmp
[ch
*(hgt
*2)+(dy
*2)+1];
388 wrd
:= wrd
shl (mFontWdt
[ch
] shr 4);
389 mFontBmp
[ch
*(hgt
*2)+(dy
*2)+0] := (wrd
and $ff);
390 mFontBmp
[ch
*(hgt
*2)+(dy
*2)+1] := ((wrd
shr 16) and $ff);
397 FillChar(mFontWdt
^, 256, wdt
);
402 destructor TGxBmpFont
.Destroy ();
404 if (mFreeFontBmp
) and (mFontBmp
<> nil) then FreeMem(mFontBmp
);
405 if (mFreeFontWdt
) and (mFontWdt
<> nil) then FreeMem(mFontWdt
);
412 mFreeFontWdt
:= false;
413 mFreeFontBmp
:= false;
419 procedure TGxBmpFont
.oglCreateTexture ();
427 x
, y
, dx
, dy
: Integer;
429 GetMem(tex
, TxWidth
*TxHeight
*4);
430 FillChar(tex
^, TxWidth
*TxHeight
*4, 0);
432 for cc
:= 0 to 255 do
436 for dy
:= 0 to mHeight
-1 do
438 if (mWidth
<= 8) then b
:= mFontBmp
[cc
*mHeight
+dy
] else b
:= mFontBmp
[cc
*(mHeight
*2)+(dy
*2)+1];
439 //if prop then b := b shl (fontwdt[cc] shr 4);
440 tpp
:= tex
+((y
+dy
)*(TxWidth
*4))+x
*4;
443 if ((b
and $80) <> 0) then
445 tpp
^ := 255; Inc(tpp
);
446 tpp
^ := 255; Inc(tpp
);
447 tpp
^ := 255; Inc(tpp
);
448 tpp
^ := 255; Inc(tpp
);
457 b
:= (b
and $7f) shl 1;
461 b
:= mFontBmp
[cc
*(mHeight
*2)+(dy
*2)+0];
464 if ((b
and $80) <> 0) then
466 tpp
^ := 255; Inc(tpp
);
467 tpp
^ := 255; Inc(tpp
);
468 tpp
^ := 255; Inc(tpp
);
469 tpp
^ := 255; Inc(tpp
);
478 b
:= (b
and $7f) shl 1;
484 glGenTextures(1, @mTexId
);
485 if (mTexId
= 0) then raise Exception
.Create('can''t create FlexUI font texture');
487 glBindTexture(GL_TEXTURE_2D
, mTexId
);
488 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_S
, GL_REPEAT
);
489 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_T
, GL_REPEAT
);
490 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, GL_NEAREST
);
491 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, GL_NEAREST
);
493 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGBA
, TxWidth
, TxHeight
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, tex
);
496 glBindTexture(GL_TEXTURE_2D
, 0);
501 procedure TGxBmpFont
.oglDestroyTexture ();
503 if (mTexId
<> 0) then
505 glDeleteTextures(1, @mTexId
);
511 function TGxBmpFont
.charWidth (const ch
: AnsiChar): Integer;
513 result
:= (mFontWdt
[Byte(ch
)] and $0f);
517 function TGxBmpFont
.textWidth (const s
: AnsiString): Integer;
521 if (Length(s
) > 0) then
524 for ch
in s
do result
+= (mFontWdt
[Byte(ch
)] and $0f)+1;
533 procedure TGxBmpFont
.initDrawText ();
535 glEnable(GL_ALPHA_TEST
);
536 glAlphaFunc(GL_NOTEQUAL
, 0.0);
537 glEnable(GL_TEXTURE_2D
);
538 glBindTexture(GL_TEXTURE_2D
, mTexId
);
542 procedure TGxBmpFont
.doneDrawText ();
544 glDisable(GL_ALPHA_TEST
);
545 glDisable(GL_TEXTURE_2D
);
546 glBindTexture(GL_TEXTURE_2D
, 0);
550 function TGxBmpFont
.drawCharInterim (x
, y
: Integer; const ch
: AnsiChar): Integer;
554 tx
:= (Integer(ch
) mod 16)*16;
555 ty
:= (Integer(ch
) div 16)*16;
557 glTexCoord2f((tx
+0)/256.0, (ty
+0)/256.0); glVertex2i(x
+0, y
+0); // top-left
558 glTexCoord2f((tx
+mWidth
)/256.0, (ty
+0)/256.0); glVertex2i(x
+mWidth
, y
+0); // top-right
559 glTexCoord2f((tx
+mWidth
)/256.0, (ty
+mHeight
)/256.0); glVertex2i(x
+mWidth
, y
+mHeight
); // bottom-right
560 glTexCoord2f((tx
+0)/256.0, (ty
+mHeight
)/256.0); glVertex2i(x
+0, y
+mHeight
); // bottom-left
562 result
:= (mFontWdt
[Byte(ch
)] and $0f);
566 function TGxBmpFont
.drawCharInternal (x
, y
: Integer; const ch
: AnsiChar): Integer;
569 result
:= drawCharInterim(x
, y
, ch
);
574 function TGxBmpFont
.drawTextInternal (x
, y
: Integer; const s
: AnsiString): Integer;
579 if (Length(s
) = 0) then begin result
:= 0; exit
; end;
584 wdt
:= drawCharInterim(x
, y
, ch
)+1;
592 // ////////////////////////////////////////////////////////////////////////// //
594 fontList
: array of TGxBmpFont
= nil;
595 defaultFontName
: AnsiString = 'win14';
598 function strEquCI (const s0
, s1
: AnsiString): Boolean;
603 result
:= (Length(s0
) = Length(s1
));
606 for f
:= 1 to Length(s0
) do
609 if (c0
>= 'a') and (c0
<= 'z') then Dec(c0
, 32); // poor man's `toupper()`
611 if (c1
>= 'a') and (c1
<= 'z') then Dec(c1
, 32); // poor man's `toupper()`
612 if (c0
<> c1
) then begin result
:= false; exit
; end;
618 function getFontByName (const aname
: AnsiString): TGxBmpFont
;
623 if (Length(fontList
) = 0) then raise Exception
.Create('font subsystem not initialized');
624 if (Length(aname
) = 0) or (strEquCI(aname
, 'default')) then fname
:= defaultFontName
else fname
:= aname
;
625 for f
:= 0 to High(fontList
) do
627 result
:= fontList
[f
];
628 if (result
= nil) then continue
;
629 if (strEquCI(result
.name
, fname
)) then exit
;
631 if (fontList
[0] = nil) then raise Exception
.Create('font subsystem not properly initialized');
632 result
:= fontList
[0];
637 procedure deleteFonts ();
641 for f := 0 to High(fontList) do freeAndNil(fontList[f]);
647 procedure fuiGfxLoadFont (const fontname
: AnsiString; st
: TStream
; proportional
: Boolean=false);
649 fnt
: TGxBmpFont
= nil;
652 if (Length(fontname
) = 0) then raise Exception
.Create('FlexUI: cannot load nameless font');
653 fnt
:= TGxBmpFont
.Create(fontname
, st
, proportional
);
655 for f
:= 0 to High(fontList
) do
657 if (strEquCI(fontList
[f
].name
, fontname
)) then
659 if (fontList
[f
].mTexId
<> 0) then raise Exception
.Create('FlexUI: cannot reload generated font named '''+fontname
+'''');
660 FreeAndNil(fontList
[f
]);
665 SetLength(fontList
, Length(fontList
)+1);
666 fontList
[High(fontList
)] := fnt
;
674 procedure fuiGfxLoadFont (const fontname
: AnsiString; const fontFile
: AnsiString; proportional
: Boolean=false);
678 if (Length(fontname
) = 0) then raise Exception
.Create('FlexUI: cannot load nameless font '''+fontFile
+'''');
679 st
:= fuiOpenFile(fontFile
);
680 if (st
= nil) then raise Exception
.Create('FlexUI: cannot load font '''+fontFile
+'''');
682 fuiGfxLoadFont(fontname
, st
, proportional
);
683 except on e
: Exception
do
685 writeln('FlexUI font loadin error: ', e
.message);
687 raise Exception
.Create('FlexUI: cannot load font '''+fontFile
+'''');
696 procedure oglInitFonts ();
700 for f
:= 0 to High(fontList
) do if (fontList
[f
] <> nil) then fontList
[f
].oglCreateTexture();
704 procedure oglDeinitFonts ();
708 for f
:= 0 to High(fontList
) do if (fontList
[f
] <> nil) then fontList
[f
].oglDestroyTexture();
712 // ////////////////////////////////////////////////////////////////////////// //
713 procedure oglSetup2DState ();
716 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
717 glDisable(GL_LINE_SMOOTH
);
718 glDisable(GL_POLYGON_SMOOTH
);
719 glDisable(GL_POINT_SMOOTH
);
720 glDisable(GL_DEPTH_TEST
);
721 glDisable(GL_TEXTURE_2D
);
722 glDisable(GL_LIGHTING
);
723 glDisable(GL_DITHER
);
724 glDisable(GL_STENCIL_TEST
);
725 glDisable(GL_SCISSOR_TEST
);
726 glDisable(GL_CULL_FACE
);
727 glDisable(GL_ALPHA_TEST
);
729 glClearColor(0, 0, 0, 0);
730 glColor4f(1, 1, 1, 1);
734 procedure oglSetup2D (winWidth
, winHeight
: Integer; upsideDown
: Boolean=false);
736 glViewport(0, 0, winWidth
, winHeight
);
740 glMatrixMode(GL_TEXTURE
);
743 glMatrixMode(GL_COLOR
);
746 glMatrixMode(GL_PROJECTION
);
750 glOrtho(0, winWidth
, 0, winHeight
, -1, 1); // set origin to bottom left
754 glOrtho(0, winWidth
, winHeight
, 0, -1, 1); // set origin to top left
757 glMatrixMode(GL_MODELVIEW
);
762 // ////////////////////////////////////////////////////////////////////////// //
763 {$INCLUDE r_fui_gfx_gl_cursor.inc}
765 procedure oglDrawCursor (); begin oglDrawCursorAt(fuiMouseX
, fuiMouseY
); end;
768 // ////////////////////////////////////////////////////////////////////////// //
769 constructor TGxContext
.Create ();
772 mColor
:= TGxRGBA
.Create(255, 255, 255);
773 mFont
:= getFontByName('default');
776 mClipRect
:= TGxRect
.Create(0, 0, 8192, 8192);
777 mClipOfs
:= TGxOfs
.Create(0, 0);
781 destructor TGxContext
.Destroy ();
783 if self
.active
then gxSetContext(nil);
788 function TGxContext
.getFont (): AnsiString;
790 result
:= mFont
.name
;
793 procedure TGxContext
.setFont (const aname
: AnsiString);
795 mFont
:= getFontByName(aname
);
799 procedure TGxContext
.onActivate ();
800 //ascale: Single; domatrix: Boolean;
802 mt
: packed array [0..15] of GLfloat
;
805 // if (domatrix) then
807 // oglSetup2D(fuiScrWdt, fuiScrHgt);
808 // glScalef(ascale, ascale, 1.0);
809 // self.mScaled := (ascale <> 1.0);
810 // self.mScale := ascale;
814 // assume uniform scale
815 glGetFloatv(GL_MODELVIEW_MATRIX
, @mt
[0]);
816 self
.mScaled
:= (mt
[0] <> 1.0) or (mt
[1*4+1] <> 1.0);
817 self
.mScale
:= mt
[0];
820 setupGLColor(mColor
);
824 procedure TGxContext
.onDeactivate ();
829 function TGxContext
.getColor (): TGxRGBA
;
834 procedure TGxContext
.setColor (const clr
: TGxRGBA
);
837 if self
.active
then setupGLColor(mColor
);
841 procedure TGxContext
.realizeClip ();
843 sx
, sy
, sw
, sh
: Integer;
845 if not self
.active
then exit
; // just in case
846 if (mClipRect
.w
<= 0) or (mClipRect
.h
<= 0) then
848 glEnable(GL_SCISSOR_TEST
);
849 glScissor(0, 0, 0, 0);
855 sx
:= trunc(mClipRect
.x
*mScale
);
856 sy
:= trunc(mClipRect
.y
*mScale
);
857 sw
:= trunc(mClipRect
.w
*mScale
);
858 sh
:= trunc(mClipRect
.h
*mScale
);
867 if (not intersectRect(sx
, sy
, sw
, sh
, 0, 0, fuiScrWdt
, fuiScrHgt
)) then
869 glEnable(GL_SCISSOR_TEST
);
870 glScissor(0, 0, 0, 0);
872 else if (sx
= 0) and (sy
= 0) and (sw
= fuiScrWdt
) and (sh
= fuiScrHgt
) then
874 glDisable(GL_SCISSOR_TEST
);
878 glEnable(GL_SCISSOR_TEST
);
879 sy
:= fuiScrHgt
-(sy
+sh
);
880 glScissor(sx
, sy
, sw
, sh
);
886 procedure TGxContext
.resetClip ();
888 mClipRect
:= TGxRect
.Create(0, 0, 8192, 8192);
889 if self
.active
then realizeClip();
893 procedure TGxContext
.setClipOfs (const aofs
: TGxOfs
);
899 function TGxContext
.getClipRect (): TGxRect
;
904 procedure TGxContext
.setClipRect (const aclip
: TGxRect
);
907 if self
.active
then realizeClip();
911 function TGxContext
.setOffset (constref aofs
: TGxOfs
): TGxOfs
;
918 function TGxContext
.setClip (constref aclip
: TGxRect
): TGxRect
;
922 if self
.active
then realizeClip();
926 function TGxContext
.combineClip (constref aclip
: TGxRect
): TGxRect
;
929 mClipRect
.intersect(aclip
);
930 if self
.active
then realizeClip();
934 procedure TGxContext
.line (x1
, y1
, x2
, y2
: Integer);
936 if (not self
.active
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
938 if (not mScaled
) then
942 glVertex2f(x1
+0.375, y1
+0.375);
943 glVertex2f(x2
+0.375, y2
+0.375);
946 if (x1
<> x2
) or (y1
<> y2
) then
950 glVertex2f(x2
+0.375, y2
+0.375);
962 glVertex2i(x2
+1, y2
+1);
968 procedure TGxContext
.hline (x
, y
, len
: Integer);
970 if (not self
.active
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
971 if (len
< 1) then exit
;
972 if (not mScaled
) then
976 glVertex2f(x
+0.375, y
+0.375);
977 glVertex2f(x
+len
+0.375, y
+0.375);
980 else if (mScale
> 1.0) then
984 glVertex2i(x
+len
, y
);
985 glVertex2i(x
+len
, y
+1);
993 while (len
> 0) do begin glVertex2i(x
, y
); Inc(x
); Dec(len
); end;
999 procedure TGxContext
.vline (x
, y
, len
: Integer);
1001 if (not self
.active
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1002 if (len
< 1) then exit
;
1003 if (not mScaled
) then
1007 glVertex2f(x
+0.375, y
+0.375);
1008 glVertex2f(x
+0.375, y
+len
+0.375);
1011 else if (mScale
> 1.0) then
1015 glVertex2i(x
, y
+len
);
1016 glVertex2i(x
+1, y
+len
);
1024 while (len
> 0) do begin glVertex2i(x
, y
); Inc(y
); Dec(len
); end;
1030 procedure TGxContext
.rect (x
, y
, w
, h
: Integer);
1032 if (not self
.active
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1033 if (w
< 0) or (h
< 0) then exit
;
1034 if (w
= 1) and (h
= 1) then
1038 if mScaled
then glVertex2i(x
, y
) else glVertex2f(x
+0.375, y
+0.375);
1043 if (not mScaled
) then
1047 glVertex2i(x
, y
); glVertex2i(x
+w
, y
); // top
1048 glVertex2i(x
, y
+h
-1); glVertex2i(x
+w
, y
+h
-1); // bottom
1049 glVertex2f(x
+0.375, y
+1); glVertex2f(x
+0.375, y
+h
-1); // left
1050 glVertex2f(x
+w
-1+0.375, y
+1); glVertex2f(x
+w
-1+0.375, y
+h
-1); // right
1058 vline(x
+w
-1, y
+1, h
-2);
1064 procedure TGxContext
.fillRect (x
, y
, w
, h
: Integer);
1066 if (not self
.active
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1067 if (w
< 0) or (h
< 0) then exit
;
1071 glVertex2f(x
+w
, y
+h
);
1077 procedure TGxContext
.darkenRect (x
, y
, w
, h
: Integer; a
: Integer);
1079 if (not self
.active
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (a
>= 255) then exit
;
1080 if (w
< 0) or (h
< 0) then exit
;
1081 if (a
< 0) then a
:= 0;
1083 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
1084 glColor4f(0.0, 0.0, 0.0, a
/255.0);
1088 glVertex2i(x
+w
, y
+h
);
1091 setupGLColor(mColor
);
1095 function TGxContext
.charWidth (const ch
: AnsiChar): Integer;
1097 result
:= mFont
.charWidth(ch
);
1100 function TGxContext
.charHeight (const ch
: AnsiChar): Integer;
1102 result
:= mFont
.height
;
1106 function TGxContext
.textWidth (const s
: AnsiString): Integer;
1108 result
:= mFont
.textWidth(s
);
1111 function TGxContext
.textHeight (const s
: AnsiString): Integer;
1113 result
:= mFont
.height
;
1117 function TGxContext
.drawChar (x
, y
: Integer; const ch
: AnsiChar): Integer; // returns char width
1119 result
:= mFont
.charWidth(ch
);
1120 if (not self
.active
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1121 TGxBmpFont(mFont
).drawCharInternal(x
, y
, ch
);
1124 function TGxContext
.drawText (x
, y
: Integer; const s
: AnsiString): Integer; // returns text width
1126 result
:= mFont
.textWidth(s
);
1127 if (not self
.active
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) or (Length(s
) = 0) then exit
;
1128 TGxBmpFont(mFont
).drawTextInternal(x
, y
, s
);
1132 function TGxContext
.iconMarkWidth (ic
: TMarkIcon
): Integer;
1134 {$IFDEF FUI_TEXT_ICONS}
1136 TMarkIcon
.Checkbox
: result
:= textWidth('[x]');
1137 TMarkIcon
.Radiobox
: result
:= textWidth('(*)');
1138 else result
:= textWidth('[x]');
1145 function TGxContext
.iconMarkHeight (ic
: TMarkIcon
): Integer;
1147 {$IFDEF FUI_TEXT_ICONS}
1149 TMarkIcon
.Checkbox
: result
:= textHeight('[x]');
1150 TMarkIcon
.Radiobox
: result
:= textHeight('(*)');
1151 else result
:= textHeight('[x]');
1158 procedure TGxContext
.drawIconMark (ic
: TMarkIcon
; x
, y
: Integer; marked
: Boolean);
1160 {$IFDEF FUI_TEXT_ICONS}
1166 if (not self
.active
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1167 {$IFDEF FUI_TEXT_ICONS}
1169 TMarkIcon
.Checkbox
: xstr
:= '[x]';
1170 TMarkIcon
.Radiobox
: xstr
:= '(*)';
1175 drawText(x
, y
, xstr
);
1179 drawChar(x
, y
, xstr
[1]);
1180 drawChar(x
+textWidth(xstr
)-charWidth(xstr
[3]), y
, xstr
[3]);
1183 if (ic
= TMarkIcon
.Checkbox
) then
1195 vline(x
+10, y
+1, 5);
1201 if (not marked
) then exit
;
1207 vline(x
+3+f
, y
+1+f
, 1);
1208 vline(x
+7-f
, y
+1+f
, 1);
1224 function TGxContext
.iconWinWidth (ic
: TWinIcon
): Integer;
1226 {$IFDEF FUI_TEXT_ICONS}
1228 TWinIcon
.Close
: result
:= nmax(textWidth('[x]'), textWidth('[#]'));
1229 else result
:= nmax(textWidth('[x]'), textWidth('[#]'));
1236 function TGxContext
.iconWinHeight (ic
: TWinIcon
): Integer;
1238 {$IFDEF FUI_TEXT_ICONS}
1240 TWinIcon
.Close
: result
:= nmax(textHeight('[x]'), textHeight('[#]'));
1241 else result
:= nmax(textHeight('[x]'), textHeight('[#]'));
1248 procedure TGxContext
.drawIconWin (ic
: TWinIcon
; x
, y
: Integer; pressed
: Boolean);
1250 {$IFDEF FUI_TEXT_ICONS}
1257 if (not self
.active
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1258 {$IFDEF FUI_TEXT_ICONS}
1260 TWinIcon
.Close
: if (pressed
) then xstr
:= '[#]' else xstr
:= '[x]';
1263 wdt
:= nmax(textWidth('[x]'), textWidth('[#]'));
1264 drawChar(x
, y
, xstr
[1]);
1265 drawChar(x
+wdt
-charWidth(xstr
[3]), y
, xstr
[3]);
1266 drawChar(x
+((wdt
-charWidth(xstr
[2])) div 2), y
, xstr
[2]);
1268 if pressed
then rect(x
, y
, 9, 8);
1271 vline(x
+1+f
, y
+f
, 1);
1272 vline(x
+1+6-f
, y
+f
, 1);
1278 procedure TGxContext
.glSetScale (ascale
: Single);
1280 if (ascale
< 0.01) then ascale
:= 0.01;
1282 glScalef(ascale
, ascale
, 1.0);
1284 mScaled
:= (ascale
<> 1.0);
1287 procedure TGxContext
.glSetTrans (ax
, ay
: Single);
1290 glScalef(mScale
, mScale
, 1.0);
1291 glTranslatef(ax
, ay
, 0);
1295 procedure TGxContext
.glSetScaleTrans (ascale
, ax
, ay
: Single);
1298 glTranslatef(ax
, ay
, 0);
1302 // vertical scroll bar
1303 procedure TGxContext
.drawVSBar (x
, y
, wdt
, hgt
: Integer; cur
, min
, max
: Integer; constref clrfull
, clrempty
: TGxRGBA
);
1307 if (wdt
< 1) or (hgt
< 1) then exit
;
1308 filled
:= sbarFilled(hgt
, cur
, min
, max
);
1310 fillRect(x
, y
, wdt
, filled
);
1312 fillRect(x
, y
+filled
, wdt
, hgt
-filled
);
1316 // horizontal scrollbar
1317 procedure TGxContext
.drawHSBar (x
, y
, wdt
, hgt
: Integer; cur
, min
, max
: Integer; constref clrfull
, clrempty
: TGxRGBA
);
1321 if (wdt
< 1) or (hgt
< 1) then exit
;
1322 filled
:= sbarFilled(wdt
, cur
, min
, max
);
1324 fillRect(x
, y
, filled
, hgt
);
1326 fillRect(x
+filled
, y
, wdt
-filled
, hgt
);
1330 // ////////////////////////////////////////////////////////////////////////// //
1332 procedure oglRestoreMode (doClear: Boolean);
1334 oglSetup2D(fuiScrWdt, fuiScrHgt);
1335 glScissor(0, 0, fuiScrWdt, fuiScrHgt);
1337 glBindTexture(GL_TEXTURE_2D, 0);
1338 glDisable(GL_BLEND);
1339 glDisable(GL_TEXTURE_2D);
1340 glDisable(GL_STENCIL_TEST);
1341 glDisable(GL_SCISSOR_TEST);
1342 glDisable(GL_LIGHTING);
1343 glDisable(GL_DEPTH_TEST);
1344 glDisable(GL_CULL_FACE);
1345 glDisable(GL_LINE_SMOOTH);
1346 glDisable(GL_POINT_SMOOTH);
1349 glColor4f(1, 1, 1, 1);
1353 glClearColor(0, 0, 0, 0);
1354 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_ACCUM_BUFFER_BIT or GL_STENCIL_BUFFER_BIT);
1358 glMatrixMode(GL_MODELVIEW);
1360 //glScalef(4, 4, 1);
1365 //procedure onWinFocus (); begin uiFocus(); end;
1366 //procedure onWinBlur (); begin fuiResetKMState(true); uiBlur(); end;
1368 //procedure onPreRender (); begin oglRestoreMode(gGfxDoClear); end;
1369 procedure onPostRender (); begin oglDrawCursor(); end;
1371 procedure onInit ();
1373 //oglSetup2D(fuiScrWdt, fuiScrHgt);
1374 createCursorTexture();
1378 procedure onDeinit ();
1380 fuiResetKMState(false);
1381 if (curtexid
<> 0) then glDeleteTextures(1, @curtexid
);
1391 // ////////////////////////////////////////////////////////////////////////// //
1393 savedGLState
:= TSavedGLState
.Create(false);
1395 //winFocusCB := onWinFocus;
1396 //winBlurCB := onWinBlur;
1397 //prerenderFrameCB := onPreRender;
1398 postrenderFrameCB
:= onPostRender
;
1399 oglInitCB
:= onInit
;
1400 oglDeinitCB
:= onDeinit
;
1402 gxPreSetContextCallback
:= gxGLPreSetContextCallback
;
1403 gxCreateContextCallback
:= gxGLCreateContextCallback
;
1404 gxFuiGfxLoadFontCallback
:= fuiGfxLoadFont
;