DEADSOFTWARE

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


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