DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob


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