DEADSOFTWARE

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


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