DEADSOFTWARE

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


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