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}
26 fui_common
, fui_events
;
29 // ////////////////////////////////////////////////////////////////////////// //
38 function charWidth (const ch
: AnsiChar): Integer; virtual; abstract;
39 function textWidth (const s
: AnsiString): Integer; virtual; abstract;
42 property name
: AnsiString read mName
;
43 property height
: Integer read mHeight
;
44 property baseLine
: Integer read mBaseLine
;
64 // for active contexts
71 function getFont (): AnsiString;
72 procedure setFont (const aname
: AnsiString);
74 procedure onActivate ();
75 procedure onDeactivate ();
77 procedure setColor (const clr
: TGxRGBA
);
79 procedure realizeClip (); // setup scissoring
81 procedure setClipOfs (const aofs
: TGxOfs
);
82 procedure setClipRect (const aclip
: TGxRect
);
85 constructor Create ();
86 destructor Destroy (); override;
88 procedure line (x1
, y1
, x2
, y2
: Integer);
89 procedure hline (x
, y
, len
: Integer);
90 procedure vline (x
, y
, len
: Integer);
91 procedure rect (x
, y
, w
, h
: Integer);
92 procedure fillRect (x
, y
, w
, h
: Integer);
93 procedure darkenRect (x
, y
, w
, h
: Integer; a
: Integer);
95 function charWidth (const ch
: AnsiChar): Integer;
96 function charHeight (const ch
: AnsiChar): Integer;
97 function textWidth (const s
: AnsiString): Integer;
98 function textHeight (const s
: AnsiString): Integer;
99 function drawChar (x
, y
: Integer; const ch
: AnsiChar): Integer; // returns char width
100 function drawText (x
, y
: Integer; const s
: AnsiString): Integer; // returns text width
102 function iconMarkWidth (ic
: TMarkIcon
): Integer;
103 function iconMarkHeight (ic
: TMarkIcon
): Integer;
104 procedure drawIconMark (ic
: TMarkIcon
; x
, y
: Integer; marked
: Boolean);
106 function iconWinWidth (ic
: TWinIcon
): Integer;
107 function iconWinHeight (ic
: TWinIcon
): Integer;
108 procedure drawIconWin (ic
: TWinIcon
; x
, y
: Integer; pressed
: Boolean);
110 procedure resetClip ();
112 function setOffset (constref aofs
: TGxOfs
): TGxOfs
; // returns previous offset
113 function setClip (constref aclip
: TGxRect
): TGxRect
; // returns previous clip
115 function combineClip (constref aclip
: TGxRect
): TGxRect
; // returns previous clip
118 procedure glSetScale (ascale
: Single);
119 procedure glSetTrans (ax
, ay
: Single);
120 procedure glSetScaleTrans (ascale
, ax
, ay
: Single);
123 property active
: Boolean read mActive
;
124 property color
: TGxRGBA read mColor write setColor
;
125 property font
: AnsiString read getFont write setFont
;
126 property offset
: TGxOfs read mClipOfs write setClipOfs
;
127 property clip
: TGxRect read mClipRect write setClipRect
; // clipping is unaffected by offset
131 // set active context; `ctx` can be `nil`
132 procedure gxSetContext (ctx
: TGxContext
; ascale
: Single=1.0);
133 procedure gxSetContextNoMatrix (ctx
: TGxContext
);
136 // setup 2D OpenGL mode; will be called automatically in `glInit()`
137 procedure oglSetup2D (winWidth
, winHeight
: Integer; upsideDown
: Boolean=false);
138 procedure oglSetup2DState (); // don't modify viewports and matrices
140 procedure oglDrawCursor ();
141 procedure oglDrawCursorAt (msX
, msY
: Integer);
145 // ////////////////////////////////////////////////////////////////////////// //
147 gGfxDoClear
: Boolean = true;
153 // ////////////////////////////////////////////////////////////////////////// //
154 // returns `false` if the color is transparent
155 // returns `false` if the color is transparent
156 function setupGLColor (constref clr
: TGxRGBA
): Boolean;
158 if (clr
.a
< 255) then
161 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
167 glColor4ub(clr
.r
, clr
.g
, clr
.b
, clr
.a
);
168 result
:= (clr
.a
<> 0);
171 function isScaled (): Boolean;
173 mt
: packed array [0..15] of Double;
175 glGetDoublev(GL_MODELVIEW_MATRIX
, @mt
[0]);
176 result
:= (mt
[0] <> 1.0) or (mt
[1*4+1] <> 1.0);
180 // ////////////////////////////////////////////////////////////////////////// //
181 //TODO: OpenGL framebuffers and shaders state
183 TSavedGLState
= record
186 gltextbinding
: GLint
;
188 //oldfbr, oldfbw: GLint;
189 glvport
: packed array [0..3] of GLint
;
193 constructor Create (dosave
: Boolean);
195 procedure restore ();
198 constructor TSavedGLState
.Create (dosave
: Boolean);
200 FillChar(self
, sizeof(self
), 0);
201 if (dosave
) then save();
204 procedure TSavedGLState
.save ();
206 if (saved
) then raise Exception
.Create('cannot save into already saved OpenGL state');
207 glGetIntegerv(GL_MATRIX_MODE
, @glmatmode
);
208 glGetIntegerv(GL_TEXTURE_BINDING_2D
, @gltextbinding
);
209 glGetIntegerv(GL_VIEWPORT
, @glvport
[0]);
210 //glGetIntegerv(GL_CURRENT_PROGRAM, &oldprg);
211 //glGetIntegerv(GL_READ_FRAMEBUFFER_BINDING, &oldfbr);
212 //glGetIntegerv(GL_DRAW_FRAMEBUFFER_BINDING, &oldfbw);
213 glMatrixMode(GL_PROJECTION
); glPushMatrix();
214 glMatrixMode(GL_MODELVIEW
); glPushMatrix();
215 glMatrixMode(GL_TEXTURE
); glPushMatrix();
216 glMatrixMode(GL_COLOR
); glPushMatrix();
217 glPushAttrib({GL_ENABLE_BIT|GL_COLOR_BUFFER_BIT|GL_CURRENT_BIT}GL_ALL_ATTRIB_BITS
); // let's play safe
221 procedure TSavedGLState
.restore ();
223 if (not saved
) then raise Exception
.Create('cannot restore unsaved OpenGL state');
224 glPopAttrib({GL_ENABLE_BIT});
225 glMatrixMode(GL_PROJECTION
); glPopMatrix();
226 glMatrixMode(GL_MODELVIEW
); glPopMatrix();
227 glMatrixMode(GL_TEXTURE
); glPopMatrix();
228 glMatrixMode(GL_COLOR
); glPopMatrix();
229 glMatrixMode(glmatmode
);
230 //if (glHasFunc!"glBindFramebufferEXT") glBindFramebufferEXT(GL_READ_FRAMEBUFFER_EXT, oldfbr);
231 //if (glHasFunc!"glBindFramebufferEXT") glBindFramebufferEXT(GL_DRAW_FRAMEBUFFER_EXT, oldfbw);
232 glBindTexture(GL_TEXTURE_2D
, gltextbinding
);
233 //if (glHasFunc!"glUseProgram") glUseProgram(oldprg);
234 glViewport(glvport
[0], glvport
[1], glvport
[2], glvport
[3]);
240 curCtx
: TGxContext
= nil;
241 savedGLState
: TSavedGLState
;
244 // ////////////////////////////////////////////////////////////////////////// //
245 // set active context; `ctx` can be `nil`
246 procedure gxSetContextInternal (ctx
: TGxContext
; ascale
: Single; domatrix
: Boolean);
248 mt
: packed array [0..15] of Double;
250 if (savedGLState
.saved
) then savedGLState
.restore();
252 if (curCtx
<> nil) then
254 curCtx
.onDeactivate();
255 curCtx
.mActive
:= false;
265 oglSetup2D(fuiScrWdt
, fuiScrHgt
);
266 glScalef(ascale
, ascale
, 1.0);
267 ctx
.mScaled
:= (ascale
<> 1.0);
268 ctx
.mScale
:= ascale
;
272 // assume uniform scale
273 glGetDoublev(GL_MODELVIEW_MATRIX
, @mt
[0]);
274 ctx
.mScaled
:= (mt
[0] <> 1.0) or (mt
[1*4+1] <> 1.0);
283 procedure gxSetContext (ctx
: TGxContext
; ascale
: Single=1.0); begin gxSetContextInternal(ctx
, ascale
, true); end;
284 procedure gxSetContextNoMatrix (ctx
: TGxContext
); begin gxSetContextInternal(ctx
, 1, false); end;
287 // ////////////////////////////////////////////////////////////////////////// //
289 TScissorSave
= record
292 scxywh
: packed array[0..3] of GLint
;
297 procedure save (enableScissoring
: Boolean);
298 procedure restore ();
300 // set new scissor rect, bounded by the saved scissor rect
301 procedure combineRect (x
, y
, w
, h
: Integer);
305 procedure TScissorSave
.save (enableScissoring
: Boolean);
307 wassc
:= (glIsEnabled(GL_SCISSOR_TEST
) <> 0);
308 if wassc
then glGetIntegerv(GL_SCISSOR_BOX
, @scxywh
[0]) else glGetIntegerv(GL_VIEWPORT
, @scxywh
[0]);
309 //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
310 if enableScissoring
and (not wassc
) then glEnable(GL_SCISSOR_TEST
);
313 procedure TScissorSave
.restore ();
315 glScissor(scxywh
[0], scxywh
[1], scxywh
[2], scxywh
[3]);
316 if wassc
then glEnable(GL_SCISSOR_TEST
) else glDisable(GL_SCISSOR_TEST
);
319 procedure TScissorSave
.combineRect (x
, y
, w
, h
: Integer);
320 //var ox, oy, ow, oh: Integer;
322 if (w
< 1) or (h
< 1) then begin glScissor(0, 0, 0, 0); exit
; end;
323 y
:= fuiScrHgt
-(y
+h
);
324 //ox := x; oy := y; ow := w; oh := h;
325 if not intersectRect(x
, y
, w
, h
, scxywh
[0], scxywh
[1], scxywh
[2], scxywh
[3]) then
327 //writeln('oops: COMBINE: old=(', ox, ',', oy, ')-(', ox+ow-1, ',', oy+oh-1, '); sci: (', scxywh[0], ',', scxywh[1], ')-(', scxywh[0]+scxywh[2]-1, ',', scxywh[1]+scxywh[3]-1, ')');
328 //writeln('oops: COMBINE: oldx=<', ox, '-', ox+ow-1, '>; oldy=<', oy, ',', oy+oh-1, '> : scix=<', scxywh[0], '-', scxywh[0]+scxywh[2]-1, '>; sciy=<', scxywh[1], '-', scxywh[1]+scxywh[3]-1, '>');
329 glScissor(0, 0, 0, 0);
333 glScissor(x
, y
, w
, h
);
338 // ////////////////////////////////////////////////////////////////////////// //
339 {$INCLUDE fui_gfx_gl_fonts.inc}
342 TGxBmpFont
= class(TGxFont
)
344 mTexId
: GLuint
; // OpenGL texture id
345 mWidth
: Integer; // <=0: proportional
348 mFreeFontWdt
: Boolean;
351 procedure oglCreateTexture ();
352 procedure oglDestroyTexture ();
354 function drawTextInternal (x
, y
: Integer; const s
: AnsiString): Integer; // return width (not including last empty pixel)
357 constructor Create (const aname
: AnsiString; awdt
, ahgt
: Integer; const afont
: PByte; const awdtable
: PByte=nil);
358 destructor Destroy (); override;
360 function charWidth (const ch
: AnsiChar): Integer; override;
361 function textWidth (const s
: AnsiString): Integer; override;
365 constructor TGxBmpFont
.Create (const aname
: AnsiString; awdt
, ahgt
: Integer; const afont
: PByte; const awdtable
: PByte=nil);
369 if (afont
= nil) then raise Exception
.Create('internal error in font creation');
370 if (ahgt
< 1) then raise Exception
.Create('internal error in font creation');
373 //if (awdtable <> nil) then raise Exception.Create('internal error in font creation');
374 mFreeFontWdt
:= true;
375 // create width table
376 GetMem(mFontWdt
, 256);
377 for c
:= 0 to 255 do mFontWdt
[c
] := awdt
-1;
381 if (awdtable
= nil) then raise Exception
.Create('internal error in font creation');
383 mFontWdt
:= awdtable
;
388 mBaseLine
:= ahgt
-1; //FIXME
394 destructor TGxBmpFont
.Destroy ();
396 if (mFreeFontWdt
) and (mFontWdt
<> nil) then FreeMem(mFontWdt
);
403 mFreeFontWdt
:= false;
409 procedure TGxBmpFont
.oglCreateTexture ();
411 mTexId
:= createFontTexture(mFontBmp
, mFontWdt
, (mWidth
<= 0));
415 procedure TGxBmpFont
.oglDestroyTexture ();
417 if (mTexId
<> 0) then
419 glDeleteTextures(1, @mTexId
);
425 function TGxBmpFont
.charWidth (const ch
: AnsiChar): Integer;
427 result
:= (mFontWdt
[Byte(ch
)] and $0f);
431 function TGxBmpFont
.textWidth (const s
: AnsiString): Integer;
435 if (Length(s
) > 0) then
438 for ch
in s
do result
+= (mFontWdt
[Byte(ch
)] and $0f)+1;
447 // return width (not including last empty pixel)
448 function TGxBmpFont
.drawTextInternal (x
, y
: Integer; const s
: AnsiString): Integer;
453 if (Length(s
) = 0) then begin result
:= 0; exit
; end;
457 glEnable(GL_ALPHA_TEST
);
458 glAlphaFunc(GL_NOTEQUAL
, 0.0);
459 glEnable(GL_TEXTURE_2D
);
460 glBindTexture(GL_TEXTURE_2D
, mTexId
);
464 tx
:= (Integer(ch
) mod 16)*8;
465 ty
:= (Integer(ch
) div 16)*8;
467 glTexCoord2f((tx
+0)/128.0, (ty
+0)/128.0); glVertex2i(x
+0, y
+0); // top-left
468 glTexCoord2f((tx
+8)/128.0, (ty
+0)/128.0); glVertex2i(x
+8, y
+0); // top-right
469 glTexCoord2f((tx
+8)/128.0, (ty
+8)/128.0); glVertex2i(x
+8, y
+8); // bottom-right
470 glTexCoord2f((tx
+0)/128.0, (ty
+8)/128.0); glVertex2i(x
+0, y
+8); // bottom-left
472 x
+= (mFontWdt
[Byte(ch
)] and $0f)+1;
473 result
+= (mFontWdt
[Byte(ch
)] and $0f)+1;
476 glDisable(GL_ALPHA_TEST
);
477 glDisable(GL_TEXTURE_2D
);
478 glBindTexture(GL_TEXTURE_2D
, 0);
482 // ////////////////////////////////////////////////////////////////////////// //
484 fontList
: array of TGxBmpFont
= nil;
485 defaultFontName
: AnsiString = 'dos';
488 function strEquCI (const s0
, s1
: AnsiString): Boolean;
493 result
:= (Length(s0
) = Length(s1
));
496 for f
:= 1 to Length(s0
) do
499 if (c0
>= 'a') and (c0
<= 'z') then Dec(c0
, 32); // poor man's `toupper()`
501 if (c1
>= 'a') and (c1
<= 'z') then Dec(c1
, 32); // poor man's `toupper()`
502 if (c0
<> c1
) then begin result
:= false; exit
; end;
508 function getFontByName (const aname
: AnsiString): TGxBmpFont
;
513 if (Length(fontList
) = 0) then raise Exception
.Create('font subsystem not initialized');
514 if (Length(aname
) = 0) or (strEquCI(aname
, 'default')) then fname
:= defaultFontName
else fname
:= aname
;
515 for f
:= 0 to High(fontList
) do
517 result
:= fontList
[f
];
518 if (result
= nil) then continue
;
519 if (strEquCI(result
.name
, fname
)) then exit
;
521 if (fontList
[0] = nil) then raise Exception
.Create('font subsystem not properly initialized');
522 result
:= fontList
[0];
526 procedure deleteFonts ();
530 for f
:= 0 to High(fontList
) do freeAndNil(fontList
[f
]);
535 procedure createFonts ();
538 SetLength(fontList
, 4);
539 fontList
[0] := TGxBmpFont
.Create('dos', 8, 8, @kgiFont8
[0], @kgiFont8PropWidth
[0]);
540 fontList
[1] := TGxBmpFont
.Create('dos-prop', 0, 8, @kgiFont8
[0], @kgiFont8PropWidth
[0]);
541 fontList
[2] := TGxBmpFont
.Create('msx', 6, 8, @kgiFont6
[0], @kgiFont6PropWidth
[0]);
542 fontList
[3] := TGxBmpFont
.Create('msx-prop', 0, 8, @kgiFont6
[0], @kgiFont6PropWidth
[0]);
546 procedure oglInitFonts ();
550 for f
:= 0 to High(fontList
) do if (fontList
[f
] <> nil) then fontList
[f
].oglCreateTexture();
554 procedure oglDeinitFonts ();
558 for f
:= 0 to High(fontList
) do if (fontList
[f
] <> nil) then fontList
[f
].oglDestroyTexture();
562 // ////////////////////////////////////////////////////////////////////////// //
563 procedure oglSetup2DState ();
566 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
567 glDisable(GL_LINE_SMOOTH
);
568 glDisable(GL_POLYGON_SMOOTH
);
569 glDisable(GL_POINT_SMOOTH
);
570 glDisable(GL_DEPTH_TEST
);
571 glDisable(GL_TEXTURE_2D
);
572 glDisable(GL_LIGHTING
);
573 glDisable(GL_DITHER
);
574 glDisable(GL_STENCIL_TEST
);
575 glDisable(GL_SCISSOR_TEST
);
576 glDisable(GL_CULL_FACE
);
577 glDisable(GL_ALPHA_TEST
);
579 glClearColor(0, 0, 0, 0);
580 glColor4f(1, 1, 1, 1);
584 procedure oglSetup2D (winWidth
, winHeight
: Integer; upsideDown
: Boolean=false);
586 glViewport(0, 0, winWidth
, winHeight
);
590 glMatrixMode(GL_TEXTURE
);
593 glMatrixMode(GL_COLOR
);
596 glMatrixMode(GL_PROJECTION
);
600 glOrtho(0, winWidth
, 0, winHeight
, -1, 1); // set origin to bottom left
604 glOrtho(0, winWidth
, winHeight
, 0, -1, 1); // set origin to top left
607 glMatrixMode(GL_MODELVIEW
);
612 // ////////////////////////////////////////////////////////////////////////// //
613 {$INCLUDE fui_gfx_gl_cursor.inc}
615 procedure oglDrawCursor (); begin oglDrawCursorAt(fuiMouseX
, fuiMouseY
); end;
618 // ////////////////////////////////////////////////////////////////////////// //
619 constructor TGxContext
.Create ();
622 mColor
:= TGxRGBA
.Create(255, 255, 255);
623 mFont
:= getFontByName('default');
626 mClipRect
:= TGxRect
.Create(0, 0, 8192, 8192);
627 mClipOfs
:= TGxOfs
.Create(0, 0);
631 destructor TGxContext
.Destroy ();
633 if (mActive
) then gxSetContext(nil);
638 function TGxContext
.getFont (): AnsiString;
640 result
:= mFont
.name
;
643 procedure TGxContext
.setFont (const aname
: AnsiString);
645 mFont
:= getFontByName(aname
);
649 procedure TGxContext
.onActivate ();
651 setupGLColor(mColor
);
655 procedure TGxContext
.onDeactivate ();
660 procedure TGxContext
.setColor (const clr
: TGxRGBA
);
663 if (mActive
) then setupGLColor(mColor
);
667 procedure TGxContext
.realizeClip ();
669 sx
, sy
, sw
, sh
: Integer;
671 if (not mActive
) then exit
; // just in case
672 if (mClipRect
.w
<= 0) or (mClipRect
.h
<= 0) then
674 glEnable(GL_SCISSOR_TEST
);
675 glScissor(0, 0, 0, 0);
681 sx
:= trunc(mClipRect
.x
*mScale
);
682 sy
:= trunc(mClipRect
.y
*mScale
);
683 sw
:= trunc(mClipRect
.w
*mScale
);
684 sh
:= trunc(mClipRect
.h
*mScale
);
693 if (not intersectRect(sx
, sy
, sw
, sh
, 0, 0, fuiScrWdt
, fuiScrHgt
)) then
695 glEnable(GL_SCISSOR_TEST
);
696 glScissor(0, 0, 0, 0);
698 else if (sx
= 0) and (sy
= 0) and (sw
= fuiScrWdt
) and (sh
= fuiScrHgt
) then
700 glDisable(GL_SCISSOR_TEST
);
704 glEnable(GL_SCISSOR_TEST
);
705 sy
:= fuiScrHgt
-(sy
+sh
);
706 glScissor(sx
, sy
, sw
, sh
);
712 procedure TGxContext
.resetClip ();
714 mClipRect
:= TGxRect
.Create(0, 0, 8192, 8192);
715 if (mActive
) then realizeClip();
719 procedure TGxContext
.setClipOfs (const aofs
: TGxOfs
);
725 procedure TGxContext
.setClipRect (const aclip
: TGxRect
);
728 if (mActive
) then realizeClip();
732 function TGxContext
.setOffset (constref aofs
: TGxOfs
): TGxOfs
;
739 function TGxContext
.setClip (constref aclip
: TGxRect
): TGxRect
;
743 if (mActive
) then realizeClip();
747 function TGxContext
.combineClip (constref aclip
: TGxRect
): TGxRect
;
750 mClipRect
.intersect(aclip
);
751 if (mActive
) then realizeClip();
755 procedure TGxContext
.line (x1
, y1
, x2
, y2
: Integer);
757 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
759 if (not mScaled
) then
763 glVertex2f(x1
+0.375, y1
+0.375);
764 glVertex2f(x2
+0.375, y2
+0.375);
767 if (x1
<> x2
) or (y1
<> y2
) then
771 glVertex2f(x2
+0.375, y2
+0.375);
783 glVertex2i(x2
+1, y2
+1);
789 procedure TGxContext
.hline (x
, y
, len
: Integer);
791 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
792 if (len
< 1) then exit
;
793 if (not mScaled
) then
797 glVertex2f(x
+0.375, y
+0.375);
798 glVertex2f(x
+len
+0.375, y
+0.375);
801 else if (mScale
> 1.0) then
805 glVertex2i(x
+len
, y
);
806 glVertex2i(x
+len
, y
+1);
814 while (len
> 0) do begin glVertex2i(x
, y
); Inc(x
); Dec(len
); end;
820 procedure TGxContext
.vline (x
, y
, len
: Integer);
822 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
823 if (len
< 1) then exit
;
824 if (not mScaled
) then
828 glVertex2f(x
+0.375, y
+0.375);
829 glVertex2f(x
+0.375, y
+len
+0.375);
832 else if (mScale
> 1.0) then
836 glVertex2i(x
, y
+len
);
837 glVertex2i(x
+1, y
+len
);
845 while (len
> 0) do begin glVertex2i(x
, y
); Inc(y
); Dec(len
); end;
851 procedure TGxContext
.rect (x
, y
, w
, h
: Integer);
853 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
854 if (w
< 0) or (h
< 0) then exit
;
855 if (w
= 1) and (h
= 1) then
859 if mScaled
then glVertex2i(x
, y
) else glVertex2f(x
+0.375, y
+0.375);
864 if (not mScaled
) then
868 glVertex2i(x
, y
); glVertex2i(x
+w
, y
); // top
869 glVertex2i(x
, y
+h
-1); glVertex2i(x
+w
, y
+h
-1); // bottom
870 glVertex2f(x
+0.375, y
+1); glVertex2f(x
+0.375, y
+h
-1); // left
871 glVertex2f(x
+w
-1+0.375, y
+1); glVertex2f(x
+w
-1+0.375, y
+h
-1); // right
879 vline(x
+w
-1, y
+1, h
-2);
885 procedure TGxContext
.fillRect (x
, y
, w
, h
: Integer);
887 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
888 if (w
< 0) or (h
< 0) then exit
;
892 glVertex2f(x
+w
, y
+h
);
898 procedure TGxContext
.darkenRect (x
, y
, w
, h
: Integer; a
: Integer);
900 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (a
>= 255) then exit
;
901 if (w
< 0) or (h
< 0) then exit
;
902 if (a
< 0) then a
:= 0;
904 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
905 glColor4f(0.0, 0.0, 0.0, a
/255.0);
909 glVertex2i(x
+w
, y
+h
);
912 setupGLColor(mColor
);
916 function TGxContext
.charWidth (const ch
: AnsiChar): Integer;
918 result
:= mFont
.charWidth(ch
);
921 function TGxContext
.charHeight (const ch
: AnsiChar): Integer;
923 result
:= mFont
.height
;
927 function TGxContext
.textWidth (const s
: AnsiString): Integer;
929 result
:= mFont
.textWidth(s
);
932 function TGxContext
.textHeight (const s
: AnsiString): Integer;
934 result
:= mFont
.height
;
938 function TGxContext
.drawChar (x
, y
: Integer; const ch
: AnsiChar): Integer; // returns char width
940 result
:= mFont
.charWidth(ch
);
941 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
942 TGxBmpFont(mFont
).drawTextInternal(x
, y
, ch
);
945 function TGxContext
.drawText (x
, y
: Integer; const s
: AnsiString): Integer; // returns text width
947 result
:= mFont
.textWidth(s
);
948 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) or (Length(s
) = 0) then exit
;
949 TGxBmpFont(mFont
).drawTextInternal(x
, y
, s
);
953 function TGxContext
.iconMarkWidth (ic
: TMarkIcon
): Integer; begin result
:= 11; end;
954 function TGxContext
.iconMarkHeight (ic
: TMarkIcon
): Integer; begin result
:= 8; end;
956 procedure TGxContext
.drawIconMark (ic
: TMarkIcon
; x
, y
: Integer; marked
: Boolean);
960 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
961 if (ic
= TMarkIcon
.Checkbox
) then
979 if (not marked
) then exit
;
985 vline(x
+3+f
, y
+1+f
, 1);
986 vline(x
+7-f
, y
+1+f
, 1);
1001 function TGxContext
.iconWinWidth (ic
: TWinIcon
): Integer; begin result
:= 9; end;
1002 function TGxContext
.iconWinHeight (ic
: TWinIcon
): Integer; begin result
:= 8; end;
1004 procedure TGxContext
.drawIconWin (ic
: TWinIcon
; x
, y
: Integer; pressed
: Boolean);
1008 if (not mActive
) or (mClipRect
.w
< 1) or (mClipRect
.h
< 1) or (mColor
.a
= 0) then exit
;
1009 if pressed
then rect(x
, y
, 9, 8);
1012 vline(x
+1+f
, y
+f
, 1);
1013 vline(x
+1+6-f
, y
+f
, 1);
1018 procedure TGxContext
.glSetScale (ascale
: Single);
1020 if (ascale
< 0.01) then ascale
:= 0.01;
1022 glScalef(ascale
, ascale
, 1.0);
1024 mScaled
:= (ascale
<> 1.0);
1027 procedure TGxContext
.glSetTrans (ax
, ay
: Single);
1030 glScalef(mScale
, mScale
, 1.0);
1031 glTranslatef(ax
, ay
, 0);
1035 procedure TGxContext
.glSetScaleTrans (ascale
, ax
, ay
: Single);
1038 glTranslatef(ax
, ay
, 0);
1042 // ////////////////////////////////////////////////////////////////////////// //
1044 procedure oglRestoreMode (doClear: Boolean);
1046 oglSetup2D(fuiScrWdt, fuiScrHgt);
1047 glScissor(0, 0, fuiScrWdt, fuiScrHgt);
1049 glBindTexture(GL_TEXTURE_2D, 0);
1050 glDisable(GL_BLEND);
1051 glDisable(GL_TEXTURE_2D);
1052 glDisable(GL_STENCIL_TEST);
1053 glDisable(GL_SCISSOR_TEST);
1054 glDisable(GL_LIGHTING);
1055 glDisable(GL_DEPTH_TEST);
1056 glDisable(GL_CULL_FACE);
1057 glDisable(GL_LINE_SMOOTH);
1058 glDisable(GL_POINT_SMOOTH);
1061 glColor4f(1, 1, 1, 1);
1065 glClearColor(0, 0, 0, 0);
1066 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_ACCUM_BUFFER_BIT or GL_STENCIL_BUFFER_BIT);
1070 glMatrixMode(GL_MODELVIEW);
1072 //glScalef(4, 4, 1);
1077 //procedure onWinFocus (); begin end;
1078 //procedure onWinBlur (); begin fuiResetKMState(true); end;
1080 //procedure onPreRender (); begin oglRestoreMode(gGfxDoClear); end;
1081 procedure onPostRender (); begin oglDrawCursor(); end;
1083 procedure onInit ();
1085 //oglSetup2D(fuiScrWdt, fuiScrHgt);
1086 createCursorTexture();
1090 procedure onDeinit ();
1092 fuiResetKMState(false);
1093 if (curtexid
<> 0) then glDeleteTextures(1, @curtexid
);
1103 // ////////////////////////////////////////////////////////////////////////// //
1105 savedGLState
:= TSavedGLState
.Create(false);
1107 //winFocusCB := onWinFocus;
1108 //winBlurCB := onWinBlur;
1109 //prerenderFrameCB := onPreRender;
1110 postrenderFrameCB
:= onPostRender
;
1111 oglInitCB
:= onInit
;
1112 oglDeinitCB
:= onDeinit
;