DEADSOFTWARE

net: implemented (half-assed) download resuming
[d2df-sdl.git] / 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, version 3 of the License ONLY.
7 *
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.
12 *
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/>.
15 *)
16 {$INCLUDE ../shared/a_modes.inc}
17 {$DEFINE FUI_TEXT_ICONS}
18 unit fui_gfx_gl;
20 interface
22 uses
23 {$INCLUDE ../nogl/noGLuses.inc}
24 SysUtils, Classes,
25 SDL2,
26 sdlcarcass,
27 fui_common, fui_events;
30 // ////////////////////////////////////////////////////////////////////////// //
31 type
32 TGxFont = class
33 protected
34 mName: AnsiString;
35 mHeight: Integer;
36 mBaseLine: Integer;
38 public
39 function charWidth (const ch: AnsiChar): Integer; virtual; abstract;
40 function textWidth (const s: AnsiString): Integer; virtual; abstract;
42 public
43 property name: AnsiString read mName;
44 property height: Integer read mHeight;
45 property baseLine: Integer read mBaseLine;
46 end;
48 TGxContext = class
49 public
50 type
51 TMarkIcon = (
52 Checkbox,
53 Radiobox
54 );
56 type
57 TWinIcon = (
58 Close
59 );
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;
71 protected
72 function getFont (): AnsiString;
73 procedure setFont (const aname: AnsiString);
75 procedure onActivate ();
76 procedure onDeactivate ();
78 procedure setColor (const clr: TGxRGBA);
80 procedure realizeClip (); // setup scissoring
82 procedure setClipOfs (const aofs: TGxOfs);
83 procedure setClipRect (const aclip: TGxRect);
85 public
86 constructor Create ();
87 destructor Destroy (); override;
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);
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
103 function iconMarkWidth (ic: TMarkIcon): Integer;
104 function iconMarkHeight (ic: TMarkIcon): Integer;
105 procedure drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean);
107 function iconWinWidth (ic: TWinIcon): Integer;
108 function iconWinHeight (ic: TWinIcon): Integer;
109 procedure drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean);
111 procedure resetClip ();
113 function setOffset (constref aofs: TGxOfs): TGxOfs; // returns previous offset
114 function setClip (constref aclip: TGxRect): TGxRect; // returns previous clip
116 function combineClip (constref aclip: TGxRect): TGxRect; // returns previous clip
118 // vertical scrollbar
119 procedure drawVSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
120 // horizontal scrollbar
121 procedure drawHSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
123 class function sbarFilled (wh: Integer; cur, min, max: Integer): Integer;
124 class function sbarPos (cxy: Integer; xy, wh: Integer; min, max: Integer): Integer;
126 public //HACK!
127 procedure glSetScale (ascale: Single);
128 procedure glSetTrans (ax, ay: Single);
129 procedure glSetScaleTrans (ascale, ax, ay: Single);
131 public
132 property active: Boolean read mActive;
133 property color: TGxRGBA read mColor write setColor;
134 property font: AnsiString read getFont write setFont;
135 property offset: TGxOfs read mClipOfs write setClipOfs;
136 property clip: TGxRect read mClipRect write setClipRect; // clipping is unaffected by offset
137 end;
140 // set active context; `ctx` can be `nil`
141 procedure gxSetContext (ctx: TGxContext; ascale: Single=1.0);
142 procedure gxSetContextNoMatrix (ctx: TGxContext);
145 // setup 2D OpenGL mode; will be called automatically in `glInit()`
146 procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
147 procedure oglSetup2DState (); // don't modify viewports and matrices
149 procedure oglDrawCursor ();
150 procedure oglDrawCursorAt (msX, msY: Integer);
153 procedure fuiGfxLoadFont (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean=false);
154 procedure fuiGfxLoadFont (const fontname: AnsiString; st: TStream; proportional: Boolean=false);
157 // ////////////////////////////////////////////////////////////////////////// //
158 var
159 gGfxDoClear: Boolean = true;
162 implementation
164 uses
165 fui_wadread,
166 utils;
169 // ////////////////////////////////////////////////////////////////////////// //
170 // returns `false` if the color is transparent
171 // returns `false` if the color is transparent
172 function setupGLColor (constref clr: TGxRGBA): Boolean;
173 begin
174 if (clr.a < 255) then
175 begin
176 glEnable(GL_BLEND);
177 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
178 end
179 else
180 begin
181 glDisable(GL_BLEND);
182 end;
183 glColor4ub(clr.r, clr.g, clr.b, clr.a);
184 result := (clr.a <> 0);
185 end;
187 function isScaled (): Boolean;
188 var
189 mt: packed array [0..15] of GLfloat;
190 begin
191 glGetFloatv(GL_MODELVIEW_MATRIX, @mt[0]);
192 result := (mt[0] <> 1.0) or (mt[1*4+1] <> 1.0);
193 end;
196 // ////////////////////////////////////////////////////////////////////////// //
197 //TODO: OpenGL framebuffers and shaders state
198 type
199 TSavedGLState = record
200 public
201 glmatmode: GLint;
202 gltextbinding: GLint;
203 //oldprg: GLint;
204 //oldfbr, oldfbw: GLint;
205 glvport: packed array [0..3] of GLint;
206 saved: Boolean;
208 public
209 constructor Create (dosave: Boolean);
210 procedure save ();
211 procedure restore ();
212 end;
214 constructor TSavedGLState.Create (dosave: Boolean);
215 begin
216 FillChar(self, sizeof(self), 0);
217 if (dosave) then save();
218 end;
220 procedure TSavedGLState.save ();
221 begin
222 if (saved) then raise Exception.Create('cannot save into already saved OpenGL state');
223 glGetIntegerv(GL_MATRIX_MODE, @glmatmode);
224 glGetIntegerv(GL_TEXTURE_BINDING_2D, @gltextbinding);
225 glGetIntegerv(GL_VIEWPORT, @glvport[0]);
226 //glGetIntegerv(GL_CURRENT_PROGRAM, &oldprg);
227 //glGetIntegerv(GL_READ_FRAMEBUFFER_BINDING, &oldfbr);
228 //glGetIntegerv(GL_DRAW_FRAMEBUFFER_BINDING, &oldfbw);
229 glMatrixMode(GL_PROJECTION); glPushMatrix();
230 glMatrixMode(GL_MODELVIEW); glPushMatrix();
231 glMatrixMode(GL_TEXTURE); glPushMatrix();
232 glMatrixMode(GL_COLOR); glPushMatrix();
233 glPushAttrib({GL_ENABLE_BIT|GL_COLOR_BUFFER_BIT|GL_CURRENT_BIT}GL_ALL_ATTRIB_BITS); // let's play safe
234 saved := true;
235 end;
237 procedure TSavedGLState.restore ();
238 begin
239 if (not saved) then raise Exception.Create('cannot restore unsaved OpenGL state');
240 glPopAttrib({GL_ENABLE_BIT});
241 glMatrixMode(GL_PROJECTION); glPopMatrix();
242 glMatrixMode(GL_MODELVIEW); glPopMatrix();
243 glMatrixMode(GL_TEXTURE); glPopMatrix();
244 glMatrixMode(GL_COLOR); glPopMatrix();
245 glMatrixMode(glmatmode);
246 //if (glHasFunc!"glBindFramebufferEXT") glBindFramebufferEXT(GL_READ_FRAMEBUFFER_EXT, oldfbr);
247 //if (glHasFunc!"glBindFramebufferEXT") glBindFramebufferEXT(GL_DRAW_FRAMEBUFFER_EXT, oldfbw);
248 glBindTexture(GL_TEXTURE_2D, gltextbinding);
249 //if (glHasFunc!"glUseProgram") glUseProgram(oldprg);
250 glViewport(glvport[0], glvport[1], glvport[2], glvport[3]);
251 saved := false;
252 end;
255 var
256 curCtx: TGxContext = nil;
257 savedGLState: TSavedGLState;
260 // ////////////////////////////////////////////////////////////////////////// //
261 // set active context; `ctx` can be `nil`
262 procedure gxSetContextInternal (ctx: TGxContext; ascale: Single; domatrix: Boolean);
263 var
264 mt: packed array [0..15] of GLfloat;
265 begin
266 if (savedGLState.saved) then savedGLState.restore();
268 if (curCtx <> nil) then
269 begin
270 curCtx.onDeactivate();
271 curCtx.mActive := false;
272 end;
274 curCtx := ctx;
275 if (ctx <> nil) then
276 begin
277 ctx.mActive := true;
278 savedGLState.save();
279 if (domatrix) then
280 begin
281 oglSetup2D(fuiScrWdt, fuiScrHgt);
282 glScalef(ascale, ascale, 1.0);
283 ctx.mScaled := (ascale <> 1.0);
284 ctx.mScale := ascale;
285 end
286 else
287 begin
288 // assume uniform scale
289 glGetFloatv(GL_MODELVIEW_MATRIX, @mt[0]);
290 ctx.mScaled := (mt[0] <> 1.0) or (mt[1*4+1] <> 1.0);
291 ctx.mScale := mt[0];
292 oglSetup2DState();
293 end;
294 ctx.onActivate();
295 end;
296 end;
299 procedure gxSetContext (ctx: TGxContext; ascale: Single=1.0); begin gxSetContextInternal(ctx, ascale, true); end;
300 procedure gxSetContextNoMatrix (ctx: TGxContext); begin gxSetContextInternal(ctx, 1, false); end;
303 // ////////////////////////////////////////////////////////////////////////// //
304 type
305 TScissorSave = record
306 public
307 wassc: Boolean;
308 scxywh: packed array[0..3] of GLint;
310 public
312 public
313 procedure save (enableScissoring: Boolean);
314 procedure restore ();
316 // set new scissor rect, bounded by the saved scissor rect
317 procedure combineRect (x, y, w, h: Integer);
318 end;
321 procedure TScissorSave.save (enableScissoring: Boolean);
322 begin
323 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
324 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
325 //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
326 if enableScissoring and (not wassc) then glEnable(GL_SCISSOR_TEST);
327 end;
329 procedure TScissorSave.restore ();
330 begin
331 glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]);
332 if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
333 end;
335 procedure TScissorSave.combineRect (x, y, w, h: Integer);
336 //var ox, oy, ow, oh: Integer;
337 begin
338 if (w < 1) or (h < 1) then begin glScissor(0, 0, 0, 0); exit; end;
339 y := fuiScrHgt-(y+h);
340 //ox := x; oy := y; ow := w; oh := h;
341 if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then
342 begin
343 //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, ')');
344 //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, '>');
345 glScissor(0, 0, 0, 0);
346 end
347 else
348 begin
349 glScissor(x, y, w, h);
350 end;
351 end;
354 // ////////////////////////////////////////////////////////////////////////// //
355 type
356 TGxBmpFont = class(TGxFont)
357 private
358 mTexId: GLuint; // OpenGL texture id
359 mWidth: Integer; // <=0: proportional
360 mFontBmp: PByte;
361 mFontWdt: PByte;
362 mFreeFontWdt: Boolean;
363 mFreeFontBmp: Boolean;
365 protected
366 procedure oglCreateTexture ();
367 procedure oglDestroyTexture ();
369 procedure initDrawText ();
370 procedure doneDrawText ();
371 function drawCharInterim (x, y: Integer; const ch: AnsiChar): Integer; // return width (not including last empty pixel)
372 function drawCharInternal (x, y: Integer; const ch: AnsiChar): Integer; // return width (not including last empty pixel)
373 function drawTextInternal (x, y: Integer; const s: AnsiString): Integer; // return width (not including last empty pixel)
375 public
376 constructor Create (const aname: AnsiString; st: TStream; proportional: Boolean);
377 destructor Destroy (); override;
379 function charWidth (const ch: AnsiChar): Integer; override;
380 function textWidth (const s: AnsiString): Integer; override;
381 end;
384 constructor TGxBmpFont.Create (const aname: AnsiString; st: TStream; proportional: Boolean);
385 var
386 sign: packed array [0..7] of AnsiChar;
387 enc: packed array [0..16] of AnsiChar;
388 b: Byte;
389 wdt, hgt, elen: Integer;
390 ch, dy: Integer;
391 fntbwdt: Integer;
392 wrd: Word;
393 begin
394 mFreeFontBmp := true;
395 mFreeFontWdt := true;
396 mName := aname;
397 mTexId := 0;
398 // signature
399 st.ReadBuffer(sign[0], 8);
400 if (sign <> 'FUIFONT0') then raise Exception.Create('FlexUI: invalid font file signature');
401 // encoding length and width
402 st.ReadBuffer(b, 1);
403 wdt := (b and $0f)+1; // 16 is not supported
404 if (wdt = 16) then raise Exception.Create('FlexUI: 16-wdt fonts aren''t supported yet');
405 elen := ((b shr 4) and $0f);
406 if (elen = 0) then raise Exception.CreateFmt('FlexUI: invalid font encoding length: %d', [elen]);
407 // height
408 st.ReadBuffer(b, 1);
409 hgt := b;
410 if (hgt < 2) then raise Exception.CreateFmt('FlexUI: invalid font height: %d', [hgt]);
411 // encoding
412 st.ReadBuffer(enc[0], elen);
413 // check for 'cp1251' here (it can also be 'koi8')
414 if (wdt <= 8) then fntbwdt := 1 else fntbwdt := 2;
415 // shift and width table (hi nibble: left shift for proportional print; lo nibble: shifted character width for proportional print)
416 GetMem(mFontWdt, 256);
417 st.ReadBuffer(mFontWdt^, 256);
418 // font bitmap
419 GetMem(mFontBmp, (hgt*fntbwdt)*256);
420 st.ReadBuffer(mFontBmp^, (hgt*fntbwdt)*256);
421 mWidth := wdt;
422 mHeight := hgt;
423 mBaseLine := hgt-1; //FIXME
424 if (proportional) then
425 begin
426 // shift font
427 for ch := 0 to 255 do
428 begin
429 for dy := 0 to hgt-1 do
430 begin
431 if (fntbwdt = 1) then
432 begin
433 mFontBmp[ch*hgt+dy] := mFontBmp[ch*hgt+dy] shl (mFontWdt[ch] shr 4);
434 end
435 else
436 begin
437 wrd := mFontBmp[ch*(hgt*2)+(dy*2)]+256*mFontBmp[ch*(hgt*2)+(dy*2)+1];
438 wrd := wrd shl (mFontWdt[ch] shr 4);
439 mFontBmp[ch*(hgt*2)+(dy*2)+0] := (wrd and $ff);
440 mFontBmp[ch*(hgt*2)+(dy*2)+1] := ((wrd shr 16) and $ff);
441 end;
442 end;
443 end;
444 end
445 else
446 begin
447 FillChar(mFontWdt^, 256, wdt);
448 end;
449 end;
452 destructor TGxBmpFont.Destroy ();
453 begin
454 if (mFreeFontBmp) and (mFontBmp <> nil) then FreeMem(mFontBmp);
455 if (mFreeFontWdt) and (mFontWdt <> nil) then FreeMem(mFontWdt);
456 mName := '';
457 mWidth := 0;
458 mHeight := 0;
459 mBaseLine := 0;
460 mFontBmp := nil;
461 mFontWdt := nil;
462 mFreeFontWdt := false;
463 mFreeFontBmp := false;
464 mTexId := 0;
465 inherited;
466 end;
469 procedure TGxBmpFont.oglCreateTexture ();
470 const
471 TxWidth = 16*16;
472 TxHeight = 16*16;
473 var
474 tex, tpp: PByte;
475 b: Byte;
476 cc: Integer;
477 x, y, dx, dy: Integer;
478 begin
479 GetMem(tex, TxWidth*TxHeight*4);
480 FillChar(tex^, TxWidth*TxHeight*4, 0);
482 for cc := 0 to 255 do
483 begin
484 x := (cc mod 16)*16;
485 y := (cc div 16)*16;
486 for dy := 0 to mHeight-1 do
487 begin
488 if (mWidth <= 8) then b := mFontBmp[cc*mHeight+dy] else b := mFontBmp[cc*(mHeight*2)+(dy*2)+1];
489 //if prop then b := b shl (fontwdt[cc] shr 4);
490 tpp := tex+((y+dy)*(TxWidth*4))+x*4;
491 for dx := 0 to 7 do
492 begin
493 if ((b and $80) <> 0) then
494 begin
495 tpp^ := 255; Inc(tpp);
496 tpp^ := 255; Inc(tpp);
497 tpp^ := 255; Inc(tpp);
498 tpp^ := 255; Inc(tpp);
499 end
500 else
501 begin
502 tpp^ := 0; Inc(tpp);
503 tpp^ := 0; Inc(tpp);
504 tpp^ := 0; Inc(tpp);
505 tpp^ := 0; Inc(tpp);
506 end;
507 b := (b and $7f) shl 1;
508 end;
509 if (mWidth > 8) then
510 begin
511 b := mFontBmp[cc*(mHeight*2)+(dy*2)+0];
512 for dx := 0 to 7 do
513 begin
514 if ((b and $80) <> 0) then
515 begin
516 tpp^ := 255; Inc(tpp);
517 tpp^ := 255; Inc(tpp);
518 tpp^ := 255; Inc(tpp);
519 tpp^ := 255; Inc(tpp);
520 end
521 else
522 begin
523 tpp^ := 0; Inc(tpp);
524 tpp^ := 0; Inc(tpp);
525 tpp^ := 0; Inc(tpp);
526 tpp^ := 0; Inc(tpp);
527 end;
528 b := (b and $7f) shl 1;
529 end;
530 end;
531 end;
532 end;
534 glGenTextures(1, @mTexId);
535 if (mTexId = 0) then raise Exception.Create('can''t create FlexUI font texture');
537 glBindTexture(GL_TEXTURE_2D, mTexId);
538 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
539 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
540 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
541 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
543 glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, TxWidth, TxHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, tex);
544 glFinish();
546 glBindTexture(GL_TEXTURE_2D, 0);
547 FreeMem(tex);
548 end;
551 procedure TGxBmpFont.oglDestroyTexture ();
552 begin
553 if (mTexId <> 0) then
554 begin
555 glDeleteTextures(1, @mTexId);
556 mTexId := 0;
557 end;
558 end;
561 function TGxBmpFont.charWidth (const ch: AnsiChar): Integer;
562 begin
563 result := (mFontWdt[Byte(ch)] and $0f);
564 end;
567 function TGxBmpFont.textWidth (const s: AnsiString): Integer;
568 var
569 ch: AnsiChar;
570 begin
571 if (Length(s) > 0) then
572 begin
573 result := -1;
574 for ch in s do result += (mFontWdt[Byte(ch)] and $0f)+1;
575 end
576 else
577 begin
578 result := 0;
579 end;
580 end;
583 procedure TGxBmpFont.initDrawText ();
584 begin
585 glEnable(GL_ALPHA_TEST);
586 glAlphaFunc(GL_NOTEQUAL, 0.0);
587 glEnable(GL_TEXTURE_2D);
588 glBindTexture(GL_TEXTURE_2D, mTexId);
589 end;
592 procedure TGxBmpFont.doneDrawText ();
593 begin
594 glDisable(GL_ALPHA_TEST);
595 glDisable(GL_TEXTURE_2D);
596 glBindTexture(GL_TEXTURE_2D, 0);
597 end;
600 function TGxBmpFont.drawCharInterim (x, y: Integer; const ch: AnsiChar): Integer;
601 var
602 tx, ty: Integer;
603 begin
604 tx := (Integer(ch) mod 16)*16;
605 ty := (Integer(ch) div 16)*16;
606 glBegin(GL_QUADS);
607 glTexCoord2f((tx+0)/256.0, (ty+0)/256.0); glVertex2i(x+0, y+0); // top-left
608 glTexCoord2f((tx+mWidth)/256.0, (ty+0)/256.0); glVertex2i(x+mWidth, y+0); // top-right
609 glTexCoord2f((tx+mWidth)/256.0, (ty+mHeight)/256.0); glVertex2i(x+mWidth, y+mHeight); // bottom-right
610 glTexCoord2f((tx+0)/256.0, (ty+mHeight)/256.0); glVertex2i(x+0, y+mHeight); // bottom-left
611 glEnd();
612 result := (mFontWdt[Byte(ch)] and $0f);
613 end;
616 function TGxBmpFont.drawCharInternal (x, y: Integer; const ch: AnsiChar): Integer;
617 begin
618 initDrawText();
619 result := drawCharInterim(x, y, ch);
620 doneDrawText();
621 end;
624 function TGxBmpFont.drawTextInternal (x, y: Integer; const s: AnsiString): Integer;
625 var
626 ch: AnsiChar;
627 wdt: Integer;
628 begin
629 if (Length(s) = 0) then begin result := 0; exit; end;
630 result := -1;
631 initDrawText();
632 for ch in s do
633 begin
634 wdt := drawCharInterim(x, y, ch)+1;
635 x += wdt;
636 result += wdt;
637 end;
638 doneDrawText();
639 end;
642 // ////////////////////////////////////////////////////////////////////////// //
643 var
644 fontList: array of TGxBmpFont = nil;
645 defaultFontName: AnsiString = 'win14';
648 function strEquCI (const s0, s1: AnsiString): Boolean;
649 var
650 f: Integer;
651 c0, c1: AnsiChar;
652 begin
653 result := (Length(s0) = Length(s1));
654 if (result) then
655 begin
656 for f := 1 to Length(s0) do
657 begin
658 c0 := s0[f];
659 if (c0 >= 'a') and (c0 <= 'z') then Dec(c0, 32); // poor man's `toupper()`
660 c1 := s1[f];
661 if (c1 >= 'a') and (c1 <= 'z') then Dec(c1, 32); // poor man's `toupper()`
662 if (c0 <> c1) then begin result := false; exit; end;
663 end;
664 end;
665 end;
668 function getFontByName (const aname: AnsiString): TGxBmpFont;
669 var
670 f: Integer;
671 fname: AnsiString;
672 begin
673 if (Length(fontList) = 0) then raise Exception.Create('font subsystem not initialized');
674 if (Length(aname) = 0) or (strEquCI(aname, 'default')) then fname := defaultFontName else fname := aname;
675 for f := 0 to High(fontList) do
676 begin
677 result := fontList[f];
678 if (result = nil) then continue;
679 if (strEquCI(result.name, fname)) then exit;
680 end;
681 if (fontList[0] = nil) then raise Exception.Create('font subsystem not properly initialized');
682 result := fontList[0];
683 end;
687 procedure deleteFonts ();
688 var
689 f: Integer;
690 begin
691 for f := 0 to High(fontList) do freeAndNil(fontList[f]);
692 fontList := nil;
693 end;
697 procedure fuiGfxLoadFont (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean=false);
698 var
699 st: TStream;
700 begin
701 if (Length(fontname) = 0) then raise Exception.Create('FlexUI: cannot load nameless font '''+fontFile+'''');
702 st := fuiOpenFile(fontFile);
703 if (st = nil) then raise Exception.Create('FlexUI: cannot load font '''+fontFile+'''');
704 try
705 fuiGfxLoadFont(fontname, st, proportional);
706 except on e: Exception do
707 begin
708 writeln('FlexUI font loadin error: ', e.message);
709 FreeAndNil(st);
710 raise Exception.Create('FlexUI: cannot load font '''+fontFile+'''');
711 end;
712 else
713 raise;
714 end;
715 FreeAndNil(st);
716 end;
719 procedure fuiGfxLoadFont (const fontname: AnsiString; st: TStream; proportional: Boolean=false);
720 var
721 fnt: TGxBmpFont = nil;
722 f: Integer;
723 begin
724 if (Length(fontname) = 0) then raise Exception.Create('FlexUI: cannot load nameless font');
725 fnt := TGxBmpFont.Create(fontname, st, proportional);
726 try
727 for f := 0 to High(fontList) do
728 begin
729 if (strEquCI(fontList[f].name, fontname)) then
730 begin
731 if (fontList[f].mTexId <> 0) then raise Exception.Create('FlexUI: cannot reload generated font named '''+fontname+'''');
732 FreeAndNil(fontList[f]);
733 fontList[f] := fnt;
734 exit;
735 end;
736 end;
737 SetLength(fontList, Length(fontList)+1);
738 fontList[High(fontList)] := fnt;
739 except
740 FreeAndNil(fnt);
741 raise;
742 end;
743 end;
746 procedure oglInitFonts ();
747 var
748 f: Integer;
749 begin
750 for f := 0 to High(fontList) do if (fontList[f] <> nil) then fontList[f].oglCreateTexture();
751 end;
754 procedure oglDeinitFonts ();
755 var
756 f: Integer;
757 begin
758 for f := 0 to High(fontList) do if (fontList[f] <> nil) then fontList[f].oglDestroyTexture();
759 end;
762 // ////////////////////////////////////////////////////////////////////////// //
763 procedure oglSetup2DState ();
764 begin
765 glDisable(GL_BLEND);
766 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
767 glDisable(GL_LINE_SMOOTH);
768 glDisable(GL_POLYGON_SMOOTH);
769 glDisable(GL_POINT_SMOOTH);
770 glDisable(GL_DEPTH_TEST);
771 glDisable(GL_TEXTURE_2D);
772 glDisable(GL_LIGHTING);
773 glDisable(GL_DITHER);
774 glDisable(GL_STENCIL_TEST);
775 glDisable(GL_SCISSOR_TEST);
776 glDisable(GL_CULL_FACE);
777 glDisable(GL_ALPHA_TEST);
779 glClearColor(0, 0, 0, 0);
780 glColor4f(1, 1, 1, 1);
781 end;
784 procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
785 begin
786 glViewport(0, 0, winWidth, winHeight);
788 oglSetup2DState();
790 glMatrixMode(GL_TEXTURE);
791 glLoadIdentity();
793 glMatrixMode(GL_COLOR);
794 glLoadIdentity();
796 glMatrixMode(GL_PROJECTION);
797 glLoadIdentity();
798 if (upsideDown) then
799 begin
800 glOrtho(0, winWidth, 0, winHeight, -1, 1); // set origin to bottom left
801 end
802 else
803 begin
804 glOrtho(0, winWidth, winHeight, 0, -1, 1); // set origin to top left
805 end;
807 glMatrixMode(GL_MODELVIEW);
808 glLoadIdentity();
809 end;
812 // ////////////////////////////////////////////////////////////////////////// //
813 {$INCLUDE fui_gfx_gl_cursor.inc}
815 procedure oglDrawCursor (); begin oglDrawCursorAt(fuiMouseX, fuiMouseY); end;
818 // ////////////////////////////////////////////////////////////////////////// //
819 constructor TGxContext.Create ();
820 begin
821 mActive := false;
822 mColor := TGxRGBA.Create(255, 255, 255);
823 mFont := getFontByName('default');
824 mScaled := false;
825 mScale := 1.0;
826 mClipRect := TGxRect.Create(0, 0, 8192, 8192);
827 mClipOfs := TGxOfs.Create(0, 0);
828 end;
831 destructor TGxContext.Destroy ();
832 begin
833 if (mActive) then gxSetContext(nil);
834 inherited;
835 end;
838 function TGxContext.getFont (): AnsiString;
839 begin
840 result := mFont.name;
841 end;
843 procedure TGxContext.setFont (const aname: AnsiString);
844 begin
845 mFont := getFontByName(aname);
846 end;
849 procedure TGxContext.onActivate ();
850 begin
851 setupGLColor(mColor);
852 realizeClip();
853 end;
855 procedure TGxContext.onDeactivate ();
856 begin
857 end;
860 procedure TGxContext.setColor (const clr: TGxRGBA);
861 begin
862 mColor := clr;
863 if (mActive) then setupGLColor(mColor);
864 end;
867 procedure TGxContext.realizeClip ();
868 var
869 sx, sy, sw, sh: Integer;
870 begin
871 if (not mActive) then exit; // just in case
872 if (mClipRect.w <= 0) or (mClipRect.h <= 0) then
873 begin
874 glEnable(GL_SCISSOR_TEST);
875 glScissor(0, 0, 0, 0);
876 end
877 else
878 begin
879 if (mScaled) then
880 begin
881 sx := trunc(mClipRect.x*mScale);
882 sy := trunc(mClipRect.y*mScale);
883 sw := trunc(mClipRect.w*mScale);
884 sh := trunc(mClipRect.h*mScale);
885 end
886 else
887 begin
888 sx := mClipRect.x;
889 sy := mClipRect.y;
890 sw := mClipRect.w;
891 sh := mClipRect.h;
892 end;
893 if (not intersectRect(sx, sy, sw, sh, 0, 0, fuiScrWdt, fuiScrHgt)) then
894 begin
895 glEnable(GL_SCISSOR_TEST);
896 glScissor(0, 0, 0, 0);
897 end
898 else if (sx = 0) and (sy = 0) and (sw = fuiScrWdt) and (sh = fuiScrHgt) then
899 begin
900 glDisable(GL_SCISSOR_TEST);
901 end
902 else
903 begin
904 glEnable(GL_SCISSOR_TEST);
905 sy := fuiScrHgt-(sy+sh);
906 glScissor(sx, sy, sw, sh);
907 end;
908 end;
909 end;
912 procedure TGxContext.resetClip ();
913 begin
914 mClipRect := TGxRect.Create(0, 0, 8192, 8192);
915 if (mActive) then realizeClip();
916 end;
919 procedure TGxContext.setClipOfs (const aofs: TGxOfs);
920 begin
921 mClipOfs := aofs;
922 end;
925 procedure TGxContext.setClipRect (const aclip: TGxRect);
926 begin
927 mClipRect := aclip;
928 if (mActive) then realizeClip();
929 end;
932 function TGxContext.setOffset (constref aofs: TGxOfs): TGxOfs;
933 begin
934 result := mClipOfs;
935 mClipOfs := aofs;
936 end;
939 function TGxContext.setClip (constref aclip: TGxRect): TGxRect;
940 begin
941 result := mClipRect;
942 mClipRect := aclip;
943 if (mActive) then realizeClip();
944 end;
947 function TGxContext.combineClip (constref aclip: TGxRect): TGxRect;
948 begin
949 result := mClipRect;
950 mClipRect.intersect(aclip);
951 if (mActive) then realizeClip();
952 end;
955 procedure TGxContext.line (x1, y1, x2, y2: Integer);
956 begin
957 if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
959 if (not mScaled) then
960 begin
961 glLineWidth(1);
962 glBegin(GL_LINES);
963 glVertex2f(x1+0.375, y1+0.375);
964 glVertex2f(x2+0.375, y2+0.375);
965 glEnd();
967 if (x1 <> x2) or (y1 <> y2) then
968 begin
969 glPointSize(1);
970 glBegin(GL_POINTS);
971 glVertex2f(x2+0.375, y2+0.375);
972 glEnd();
973 end;
974 end
975 else
976 begin
977 glLineWidth(1);
978 glBegin(GL_LINES);
979 glVertex2i(x1, y1);
980 glVertex2i(x2, y2);
981 // draw last point
982 glVertex2i(x2, y2);
983 glVertex2i(x2+1, y2+1);
984 glEnd();
985 end;
986 end;
989 procedure TGxContext.hline (x, y, len: Integer);
990 begin
991 if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
992 if (len < 1) then exit;
993 if (not mScaled) then
994 begin
995 glLineWidth(1);
996 glBegin(GL_LINES);
997 glVertex2f(x+0.375, y+0.375);
998 glVertex2f(x+len+0.375, y+0.375);
999 glEnd();
1000 end
1001 else if (mScale > 1.0) then
1002 begin
1003 glBegin(GL_QUADS);
1004 glVertex2i(x, y);
1005 glVertex2i(x+len, y);
1006 glVertex2i(x+len, y+1);
1007 glVertex2i(x, y+1);
1008 glEnd();
1009 end
1010 else
1011 begin
1012 glPointSize(1);
1013 glBegin(GL_POINTS);
1014 while (len > 0) do begin glVertex2i(x, y); Inc(x); Dec(len); end;
1015 glEnd();
1016 end;
1017 end;
1020 procedure TGxContext.vline (x, y, len: Integer);
1021 begin
1022 if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
1023 if (len < 1) then exit;
1024 if (not mScaled) then
1025 begin
1026 glLineWidth(1);
1027 glBegin(GL_LINES);
1028 glVertex2f(x+0.375, y+0.375);
1029 glVertex2f(x+0.375, y+len+0.375);
1030 glEnd();
1031 end
1032 else if (mScale > 1.0) then
1033 begin
1034 glBegin(GL_QUADS);
1035 glVertex2i(x, y);
1036 glVertex2i(x, y+len);
1037 glVertex2i(x+1, y+len);
1038 glVertex2i(x+1, y);
1039 glEnd();
1040 end
1041 else
1042 begin
1043 glPointSize(1);
1044 glBegin(GL_POINTS);
1045 while (len > 0) do begin glVertex2i(x, y); Inc(y); Dec(len); end;
1046 glEnd();
1047 end;
1048 end;
1051 procedure TGxContext.rect (x, y, w, h: Integer);
1052 begin
1053 if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
1054 if (w < 0) or (h < 0) then exit;
1055 if (w = 1) and (h = 1) then
1056 begin
1057 glPointSize(1);
1058 glBegin(GL_POINTS);
1059 if mScaled then glVertex2i(x, y) else glVertex2f(x+0.375, y+0.375);
1060 glEnd();
1061 end
1062 else
1063 begin
1064 if (not mScaled) then
1065 begin
1066 glLineWidth(1);
1067 glBegin(GL_LINES);
1068 glVertex2i(x, y); glVertex2i(x+w, y); // top
1069 glVertex2i(x, y+h-1); glVertex2i(x+w, y+h-1); // bottom
1070 glVertex2f(x+0.375, y+1); glVertex2f(x+0.375, y+h-1); // left
1071 glVertex2f(x+w-1+0.375, y+1); glVertex2f(x+w-1+0.375, y+h-1); // right
1072 glEnd();
1073 end
1074 else
1075 begin
1076 hline(x, y, w);
1077 hline(x, y+h-1, w);
1078 vline(x, y+1, h-2);
1079 vline(x+w-1, y+1, h-2);
1080 end;
1081 end;
1082 end;
1085 procedure TGxContext.fillRect (x, y, w, h: Integer);
1086 begin
1087 if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
1088 if (w < 0) or (h < 0) then exit;
1089 glBegin(GL_QUADS);
1090 glVertex2f(x, y);
1091 glVertex2f(x+w, y);
1092 glVertex2f(x+w, y+h);
1093 glVertex2f(x, y+h);
1094 glEnd();
1095 end;
1098 procedure TGxContext.darkenRect (x, y, w, h: Integer; a: Integer);
1099 begin
1100 if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (a >= 255) then exit;
1101 if (w < 0) or (h < 0) then exit;
1102 if (a < 0) then a := 0;
1103 glEnable(GL_BLEND);
1104 glBlendFunc(GL_ZERO, GL_SRC_ALPHA);
1105 glColor4f(0.0, 0.0, 0.0, a/255.0);
1106 glBegin(GL_QUADS);
1107 glVertex2i(x, y);
1108 glVertex2i(x+w, y);
1109 glVertex2i(x+w, y+h);
1110 glVertex2i(x, y+h);
1111 glEnd();
1112 setupGLColor(mColor);
1113 end;
1116 function TGxContext.charWidth (const ch: AnsiChar): Integer;
1117 begin
1118 result := mFont.charWidth(ch);
1119 end;
1121 function TGxContext.charHeight (const ch: AnsiChar): Integer;
1122 begin
1123 result := mFont.height;
1124 end;
1127 function TGxContext.textWidth (const s: AnsiString): Integer;
1128 begin
1129 result := mFont.textWidth(s);
1130 end;
1132 function TGxContext.textHeight (const s: AnsiString): Integer;
1133 begin
1134 result := mFont.height;
1135 end;
1138 function TGxContext.drawChar (x, y: Integer; const ch: AnsiChar): Integer; // returns char width
1139 begin
1140 result := mFont.charWidth(ch);
1141 if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
1142 TGxBmpFont(mFont).drawCharInternal(x, y, ch);
1143 end;
1145 function TGxContext.drawText (x, y: Integer; const s: AnsiString): Integer; // returns text width
1146 begin
1147 result := mFont.textWidth(s);
1148 if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) or (Length(s) = 0) then exit;
1149 TGxBmpFont(mFont).drawTextInternal(x, y, s);
1150 end;
1153 function TGxContext.iconMarkWidth (ic: TMarkIcon): Integer;
1154 begin
1155 {$IFDEF FUI_TEXT_ICONS}
1156 case ic of
1157 TMarkIcon.Checkbox: result := textWidth('[x]');
1158 TMarkIcon.Radiobox: result := textWidth('(*)');
1159 else result := textWidth('[x]');
1160 end;
1161 {$ELSE}
1162 result := 11;
1163 {$ENDIF}
1164 end;
1166 function TGxContext.iconMarkHeight (ic: TMarkIcon): Integer;
1167 begin
1168 {$IFDEF FUI_TEXT_ICONS}
1169 case ic of
1170 TMarkIcon.Checkbox: result := textHeight('[x]');
1171 TMarkIcon.Radiobox: result := textHeight('(*)');
1172 else result := textHeight('[x]');
1173 end;
1174 {$ELSE}
1175 result := 8;
1176 {$ENDIF}
1177 end;
1179 procedure TGxContext.drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean);
1180 var
1181 {$IFDEF FUI_TEXT_ICONS}
1182 xstr: AnsiString;
1183 {$ELSE}
1184 f: Integer;
1185 {$ENDIF}
1186 begin
1187 if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
1188 {$IFDEF FUI_TEXT_ICONS}
1189 case ic of
1190 TMarkIcon.Checkbox: xstr := '[x]';
1191 TMarkIcon.Radiobox: xstr := '(*)';
1192 else exit;
1193 end;
1194 if (marked) then
1195 begin
1196 drawText(x, y, xstr);
1197 end
1198 else
1199 begin
1200 drawChar(x, y, xstr[1]);
1201 drawChar(x+textWidth(xstr)-charWidth(xstr[3]), y, xstr[3]);
1202 end;
1203 {$ELSE}
1204 if (ic = TMarkIcon.Checkbox) then
1205 begin
1206 vline(x, y, 7);
1207 vline(x+10, y, 7);
1208 hline(x+1, y, 1);
1209 hline(x+1, y+6, 1);
1210 hline(x+9, y, 1);
1211 hline(x+9, y+6, 1);
1212 end
1213 else
1214 begin
1215 vline(x, y+1, 5);
1216 vline(x+10, y+1, 5);
1217 hline(x+1, y, 1);
1218 hline(x+1, y+6, 1);
1219 hline(x+9, y, 1);
1220 hline(x+9, y+6, 1);
1221 end;
1222 if (not marked) then exit;
1223 case ic of
1224 TMarkIcon.Checkbox:
1225 begin
1226 for f := 0 to 4 do
1227 begin
1228 vline(x+3+f, y+1+f, 1);
1229 vline(x+7-f, y+1+f, 1);
1230 end;
1231 end;
1232 TMarkIcon.Radiobox:
1233 begin
1234 hline(x+4, y+1, 3);
1235 hline(x+3, y+2, 5);
1236 hline(x+3, y+3, 5);
1237 hline(x+3, y+4, 5);
1238 hline(x+4, y+5, 3);
1239 end;
1240 end;
1241 {$ENDIF}
1242 end;
1245 function TGxContext.iconWinWidth (ic: TWinIcon): Integer;
1246 begin
1247 {$IFDEF FUI_TEXT_ICONS}
1248 case ic of
1249 TWinIcon.Close: result := nmax(textWidth('[x]'), textWidth('[#]'));
1250 else result := nmax(textWidth('[x]'), textWidth('[#]'));
1251 end;
1252 {$ELSE}
1253 result := 9;
1254 {$ENDIF}
1255 end;
1257 function TGxContext.iconWinHeight (ic: TWinIcon): Integer;
1258 begin
1259 {$IFDEF FUI_TEXT_ICONS}
1260 case ic of
1261 TWinIcon.Close: result := nmax(textHeight('[x]'), textHeight('[#]'));
1262 else result := nmax(textHeight('[x]'), textHeight('[#]'));
1263 end;
1264 {$ELSE}
1265 result := 8;
1266 {$ENDIF}
1267 end;
1269 procedure TGxContext.drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean);
1270 var
1271 {$IFDEF FUI_TEXT_ICONS}
1272 xstr: AnsiString;
1273 wdt: Integer;
1274 {$ELSE}
1275 f: Integer;
1276 {$ENDIF}
1277 begin
1278 if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
1279 {$IFDEF FUI_TEXT_ICONS}
1280 case ic of
1281 TWinIcon.Close: if (pressed) then xstr := '[#]' else xstr := '[x]';
1282 else exit;
1283 end;
1284 wdt := nmax(textWidth('[x]'), textWidth('[#]'));
1285 drawChar(x, y, xstr[1]);
1286 drawChar(x+wdt-charWidth(xstr[3]), y, xstr[3]);
1287 drawChar(x+((wdt-charWidth(xstr[2])) div 2), y, xstr[2]);
1288 {$ELSE}
1289 if pressed then rect(x, y, 9, 8);
1290 for f := 1 to 5 do
1291 begin
1292 vline(x+1+f, y+f, 1);
1293 vline(x+1+6-f, y+f, 1);
1294 end;
1295 {$ENDIF}
1296 end;
1299 procedure TGxContext.glSetScale (ascale: Single);
1300 begin
1301 if (ascale < 0.01) then ascale := 0.01;
1302 glLoadIdentity();
1303 glScalef(ascale, ascale, 1.0);
1304 mScale := ascale;
1305 mScaled := (ascale <> 1.0);
1306 end;
1308 procedure TGxContext.glSetTrans (ax, ay: Single);
1309 begin
1310 glLoadIdentity();
1311 glScalef(mScale, mScale, 1.0);
1312 glTranslatef(ax, ay, 0);
1313 end;
1316 procedure TGxContext.glSetScaleTrans (ascale, ax, ay: Single);
1317 begin
1318 glSetScale(ascale);
1319 glTranslatef(ax, ay, 0);
1320 end;
1323 // vertical scroll bar
1324 procedure TGxContext.drawVSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
1325 var
1326 filled: Integer;
1327 begin
1328 if (wdt < 1) or (hgt < 1) then exit;
1329 filled := sbarFilled(hgt, cur, min, max);
1330 color := clrfull;
1331 fillRect(x, y, wdt, filled);
1332 color := clrempty;
1333 fillRect(x, y+filled, wdt, hgt-filled);
1334 end;
1337 // horizontal scrollbar
1338 procedure TGxContext.drawHSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
1339 var
1340 filled: Integer;
1341 begin
1342 if (wdt < 1) or (hgt < 1) then exit;
1343 filled := sbarFilled(wdt, cur, min, max);
1344 color := clrfull;
1345 fillRect(x, y, filled, hgt);
1346 color := clrempty;
1347 fillRect(x+filled, y, wdt-filled, hgt);
1348 end;
1351 class function TGxContext.sbarFilled (wh: Integer; cur, min, max: Integer): Integer;
1352 begin
1353 if (wh < 1) then result := 0
1354 else if (min > max) then result := 0
1355 else if (min = max) then result := wh
1356 else
1357 begin
1358 if (cur < min) then cur := min else if (cur > max) then cur := max;
1359 result := wh*(cur-min) div (max-min);
1360 end;
1361 end;
1364 class function TGxContext.sbarPos (cxy: Integer; xy, wh: Integer; min, max: Integer): Integer;
1365 begin
1366 if (wh < 1) then begin result := 0; exit; end;
1367 if (min > max) then begin result := 0; exit; end;
1368 if (min = max) then begin result := max; exit; end;
1369 if (cxy < xy) then begin result := min; exit; end;
1370 if (cxy >= xy+wh) then begin result := max; exit; end;
1371 result := min+((max-min)*(cxy-xy) div wh);
1372 assert((result >= min) and (result <= max));
1373 end;
1378 // ////////////////////////////////////////////////////////////////////////// //
1379 (*
1380 procedure oglRestoreMode (doClear: Boolean);
1381 begin
1382 oglSetup2D(fuiScrWdt, fuiScrHgt);
1383 glScissor(0, 0, fuiScrWdt, fuiScrHgt);
1385 glBindTexture(GL_TEXTURE_2D, 0);
1386 glDisable(GL_BLEND);
1387 glDisable(GL_TEXTURE_2D);
1388 glDisable(GL_STENCIL_TEST);
1389 glDisable(GL_SCISSOR_TEST);
1390 glDisable(GL_LIGHTING);
1391 glDisable(GL_DEPTH_TEST);
1392 glDisable(GL_CULL_FACE);
1393 glDisable(GL_LINE_SMOOTH);
1394 glDisable(GL_POINT_SMOOTH);
1395 glLineWidth(1);
1396 glPointSize(1);
1397 glColor4f(1, 1, 1, 1);
1399 if doClear then
1400 begin
1401 glClearColor(0, 0, 0, 0);
1402 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_ACCUM_BUFFER_BIT or GL_STENCIL_BUFFER_BIT);
1403 end;
1405 // scale everything
1406 glMatrixMode(GL_MODELVIEW);
1407 glLoadIdentity();
1408 //glScalef(4, 4, 1);
1409 end;
1410 *)
1413 //procedure onWinFocus (); begin uiFocus(); end;
1414 //procedure onWinBlur (); begin fuiResetKMState(true); uiBlur(); end;
1416 //procedure onPreRender (); begin oglRestoreMode(gGfxDoClear); end;
1417 procedure onPostRender (); begin oglDrawCursor(); end;
1419 procedure onInit ();
1420 begin
1421 //oglSetup2D(fuiScrWdt, fuiScrHgt);
1422 createCursorTexture();
1423 oglInitFonts();
1424 end;
1426 procedure onDeinit ();
1427 begin
1428 fuiResetKMState(false);
1429 if (curtexid <> 0) then glDeleteTextures(1, @curtexid);
1430 curtexid := 0;
1431 oglDeinitFonts();
1432 fuiSetButState(0);
1433 fuiSetModState(0);
1434 fuiSetMouseX(0);
1435 fuiSetMouseY(0);
1436 end;
1439 // ////////////////////////////////////////////////////////////////////////// //
1440 initialization
1441 savedGLState := TSavedGLState.Create(false);
1442 //createFonts();
1443 //winFocusCB := onWinFocus;
1444 //winBlurCB := onWinBlur;
1445 //prerenderFrameCB := onPreRender;
1446 postrenderFrameCB := onPostRender;
1447 oglInitCB := onInit;
1448 oglDeinitCB := onDeinit;
1449 end.