DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
check FBO status and fall back to no-fbo if something is wrong
[d2df-sdl.git] / src / engine / e_graphics.pas
1 (* Copyright (C) Doom 2D: Forever Developers
2 *
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE ../shared/a_modes.inc}
16 unit e_graphics;
17
18 interface
19
20 uses
21 {$INCLUDE ../nogl/noGLuses.inc}
22 {$IFDEF USE_SDL2}
23 SDL2,
24 {$ENDIF}
25 SysUtils, Classes, Math, e_log, e_texture,
26 MAPDEF, ImagingTypes, Imaging, ImagingUtility;
27
28 type
29 TMirrorType=(None, Horizontal, Vertical);
30 TBlending=(None, Blend, Filter, Invert);
31
32 TPoint2i = record
33 X, Y: Integer;
34 end;
35
36 TPoint2f = record
37 X, Y: Double;
38 end;
39
40 TRect = record
41 Left, Top, Right, Bottom: Integer;
42 end;
43
44 TRectWH = record
45 X, Y: Integer;
46 Width, Height: Word;
47 end;
48
49 TRGB = packed record
50 R, G, B: Byte;
51 end;
52
53 PDFPoint = ^TDFPoint;
54 PPoint2f = ^TPoint2f;
55 PRect = ^TRect;
56 PRectWH = ^TRectWH;
57
58
59 //------------------------------------------------------------------
60 // ïðîòîòèïû ôóíêöèé
61 //------------------------------------------------------------------
62 procedure e_InitGL();
63 procedure e_SetViewPort(X, Y, Width, Height: Word);
64 procedure e_ResizeWindow(Width, Height: Integer);
65 function e_ResizeFramebuffer(Width, Height: Integer): Boolean;
66 procedure e_BlitFramebuffer(WinWidth, WinHeight: Integer);
67
68 procedure e_Draw(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
69 Blending: Boolean; Mirror: TMirrorType = TMirrorType.None);
70 procedure e_DrawAdv(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
71 Blending: Boolean; Angle: Single; RC: PDFPoint; Mirror: TMirrorType = TMirrorType.None);
72 procedure e_DrawSize(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
73 Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = TMirrorType.None);
74 procedure e_DrawSizeMirror(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
75 Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = TMirrorType.None);
76
77 procedure e_DrawFill(ID: DWORD; X, Y: Integer; XCount, YCount: Word; Alpha: Integer;
78 AlphaChannel: Boolean; Blending: Boolean; ambientBlendMode: Boolean=false);
79
80 procedure e_DrawFillX (id: DWORD; x, y, wdt, hgt: Integer; alpha: Integer; alphachannel: Boolean;
81 blending: Boolean; scale: Single; ambientBlendMode: Boolean=false);
82
83 procedure e_AmbientQuad (x, y, w, h: Integer; r, g, b, a: Byte);
84
85 procedure e_DrawPoint(Size: Byte; X, Y: Integer; Red, Green, Blue: Byte);
86 procedure e_DrawLine(Width: Byte; X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
87 procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
88 procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte;
89 Blending: TBlending = TBlending.None);
90 procedure e_DarkenQuad (x0, y0, x1, y1: Integer; a: Integer);
91 procedure e_DarkenQuadWH (x, y, w, h: Integer; a: Integer);
92
93 function e_CreateTextureImg (var img: TImageData; var ID: DWORD): Boolean;
94 function e_CreateTexture(FileName: string; var ID: DWORD): Boolean;
95 function e_CreateTextureEx(FileName: string; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
96 function e_CreateTextureMem(pData: Pointer; dataSize: LongInt; var ID: DWORD): Boolean;
97 function e_CreateTextureMemEx(pData: Pointer; dataSize: LongInt; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
98 procedure e_GetTextureSize(ID: DWORD; Width, Height: PWord);
99 procedure e_DeleteTexture(ID: DWORD);
100 procedure e_RemoveAllTextures();
101
102 // CharFont
103 function e_CharFont_Create(sp: ShortInt=0): DWORD;
104 procedure e_CharFont_AddChar(FontID: DWORD; Texture: Integer; c: Char; w: Byte);
105 procedure e_CharFont_Print(FontID: DWORD; X, Y: Integer; Text: string);
106 procedure e_CharFont_PrintEx(FontID: DWORD; X, Y: Integer; Text: string;
107 Color: TRGB; Scale: Single = 1.0);
108 procedure e_CharFont_PrintFmt(FontID: DWORD; X, Y: Integer; Text: string);
109 procedure e_CharFont_GetSize(FontID: DWORD; Text: string; var w, h: Word);
110 procedure e_CharFont_GetSizeFmt(FontID: DWORD; Text: string; var w, h: Word);
111 function e_CharFont_GetMaxWidth(FontID: DWORD): Word;
112 function e_CharFont_GetMaxHeight(FontID: DWORD): Word;
113 procedure e_CharFont_Remove(FontID: DWORD);
114 procedure e_CharFont_RemoveAll();
115
116 // TextureFont
117 procedure e_TextureFontBuild(Tex: DWORD; var FontID: DWORD; XCount, YCount: Word;
118 Space: ShortInt=0);
119 procedure e_TextureFontKill(FontID: DWORD);
120 procedure e_TextureFontPrint(X, Y: GLint; Text: string; FontID: DWORD);
121 procedure e_TextureFontPrintEx(X, Y: GLint; Text: string; FontID: DWORD; Red, Green,
122 Blue: Byte; Scale: Single; Shadow: Boolean = False);
123 procedure e_TextureFontPrintFmt(X, Y: GLint; Text: string; FontID: DWORD;
124 Shadow: Boolean = False; Newlines: Boolean = False);
125 procedure e_TextureFontGetSize(ID: DWORD; out CharWidth, CharHeight: Byte);
126 procedure e_RemoveAllTextureFont();
127
128 function e_TextureFontCharWidth (ch: Char; FontID: DWORD): Integer;
129 procedure e_TextureFontPrintCharEx (X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
130
131 procedure e_ReleaseEngine();
132 procedure e_BeginRender();
133 procedure e_Clear(Mask: TGLbitfield; Red, Green, Blue: Single); overload;
134 procedure e_Clear(); overload;
135 procedure e_EndRender();
136
137 {$IFDEF USE_SDL2}
138 function e_GetGamma(win: PSDL_Window): Byte;
139 procedure e_SetGamma(win: PSDL_Window;Gamma: Byte);
140 {$ENDIF}
141
142 procedure e_MakeScreenshot(st: TStream; Width, Height: Word);
143
144 function _RGB(Red, Green, Blue: Byte): TRGB;
145 function _Point(X, Y: Integer): TPoint2i;
146 function _Rect(X, Y: Integer; Width, Height: Word): TRectWH;
147 function _TRect(L, T, R, B: LongInt): TRect;
148
149 //function e_getTextGLId (ID: DWORD): GLuint;
150
151 var
152 e_Colors: TRGB;
153 e_NoGraphics: Boolean = False;
154 e_FastScreenshots: Boolean = true; // it's REALLY SLOW with `false`
155 g_dbg_scale: Single = 1.0;
156 r_pixel_scale: Single = 1.0;
157
158
159 implementation
160
161 uses
162 paszlib, crc, utils;
163
164
165 type
166 TTexture = record
167 tx: GLTexture;
168 end;
169
170 TTextureFont = record
171 Texture: DWORD;
172 TextureID: DWORD;
173 Base: Uint32;
174 CharWidth: Byte;
175 CharHeight: Byte;
176 XC, YC: WORD;
177 SPC: ShortInt;
178 end;
179
180 TCharFont = record
181 Chars: array[0..255] of
182 record
183 TextureID: Integer;
184 Width: Byte;
185 end;
186 Space: ShortInt;
187 Height: ShortInt;
188 alive: Boolean;
189 end;
190
191 TSavedTexture = record
192 TexID: DWORD;
193 OldID: DWORD;
194 Pixels: Pointer;
195 end;
196
197 var
198 e_Textures: array of TTexture = nil;
199 e_TextureFonts: array of TTextureFont = nil;
200 e_CharFonts: array of TCharFont;
201 //e_SavedTextures: array of TSavedTexture;
202 e_FBO: GLuint = 0;
203 e_RBO: GLuint = 0;
204 e_Frame: GLuint = 0;
205 e_FrameW: Integer = -1;
206 e_FrameH: Integer = -1;
207
208 //function e_getTextGLId (ID: DWORD): GLuint; begin result := e_Textures[ID].tx.id; end;
209
210 //------------------------------------------------------------------
211 // Èíèöèàëèçèðóåò OpenGL
212 //------------------------------------------------------------------
213 procedure e_InitGL();
214 begin
215 if e_NoGraphics then
216 begin
217 e_DummyTextures := True;
218 Exit;
219 end;
220 e_Colors.R := 255;
221 e_Colors.G := 255;
222 e_Colors.B := 255;
223 glDisable(GL_DEPTH_TEST);
224 glEnable(GL_SCISSOR_TEST);
225 glClearColor(0, 0, 0, 0);
226 end;
227
228 procedure e_SetViewPort(X, Y, Width, Height: Word);
229 var
230 mat: Array [0..15] of GLDouble;
231
232 begin
233 if e_NoGraphics then Exit;
234 glLoadIdentity();
235 glScissor(X, Y, Width, Height);
236 glViewport(X, Y, Width, Height);
237 //gluOrtho2D(0, Width, Height, 0);
238
239 glMatrixMode(GL_PROJECTION);
240
241 mat[ 0] := 2.0 / Width;
242 mat[ 1] := 0.0;
243 mat[ 2] := 0.0;
244 mat[ 3] := 0.0;
245
246 mat[ 4] := 0.0;
247 mat[ 5] := -2.0 / Height;
248 mat[ 6] := 0.0;
249 mat[ 7] := 0.0;
250
251 mat[ 8] := 0.0;
252 mat[ 9] := 0.0;
253 mat[10] := 1.0;
254 mat[11] := 0.0;
255
256 mat[12] := -1.0;
257 mat[13] := 1.0;
258 mat[14] := 0.0;
259 mat[15] := 1.0;
260
261 glLoadMatrixd(@mat[0]);
262
263 glMatrixMode(GL_MODELVIEW);
264 glLoadIdentity();
265 end;
266
267 //------------------------------------------------------------------
268 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
269 //------------------------------------------------------------------
270 function FindTexture(): DWORD;
271 var
272 i: integer;
273 begin
274 if e_Textures <> nil then
275 for i := 0 to High(e_Textures) do
276 if e_Textures[i].tx.Width = 0 then
277 begin
278 Result := i;
279 Exit;
280 end;
281
282 if e_Textures = nil then
283 begin
284 SetLength(e_Textures, 32);
285 Result := 0;
286 end
287 else
288 begin
289 Result := High(e_Textures) + 1;
290 SetLength(e_Textures, Length(e_Textures) + 32);
291 end;
292 end;
293
294 //------------------------------------------------------------------
295 // Ñîçäàåò òåêñòóðó
296 //------------------------------------------------------------------
297 function e_CreateTexture(FileName: String; var ID: DWORD): Boolean;
298 var
299 find_id: DWORD;
300 fmt: Word;
301 begin
302 Result := False;
303
304 e_WriteLog('Loading texture from '+FileName, TMsgType.Notify);
305
306 find_id := FindTexture();
307
308 if not LoadTexture(FileName, e_Textures[find_id].tx, e_Textures[find_id].tx.Width,
309 e_Textures[find_id].tx.Height, @fmt) then Exit;
310
311 ID := find_id;
312
313 Result := True;
314 end;
315
316 function e_CreateTextureEx(FileName: String; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
317 var
318 find_id: DWORD;
319 fmt: Word;
320 begin
321 Result := False;
322
323 find_id := FindTexture();
324
325 if not LoadTextureEx(FileName, e_Textures[find_id].tx, fX, fY, fWidth, fHeight, @fmt) then exit;
326
327 ID := find_id;
328
329 Result := True;
330 end;
331
332 function e_CreateTextureMem(pData: Pointer; dataSize: LongInt; var ID: DWORD): Boolean;
333 var
334 find_id: DWORD;
335 fmt: Word;
336 begin
337 Result := False;
338
339 find_id := FindTexture;
340
341 if not LoadTextureMem(pData, dataSize, e_Textures[find_id].tx, e_Textures[find_id].tx.Width, e_Textures[find_id].tx.Height, @fmt) then exit;
342
343 id := find_id;
344
345 Result := True;
346 end;
347
348 function e_CreateTextureMemEx(pData: Pointer; dataSize: LongInt; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
349 var
350 find_id: DWORD;
351 fmt: Word;
352 begin
353 Result := False;
354
355 find_id := FindTexture();
356
357 if not LoadTextureMemEx(pData, dataSize, e_Textures[find_id].tx, fX, fY, fWidth, fHeight, @fmt) then exit;
358
359 ID := find_id;
360
361 Result := True;
362 end;
363
364 function e_CreateTextureImg (var img: TImageData; var ID: DWORD): Boolean;
365 var
366 find_id: DWORD;
367 fmt, tw, th: Word;
368 begin
369 result := false;
370 find_id := FindTexture();
371 if not LoadTextureImg(img, e_Textures[find_id].tx, tw, th, @fmt) then exit;
372 ID := find_id;
373 result := True;
374 end;
375
376 procedure e_GetTextureSize(ID: DWORD; Width, Height: PWord);
377 begin
378 if Width <> nil then Width^ := e_Textures[ID].tx.Width;
379 if Height <> nil then Height^ := e_Textures[ID].tx.Height;
380 end;
381
382 procedure DestroyFramebuffer;
383 begin
384 glBindTexture(GL_TEXTURE_2D, 0);
385 glBindRenderbuffer(GL_RENDERBUFFER, 0);
386 glBindFramebuffer(GL_FRAMEBUFFER, 0);
387
388 if e_Frame > 0 then
389 begin
390 glDeleteTextures(1, @e_Frame);
391 e_Frame := 0;
392 end;
393
394 if e_RBO > 0 then
395 begin
396 glDeleteRenderbuffers(1, @e_RBO);
397 e_RBO := 0;
398 end;
399
400 if e_FBO > 0 then
401 begin
402 glDeleteFramebuffers(1, @e_FBO);
403 e_FBO := 0;
404 end;
405 end;
406
407 function e_ResizeFramebuffer(Width, Height: Integer): Boolean;
408 begin
409 Result := False;
410
411 if e_NoGraphics then Exit;
412
413 DestroyFramebuffer;
414
415 e_FrameW := Width;
416 e_FrameH := Height;
417
418 glGetError();
419
420 glGenFramebuffers(1, @e_FBO);
421
422 if glGetError() <> GL_NO_ERROR then
423 begin
424 e_LogWriteln('GL: glGenFramebuffers failed');
425 Exit;
426 end;
427
428 glGenTextures(1, @e_Frame);
429 glBindTexture(GL_TEXTURE_2D, e_Frame);
430 glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, nil);
431 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
432 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
433
434 if glGetError() <> GL_NO_ERROR then
435 begin
436 e_LogWriteln('GL: can''t create FBO color buffer');
437 DestroyFramebuffer;
438 Exit;
439 end;
440
441 glBindFramebuffer(GL_FRAMEBUFFER, e_FBO);
442 glFramebufferTexture2D(GL_FRAMEBUFFER, GL_COLOR_ATTACHMENT0, GL_TEXTURE_2D, e_Frame, 0);
443
444 {$IFNDEF USE_GLES1}
445 glGenRenderbuffers(1, @e_RBO);
446 glBindRenderbuffer(GL_RENDERBUFFER, e_RBO);
447 glRenderbufferStorage(GL_RENDERBUFFER, GL_DEPTH24_STENCIL8, Width, Height);
448 glFramebufferRenderbuffer(GL_FRAMEBUFFER, GL_DEPTH_STENCIL_ATTACHMENT, GL_RENDERBUFFER, e_RBO);
449 if glCheckFramebufferStatus(GL_FRAMEBUFFER) <> GL_FRAMEBUFFER_COMPLETE then
450 begin
451 e_LogWriteln('GL: can''t construct framebuffer with depth+stencil attachment');
452 glFramebufferRenderbuffer(GL_FRAMEBUFFER, GL_DEPTH_STENCIL_ATTACHMENT, GL_RENDERBUFFER, 0);
453 glDeleteRenderbuffers(1, @e_RBO); e_RBO := 0;
454 Exit;
455 end;
456 {$ENDIF}
457
458 if glCheckFramebufferStatus(GL_FRAMEBUFFER) <> GL_FRAMEBUFFER_COMPLETE then
459 begin
460 e_LogWriteln('GL: can''t construct framebuffer with color attachment');
461 DestroyFramebuffer;
462 Exit;
463 end;
464
465 Result := True;
466 end;
467
468 procedure e_ResizeWindow(Width, Height: Integer);
469 begin
470 if Height = 0 then
471 Height := 1;
472 e_SetViewPort(0, 0, Width, Height);
473 end;
474
475 procedure drawTxQuad (x0, y0, w, h, tw, th: Integer; u, v: single; Mirror: TMirrorType);
476 var
477 x1, y1, tmp: Integer;
478 begin
479 if (w < 1) or (h < 1) then exit;
480 x1 := x0+w;
481 y1 := y0+h;
482 if Mirror = TMirrorType.Horizontal then begin tmp := x1; x1 := x0; x0 := tmp; end
483 else if Mirror = TMirrorType.Vertical then begin tmp := y1; y1 := y0; y0 := tmp; end;
484 glTexCoord2f(0, v); glVertex2i(x0, y0);
485 glTexCoord2f(0, 0); glVertex2i(x0, y1);
486 glTexCoord2f(u, 0); glVertex2i(x1, y1);
487 glTexCoord2f(u, v); glVertex2i(x1, y0);
488 end;
489
490 procedure e_BlitFramebuffer(WinWidth, WinHeight: Integer);
491 begin
492 if (e_FBO = 0) or (e_Frame = 0) or e_NoGraphics then exit;
493
494 glDisable(GL_BLEND);
495 glEnable(GL_TEXTURE_2D);
496 glBindFramebuffer(GL_FRAMEBUFFER, 0);
497 glBindTexture(GL_TEXTURE_2D, e_Frame);
498 e_SetViewPort(0, 0, WinWidth, WinHeight);
499 glColor4ub(255, 255, 255, 255);
500
501 glBegin(GL_QUADS);
502 glTexCoord2f(0, 1); glVertex2i( 0, 0);
503 glTexCoord2f(0, 0); glVertex2i( 0, WinHeight);
504 glTexCoord2f(1, 0); glVertex2i(WinWidth, WinHeight);
505 glTexCoord2f(1, 1); glVertex2i(WinWidth, 0);
506 glEnd();
507
508 glBindFramebuffer(GL_FRAMEBUFFER, e_FBO);
509 e_SetViewPort(0, 0, e_FrameW, e_FrameH);
510 end;
511
512 procedure e_Draw(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
513 Blending: Boolean; Mirror: TMirrorType = TMirrorType.None);
514 begin
515 if e_NoGraphics then Exit;
516 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
517
518 if (Alpha > 0) or (AlphaChannel) or (Blending) then
519 glEnable(GL_BLEND)
520 else
521 glDisable(GL_BLEND);
522
523 if (AlphaChannel) or (Alpha > 0) then
524 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
525
526 if Alpha > 0 then
527 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
528
529 if Blending then
530 glBlendFunc(GL_SRC_ALPHA, GL_ONE);
531
532 glEnable(GL_TEXTURE_2D);
533 glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
534 glBegin(GL_QUADS);
535
536 drawTxQuad(X, Y, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
537
538 //u := e_Textures[ID].tx.u;
539 //v := e_Textures[ID].tx.v;
540
541 {
542 if Mirror = M_NONE then
543 begin
544 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
545 glTexCoord2f(0, 0); glVertex2i(X, Y);
546 glTexCoord2f(0, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
547 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
548 end
549 else
550 if Mirror = M_HORIZONTAL then
551 begin
552 glTexCoord2f(u, 0); glVertex2i(X, Y);
553 glTexCoord2f(0, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
554 glTexCoord2f(0, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
555 glTexCoord2f(u, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
556 end
557 else
558 if Mirror = M_VERTICAL then
559 begin
560 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y);
561 glTexCoord2f(0, -v); glVertex2i(X, Y);
562 glTexCoord2f(0, 0); glVertex2i(X, Y + e_Textures[id].tx.Height);
563 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
564 end;
565 }
566
567 glEnd();
568
569 glDisable(GL_BLEND);
570 end;
571
572 procedure e_DrawSize(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
573 Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = TMirrorType.None);
574 var
575 u, v: Single;
576 begin
577 if e_NoGraphics then Exit;
578 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
579
580 if (Alpha > 0) or (AlphaChannel) or (Blending) then
581 glEnable(GL_BLEND)
582 else
583 glDisable(GL_BLEND);
584
585 if (AlphaChannel) or (Alpha > 0) then
586 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
587
588 if Alpha > 0 then
589 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
590
591 if Blending then
592 glBlendFunc(GL_SRC_ALPHA, GL_ONE);
593
594 glEnable(GL_TEXTURE_2D);
595 glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
596
597 u := e_Textures[ID].tx.u;
598 v := e_Textures[ID].tx.v;
599
600 glBegin(GL_QUADS);
601 glTexCoord2f(0, v); glVertex2i(X, Y);
602 glTexCoord2f(u, v); glVertex2i(X + Width, Y);
603 glTexCoord2f(u, 0); glVertex2i(X + Width, Y + Height);
604 glTexCoord2f(0, 0); glVertex2i(X, Y + Height);
605 glEnd();
606
607 glDisable(GL_BLEND);
608 end;
609
610 procedure e_DrawSizeMirror(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
611 Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = TMirrorType.None);
612 begin
613 if e_NoGraphics then Exit;
614 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
615
616 if (Alpha > 0) or (AlphaChannel) or (Blending) then
617 glEnable(GL_BLEND)
618 else
619 glDisable(GL_BLEND);
620
621 if (AlphaChannel) or (Alpha > 0) then
622 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
623
624 if Alpha > 0 then
625 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
626
627 if Blending then
628 glBlendFunc(GL_SRC_ALPHA, GL_ONE);
629
630 glEnable(GL_TEXTURE_2D);
631 glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
632 glBegin(GL_QUADS);
633 drawTxQuad(X, Y, Width, Height, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
634 glEnd();
635
636 glDisable(GL_BLEND);
637 end;
638
639 procedure e_DrawFill(ID: DWORD; X, Y: Integer; XCount, YCount: Word; Alpha: Integer;
640 AlphaChannel: Boolean; Blending: Boolean; ambientBlendMode: Boolean=false);
641 var
642 X2, Y2, dx, w, h: Integer;
643 u, v: Single;
644 begin
645 if e_NoGraphics then Exit;
646 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
647 ambientBlendMode := false;
648
649 if (Alpha > 0) or AlphaChannel or Blending then
650 begin
651 glEnable(GL_BLEND);
652 end
653 else
654 begin
655 if not ambientBlendMode then glDisable(GL_BLEND);
656 end;
657 if AlphaChannel or (Alpha > 0) then glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
658 if (Alpha > 0) then glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
659 if Blending then glBlendFunc(GL_SRC_ALPHA, GL_ONE);
660
661 if (XCount = 0) then XCount := 1;
662 if (YCount = 0) then YCount := 1;
663
664 glEnable(GL_TEXTURE_2D);
665 glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
666
667 X2 := X+e_Textures[ID].tx.width*XCount;
668 Y2 := Y+e_Textures[ID].tx.height*YCount;
669
670 //k8: this SHOULD work... i hope
671 if (e_Textures[ID].tx.width = e_Textures[ID].tx.glwidth) and (e_Textures[ID].tx.height = e_Textures[ID].tx.glheight) then
672 begin
673 glBegin(GL_QUADS);
674 glTexCoord2i(0, YCount); glVertex2i(X, Y);
675 glTexCoord2i(XCount, YCount); glVertex2i(X2, Y);
676 glTexCoord2i(XCount, 0); glVertex2i(X2, Y2);
677 glTexCoord2i(0, 0); glVertex2i(X, Y2);
678 glEnd();
679 end
680 else
681 begin
682 glBegin(GL_QUADS);
683 // hard day's night
684 u := e_Textures[ID].tx.u;
685 v := e_Textures[ID].tx.v;
686 w := e_Textures[ID].tx.width;
687 h := e_Textures[ID].tx.height;
688 while YCount > 0 do
689 begin
690 dx := XCount;
691 x2 := X;
692 while dx > 0 do
693 begin
694 glTexCoord2f(0, v); glVertex2i(X, Y);
695 glTexCoord2f(u, v); glVertex2i(X+w, Y);
696 glTexCoord2f(u, 0); glVertex2i(X+w, Y+h);
697 glTexCoord2f(0, 0); glVertex2i(X, Y+h);
698 Inc(X, w);
699 Dec(dx);
700 end;
701 X := x2;
702 Inc(Y, h);
703 Dec(YCount);
704 end;
705 glEnd();
706 end;
707
708 glDisable(GL_BLEND);
709 end;
710
711
712 //TODO: overflow checks
713 function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
714 var
715 ex0, ey0: Integer;
716 begin
717 result := false;
718 if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit;
719 // check for intersection
720 if (x0+w0 <= x1) or (y0+h0 <= y1) or (x1+w1 <= x0) or (y1+h1 <= y0) then exit;
721 if (x0 >= x1+w1) or (y0 >= y1+h1) or (x1 >= x0+h0) or (y1 >= y0+h0) then exit;
722 // ok, intersects
723 ex0 := x0+w0;
724 ey0 := y0+h0;
725 if (x0 < x1) then x0 := x1;
726 if (y0 < y1) then y0 := y1;
727 if (ex0 > x1+w1) then ex0 := x1+w1;
728 if (ey0 > y1+h1) then ey0 := y1+h1;
729 w0 := ex0-x0;
730 h0 := ey0-y0;
731 result := (w0 > 0) and (h0 > 0);
732 end;
733
734
735 procedure e_DrawFillX (id: DWORD; x, y, wdt, hgt: Integer; alpha: Integer; alphachannel: Boolean;
736 blending: Boolean; scale: Single; ambientBlendMode: Boolean=false);
737 var
738 x2, y2: Integer;
739 {
740 wassc: Boolean;
741 scxywh: array[0..3] of GLint;
742 vpxywh: array[0..3] of GLint;
743 }
744 w, h, dw, cw, ch, yofs: Integer;
745 u, v, cu, cv: Single;
746 onlyOneY: Boolean;
747
748 {
749 procedure setScissorGLInternal (x, y, w, h: Integer);
750 begin
751 //if not scallowed then exit;
752 x := trunc(x*scale);
753 y := trunc(y*scale);
754 w := trunc(w*scale);
755 h := trunc(h*scale);
756 y := vpxywh[3]-(y+h);
757 if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then
758 begin
759 glScissor(0, 0, 0, 0);
760 end
761 else
762 begin
763 //writeln(' (', x, ',', y, ')-(', w, ',', h, ')');
764 glScissor(x, y, w, h);
765 end;
766 end;
767 }
768
769 begin
770 if e_NoGraphics then exit;
771 ambientBlendMode := false;
772
773 if (wdt < 1) or (hgt < 1) then exit;
774
775 if (wdt mod e_Textures[ID].tx.width = 0) and (hgt mod e_Textures[ID].tx.height = 0) then
776 begin
777 e_DrawFill(id, x, y, wdt div e_Textures[ID].tx.width, hgt div e_Textures[ID].tx.height, alpha, alphachannel, blending, ambientBlendMode);
778 exit;
779 end;
780
781 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
782
783 if (Alpha > 0) or AlphaChannel or Blending then
784 begin
785 glEnable(GL_BLEND);
786 end
787 else
788 begin
789 if not ambientBlendMode then glDisable(GL_BLEND);
790 end;
791 if AlphaChannel or (Alpha > 0) then glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
792 if (Alpha > 0) then glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
793 if Blending then glBlendFunc(GL_SRC_ALPHA, GL_ONE);
794
795 glEnable(GL_TEXTURE_2D);
796 glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
797
798 x2 := x+wdt;
799 y2 := y+hgt;
800
801 //k8: this SHOULD work... i hope
802 if {false and} (e_Textures[ID].tx.width = e_Textures[ID].tx.glwidth) and (e_Textures[ID].tx.height = e_Textures[ID].tx.glheight) then
803 begin
804 glBegin(GL_QUADS);
805 glTexCoord2f(0, hgt/e_Textures[ID].tx.height); glVertex2i(x, y);
806 glTexCoord2f(wdt/e_Textures[ID].tx.width, hgt/e_Textures[ID].tx.height); glVertex2i(x2, y);
807 glTexCoord2f(wdt/e_Textures[ID].tx.width, 0); glVertex2i(x2, y2);
808 glTexCoord2f(0, 0); glVertex2i(x, y2);
809 glEnd();
810 end
811 else
812 begin
813 // hard day's night; setup scissor
814 {
815 glGetIntegerv(GL_VIEWPORT, @vpxywh[0]);
816 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
817 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
818 //writeln('(', scxywh[0], ',', scxywh[1], ')-(', scxywh[2], ',', scxywh[3], ')');
819 //glEnable(GL_SCISSOR_TEST);
820 setScissorGLInternal(x, y, wdt, hgt);
821 }
822 // draw quads
823 u := e_Textures[ID].tx.u;
824 v := e_Textures[ID].tx.v;
825 w := e_Textures[ID].tx.width;
826 h := e_Textures[ID].tx.height;
827 x2 := x;
828 if (hgt > h) then begin y += hgt-h; onlyOneY := false; end else onlyOneY := true;
829 glBegin(GL_QUADS);
830 while (hgt > 0) do
831 begin
832 if (hgt >= h) then begin ch := h; cv := v; yofs := 0; end else begin ch := hgt; cv := v/(h/hgt); yofs := h-hgt; end;
833 if onlyOneY then yofs := 0;
834 Dec(hgt, h);
835 dw := wdt;
836 x := x2;
837 while (dw > 0) do
838 begin
839 if (dw >= w) then begin cw := w; cu := u; end else begin cw := dw; cu := u/(w/dw); end;
840 Dec(dw, w);
841 glTexCoord2f(0, cv); glVertex2i(X, Y+yofs);
842 glTexCoord2f(cu, cv); glVertex2i(X+cw, Y+yofs);
843 glTexCoord2f(cu, 0); glVertex2i(X+cw, Y+ch+yofs);
844 glTexCoord2f(0, 0); glVertex2i(X, Y+ch+yofs);
845 Inc(X, w);
846 end;
847 Dec(Y, h);
848 end;
849 glEnd();
850 //if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
851 end;
852
853 glDisable(GL_BLEND);
854 end;
855
856
857 procedure e_AmbientQuad (x, y, w, h: Integer; r, g, b, a: Byte);
858 begin
859 if e_NoGraphics then exit;
860 if (w < 1) or (h < 1) then exit;
861 if (a <> 255) or ((r or g or b) <> 0) then
862 begin
863 glEnable(GL_BLEND);
864 glDisable(GL_TEXTURE_2D);
865 glColor4ub(r, g, b, a);
866 if ((r or g or b) <> 0) then
867 begin
868 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
869 glBegin(GL_QUADS);
870 glVertex2i(x, y);
871 glVertex2i(x+w, y);
872 glVertex2i(x+w, y+h);
873 glVertex2i(x, y+h);
874 glEnd();
875 end;
876 glBlendFunc(GL_ZERO, GL_SRC_ALPHA);
877 glBegin(GL_QUADS);
878 glVertex2i(x, y);
879 glVertex2i(x+w, y);
880 glVertex2i(x+w, y+h);
881 glVertex2i(x, y+h);
882 glEnd();
883 glDisable(GL_BLEND);
884 end;
885 end;
886
887
888 procedure e_DrawAdv(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
889 Blending: Boolean; Angle: Single; RC: PDFPoint; Mirror: TMirrorType = TMirrorType.None);
890 begin
891 if e_NoGraphics then Exit;
892
893 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
894
895 if (Alpha > 0) or (AlphaChannel) or (Blending) then
896 glEnable(GL_BLEND)
897 else
898 glDisable(GL_BLEND);
899
900 if (AlphaChannel) or (Alpha > 0) then
901 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
902
903 if Alpha > 0 then
904 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
905
906 if Blending then
907 glBlendFunc(GL_SRC_ALPHA, GL_ONE);
908
909 if (Angle <> 0) and (RC <> nil) then
910 begin
911 glPushMatrix();
912 glTranslatef(X+RC.X, Y+RC.Y, 0);
913 glRotatef(Angle, 0, 0, 1);
914 glTranslatef(-(X+RC.X), -(Y+RC.Y), 0);
915 end;
916
917 glEnable(GL_TEXTURE_2D);
918 glBindTexture(GL_TEXTURE_2D, e_Textures[id].tx.id);
919 glBegin(GL_QUADS); //0-1 1-1
920 //00 10
921 drawTxQuad(X, Y, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
922 glEnd();
923
924 if Angle <> 0 then
925 glPopMatrix();
926
927 glDisable(GL_BLEND);
928 end;
929
930 procedure e_DrawPoint(Size: Byte; X, Y: Integer; Red, Green, Blue: Byte);
931 begin
932 if e_NoGraphics then Exit;
933 glDisable(GL_TEXTURE_2D);
934 glColor3ub(Red, Green, Blue);
935 glPointSize(Size);
936
937 if (Size = 2) or (Size = 4) then
938 X := X + 1;
939
940 glBegin(GL_POINTS);
941 glVertex2f(X+0.3, Y+1.0);
942 glEnd();
943
944 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
945 end;
946
947 procedure e_LineCorrection(var X1, Y1, X2, Y2: Integer);
948 begin
949 // Make lines only top-left/bottom-right and top-right/bottom-left
950 if Y2 < Y1 then
951 begin
952 X1 := X1 xor X2;
953 X2 := X1 xor X2;
954 X1 := X1 xor X2;
955
956 Y1 := Y1 xor Y2;
957 Y2 := Y1 xor Y2;
958 Y1 := Y1 xor Y2;
959 end;
960
961 // Pixel-perfect hack
962 if X1 < X2 then
963 Inc(X2)
964 else
965 Inc(X1);
966 Inc(Y2);
967 end;
968
969 procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
970 var
971 nX1, nY1, nX2, nY2: Integer;
972 begin
973 if e_NoGraphics then Exit;
974 // Only top-left/bottom-right quad
975 if X1 > X2 then
976 begin
977 X1 := X1 xor X2;
978 X2 := X1 xor X2;
979 X1 := X1 xor X2;
980 end;
981 if Y1 > Y2 then
982 begin
983 Y1 := Y1 xor Y2;
984 Y2 := Y1 xor Y2;
985 Y1 := Y1 xor Y2;
986 end;
987
988 if Alpha > 0 then
989 begin
990 glEnable(GL_BLEND);
991 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
992 end
993 else
994 glDisable(GL_BLEND);
995
996 glDisable(GL_TEXTURE_2D);
997 glColor4ub(Red, Green, Blue, 255-Alpha);
998 glLineWidth(1);
999 glBegin(GL_LINES);
1000 nX1 := X1; nY1 := Y1;
1001 nX2 := X2; nY2 := Y1;
1002 e_LineCorrection(nX1, nY1, nX2, nY2); // Pixel-perfect lines
1003 glVertex2i(nX1, nY1);
1004 glVertex2i(nX2, nY2);
1005
1006 nX1 := X2; nY1 := Y1;
1007 nX2 := X2; nY2 := Y2;
1008 e_LineCorrection(nX1, nY1, nX2, nY2);
1009 glVertex2i(nX1, nY1);
1010 glVertex2i(nX2, nY2);
1011
1012 nX1 := X2; nY1 := Y2;
1013 nX2 := X1; nY2 := Y2;
1014 e_LineCorrection(nX1, nY1, nX2, nY2);
1015 glVertex2i(nX1, nY1);
1016 glVertex2i(nX2, nY2);
1017
1018 nX1 := X1; nY1 := Y2;
1019 nX2 := X1; nY2 := Y1;
1020 e_LineCorrection(nX1, nY1, nX2, nY2);
1021 glVertex2i(nX1, nY1);
1022 glVertex2i(nX2, nY2);
1023 glEnd();
1024 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1025 glDisable(GL_BLEND);
1026 end;
1027
1028 procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte;
1029 Blending: TBlending = TBlending.None);
1030 begin
1031 if e_NoGraphics then Exit;
1032 if (Alpha > 0) or (Blending <> TBlending.None) then
1033 glEnable(GL_BLEND)
1034 else
1035 glDisable(GL_BLEND);
1036
1037 case Blending of
1038 TBlending.None: if Alpha > 0 then glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1039 TBlending.Blend: glBlendFunc(GL_SRC_ALPHA, GL_ONE);
1040 TBlending.Invert: glBlendFunc(GL_ONE_MINUS_DST_COLOR, GL_ZERO);
1041 TBlending.Filter: glBlendFunc(GL_ZERO, GL_SRC_COLOR);
1042 end;
1043
1044 glDisable(GL_TEXTURE_2D);
1045 glColor4ub(Red, Green, Blue, 255-Alpha);
1046
1047 X2 := X2 + 1;
1048 Y2 := Y2 + 1;
1049
1050 glBegin(GL_QUADS);
1051 glVertex2i(X1, Y1);
1052 glVertex2i(X2, Y1);
1053 glVertex2i(X2, Y2);
1054 glVertex2i(X1, Y2);
1055 glEnd();
1056
1057 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1058 glDisable(GL_BLEND);
1059 end;
1060
1061
1062 // ////////////////////////////////////////////////////////////////////////// //
1063 procedure e_DarkenQuad (x0, y0, x1, y1: Integer; a: Integer);
1064 begin
1065 if (a < 0) then a := 0;
1066 if (a > 255) then a := 255;
1067 glEnable(GL_BLEND);
1068 glBlendFunc(GL_ZERO, GL_SRC_ALPHA);
1069 glDisable(GL_TEXTURE_2D);
1070 glColor4ub(0, 0, 0, Byte(255-a));
1071 glBegin(GL_QUADS);
1072 glVertex2i(x0, y0);
1073 glVertex2i(x1, y0);
1074 glVertex2i(x1, y1);
1075 glVertex2i(x0, y1);
1076 glEnd();
1077 //glRect(x, y, x+w, y+h);
1078 glColor4ub(1, 1, 1, 1);
1079 glDisable(GL_BLEND);
1080 //glBlendEquation(GL_FUNC_ADD);
1081 end;
1082
1083 procedure e_DarkenQuadWH (x, y, w, h: Integer; a: Integer);
1084 begin
1085 if (w > 0) and (h > 0) then e_DarkenQuad(x, y, x+w, y+h, a);
1086 end;
1087
1088
1089 procedure e_DrawLine(Width: Byte; X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
1090 begin
1091 if e_NoGraphics then Exit;
1092 // Pixel-perfect lines
1093 if Width = 1 then
1094 e_LineCorrection(X1, Y1, X2, Y2);
1095
1096 if Alpha > 0 then
1097 begin
1098 glEnable(GL_BLEND);
1099 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1100 end else
1101 glDisable(GL_BLEND);
1102
1103 glDisable(GL_TEXTURE_2D);
1104 glColor4ub(Red, Green, Blue, 255-Alpha);
1105 glLineWidth(Width);
1106 glBegin(GL_LINES);
1107 glVertex2i(X1, Y1);
1108 glVertex2i(X2, Y2);
1109 glEnd();
1110 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1111
1112 glDisable(GL_BLEND);
1113 end;
1114
1115 //------------------------------------------------------------------
1116 // Óäàëÿåò òåêñòóðó èç ìàññèâà
1117 //------------------------------------------------------------------
1118 procedure e_DeleteTexture(ID: DWORD);
1119 begin
1120 if not e_NoGraphics then
1121 glDeleteTextures(1, @e_Textures[ID].tx.id);
1122 e_Textures[ID].tx.id := 0;
1123 e_Textures[ID].tx.Width := 0;
1124 e_Textures[ID].tx.Height := 0;
1125 end;
1126
1127 //------------------------------------------------------------------
1128 // Óäàëÿåò âñå òåêñòóðû
1129 //------------------------------------------------------------------
1130 procedure e_RemoveAllTextures();
1131 var
1132 i: integer;
1133 begin
1134 if e_Textures = nil then Exit;
1135
1136 for i := 0 to High(e_Textures) do
1137 if e_Textures[i].tx.Width <> 0 then e_DeleteTexture(i);
1138 e_Textures := nil;
1139 end;
1140
1141 //------------------------------------------------------------------
1142 // Óäàëÿåò äâèæîê
1143 //------------------------------------------------------------------
1144 procedure e_ReleaseEngine();
1145 begin
1146 e_RemoveAllTextures;
1147 e_RemoveAllTextureFont;
1148 end;
1149
1150 procedure e_BeginRender();
1151 begin
1152 if e_NoGraphics then Exit;
1153 glEnable(GL_ALPHA_TEST);
1154 glAlphaFunc(GL_GREATER, 0.0);
1155 end;
1156
1157 procedure e_Clear(Mask: TGLbitfield; Red, Green, Blue: Single); overload;
1158 begin
1159 if e_NoGraphics then Exit;
1160 glClearColor(Red, Green, Blue, 0);
1161 glClear(Mask);
1162 end;
1163
1164 procedure e_Clear(); overload;
1165 begin
1166 if e_NoGraphics then Exit;
1167 glClearColor(0, 0, 0, 0);
1168 glClear(GL_COLOR_BUFFER_BIT);
1169 end;
1170
1171 procedure e_EndRender();
1172 begin
1173 if e_NoGraphics then Exit;
1174 glPopMatrix();
1175 end;
1176
1177 {$IFDEF USE_SDL2}
1178 function e_GetGamma(win: PSDL_Window): Byte;
1179 var
1180 ramp: array [0..256*3-1] of Word;
1181 rgb: array [0..2] of Double;
1182 sum: double;
1183 count: integer;
1184 min: integer;
1185 max: integer;
1186 A, B: double;
1187 i, j: integer;
1188 begin
1189 Result := 0;
1190 if e_NoGraphics then Exit;
1191 rgb[0] := 1.0;
1192 rgb[1] := 1.0;
1193 rgb[2] := 1.0;
1194
1195 SDL_GetWindowGammaRamp(win, @ramp[0], @ramp[256], @ramp[512]);
1196
1197 for i := 0 to 2 do
1198 begin
1199 sum := 0;
1200 count := 0;
1201 min := 256 * i;
1202 max := min + 256;
1203
1204 for j := min to max - 1 do
1205 if ramp[j] > 0 then
1206 begin
1207 B := (j mod 256)/256;
1208 A := ramp[j]/65536;
1209 sum := sum + ln(A)/ln(B);
1210 inc(count);
1211 end;
1212 rgb[i] := sum / count;
1213 end;
1214
1215 Result := 100 - Trunc(((rgb[0] + rgb[1] + rgb[2])/3 - 0.23) * 100/(2.7 - 0.23));
1216 end;
1217
1218 procedure e_SetGamma(win: PSDL_Window; Gamma: Byte);
1219 var
1220 ramp: array [0..256*3-1] of Word;
1221 i: integer;
1222 r: double;
1223 g: double;
1224 begin
1225 if e_NoGraphics then Exit;
1226 g := (100 - Gamma)*(2.7 - 0.23)/100 + 0.23;
1227
1228 for i := 0 to 255 do
1229 begin
1230 r := Exp(g * ln(i/256))*65536;
1231 if r < 0 then r := 0
1232 else if r > 65535 then r := 65535;
1233 ramp[i] := trunc(r);
1234 ramp[i + 256] := trunc(r);
1235 ramp[i + 512] := trunc(r);
1236 end;
1237
1238 SDL_SetWindowGammaRamp(win, @ramp[0], @ramp[256], @ramp[512]);
1239 end;
1240 {$ENDIF}
1241
1242 function e_CharFont_Create(sp: ShortInt=0): DWORD;
1243 var
1244 i, id: DWORD;
1245 begin
1246 e_WriteLog('Creating CharFont...', TMsgType.Notify);
1247
1248 id := DWORD(-1);
1249
1250 if e_CharFonts <> nil then
1251 for i := 0 to High(e_CharFonts) do
1252 if not e_CharFonts[i].alive then
1253 begin
1254 id := i;
1255 Break;
1256 end;
1257
1258 if id = DWORD(-1) then
1259 begin
1260 SetLength(e_CharFonts, Length(e_CharFonts) + 1);
1261 id := High(e_CharFonts);
1262 end;
1263
1264 with e_CharFonts[id] do
1265 begin
1266 for i := 0 to High(Chars) do
1267 with Chars[i] do
1268 begin
1269 TextureID := -1;
1270 Width := 0;
1271 end;
1272
1273 Space := sp;
1274 alive := True;
1275 end;
1276
1277 Result := id;
1278 end;
1279
1280 procedure e_CharFont_AddChar(FontID: DWORD; Texture: Integer; c: Char; w: Byte);
1281 begin
1282 with e_CharFonts[FontID].Chars[Ord(c)] do
1283 begin
1284 TextureID := Texture;
1285 Width := w;
1286 end;
1287 end;
1288
1289 procedure e_CharFont_Print(FontID: DWORD; X, Y: Integer; Text: string);
1290 var
1291 a: Integer;
1292 begin
1293 if e_NoGraphics then Exit;
1294 if Text = '' then Exit;
1295 if e_CharFonts = nil then Exit;
1296 if Integer(FontID) > High(e_CharFonts) then Exit;
1297
1298 with e_CharFonts[FontID] do
1299 begin
1300 for a := 1 to Length(Text) do
1301 with Chars[Ord(Text[a])] do
1302 if TextureID <> -1 then
1303 begin
1304 e_Draw(TextureID, X, Y, 0, True, False);
1305 X := X+Width+IfThen(a = Length(Text), 0, Space);
1306 end;
1307 end;
1308 end;
1309
1310 procedure e_CharFont_PrintEx(FontID: DWORD; X, Y: Integer; Text: string;
1311 Color: TRGB; Scale: Single = 1.0);
1312 var
1313 a: Integer;
1314 c: TRGB;
1315 begin
1316 if e_NoGraphics then Exit;
1317 if Text = '' then Exit;
1318 if e_CharFonts = nil then Exit;
1319 if Integer(FontID) > High(e_CharFonts) then Exit;
1320
1321 with e_CharFonts[FontID] do
1322 begin
1323 for a := 1 to Length(Text) do
1324 with Chars[Ord(Text[a])] do
1325 if TextureID <> -1 then
1326 begin
1327 if Scale <> 1.0 then
1328 begin
1329 glPushMatrix;
1330 glScalef(Scale, Scale, 0);
1331 end;
1332
1333 c := e_Colors;
1334 e_Colors := Color;
1335 e_Draw(TextureID, X, Y, 0, True, False);
1336 e_Colors := c;
1337
1338 if Scale <> 1.0 then glPopMatrix;
1339
1340 X := X+Width+IfThen(a = Length(Text), 0, Space);
1341 end;
1342 end;
1343 end;
1344
1345 procedure e_CharFont_PrintFmt(FontID: DWORD; X, Y: Integer; Text: string);
1346 var
1347 a, TX, TY, len: Integer;
1348 tc, c: TRGB;
1349 w, h: Word;
1350 begin
1351 if e_NoGraphics then Exit;
1352 if Text = '' then Exit;
1353 if e_CharFonts = nil then Exit;
1354 if Integer(FontID) > High(e_CharFonts) then Exit;
1355
1356 c.R := 255;
1357 c.G := 255;
1358 c.B := 255;
1359
1360 TX := X;
1361 TY := Y;
1362 len := Length(Text);
1363
1364 e_CharFont_GetSize(FontID, 'A', w, h);
1365
1366 with e_CharFonts[FontID] do
1367 begin
1368 for a := 1 to len do
1369 begin
1370 case Text[a] of
1371 #10: // line feed
1372 begin
1373 TX := X;
1374 TY := TY + h;
1375 continue;
1376 end;
1377 #1: // black
1378 begin
1379 c.R := 0; c.G := 0; c.B := 0;
1380 continue;
1381 end;
1382 #2: // white
1383 begin
1384 c.R := 255; c.G := 255; c.B := 255;
1385 continue;
1386 end;
1387 #3: // darker
1388 begin
1389 c.R := c.R div 2; c.G := c.G div 2; c.B := c.B div 2;
1390 continue;
1391 end;
1392 #4: // lighter
1393 begin
1394 c.R := Min(c.R * 2, 255); c.G := Min(c.G * 2, 255); c.B := Min(c.B * 2, 255);
1395 continue;
1396 end;
1397 #18: // red
1398 begin
1399 c.R := 255; c.G := 0; c.B := 0;
1400 continue;
1401 end;
1402 #19: // green
1403 begin
1404 c.R := 0; c.G := 255; c.B := 0;
1405 continue;
1406 end;
1407 #20: // blue
1408 begin
1409 c.R := 0; c.G := 0; c.B := 255;
1410 continue;
1411 end;
1412 #21: // yellow
1413 begin
1414 c.R := 255; c.G := 255; c.B := 0;
1415 continue;
1416 end;
1417 end;
1418
1419 with Chars[Ord(Text[a])] do
1420 if TextureID <> -1 then
1421 begin
1422 tc := e_Colors;
1423 e_Colors := c;
1424 e_Draw(TextureID, TX, TY, 0, True, False);
1425 e_Colors := tc;
1426
1427 TX := TX+Width+IfThen(a = Length(Text), 0, Space);
1428 end;
1429 end;
1430 end;
1431 end;
1432
1433 procedure e_CharFont_GetSize(FontID: DWORD; Text: string; var w, h: Word);
1434 var
1435 a: Integer;
1436 h2: Word;
1437 begin
1438 w := 0;
1439 h := 0;
1440
1441 if Text = '' then Exit;
1442 if e_CharFonts = nil then Exit;
1443 if Integer(FontID) > High(e_CharFonts) then Exit;
1444
1445 with e_CharFonts[FontID] do
1446 begin
1447 for a := 1 to Length(Text) do
1448 with Chars[Ord(Text[a])] do
1449 if TextureID <> -1 then
1450 begin
1451 w := w+Width+IfThen(a = Length(Text), 0, Space);
1452 e_GetTextureSize(TextureID, nil, @h2);
1453 if h2 > h then h := h2;
1454 end;
1455 end;
1456 end;
1457
1458 procedure e_CharFont_GetSizeFmt(FontID: DWORD; Text: string; var w, h: Word);
1459 var
1460 a, lines, len: Integer;
1461 h2, w2, tw, th: Word;
1462 begin
1463 w2 := 0;
1464 h2 := 0;
1465 tw := 0;
1466 th := 0;
1467
1468 if Text = '' then Exit;
1469 if e_CharFonts = nil then Exit;
1470 if Integer(FontID) > High(e_CharFonts) then Exit;
1471
1472 lines := 1;
1473 len := Length(Text);
1474
1475 with e_CharFonts[FontID] do
1476 begin
1477 for a := 1 to len do
1478 begin
1479 if Text[a] = #10 then
1480 begin
1481 Inc(lines);
1482 if w2 > tw then tw := w2;
1483 w2 := 0;
1484 continue;
1485 end;
1486
1487 with Chars[Ord(Text[a])] do
1488 if TextureID <> -1 then
1489 begin
1490 w2 := w2 + Width + IfThen(a = len, 0, Space);
1491 e_GetTextureSize(TextureID, nil, @h2);
1492 if h2 > th then th := h2;
1493 end;
1494 end;
1495 end;
1496
1497 if w2 > tw then
1498 tw := w2;
1499
1500 w := tw;
1501 h := th * lines;
1502 end;
1503
1504 function e_CharFont_GetMaxWidth(FontID: DWORD): Word;
1505 var
1506 a: Integer;
1507 begin
1508 Result := 0;
1509
1510 if e_CharFonts = nil then Exit;
1511 if Integer(FontID) > High(e_CharFonts) then Exit;
1512
1513 for a := 0 to High(e_CharFonts[FontID].Chars) do
1514 Result := Max(Result, e_CharFonts[FontID].Chars[a].Width);
1515 end;
1516
1517 function e_CharFont_GetMaxHeight(FontID: DWORD): Word;
1518 var
1519 a: Integer;
1520 h2: Word;
1521 begin
1522 Result := 0;
1523
1524 if e_CharFonts = nil then Exit;
1525 if Integer(FontID) > High(e_CharFonts) then Exit;
1526
1527 for a := 0 to High(e_CharFonts[FontID].Chars) do
1528 begin
1529 if e_CharFonts[FontID].Chars[a].TextureID <> -1 then
1530 e_GetTextureSize(e_CharFonts[FontID].Chars[a].TextureID, nil, @h2)
1531 else h2 := 0;
1532 if h2 > Result then Result := h2;
1533 end;
1534 end;
1535
1536 procedure e_CharFont_Remove(FontID: DWORD);
1537 var
1538 a: Integer;
1539 begin
1540 with e_CharFonts[FontID] do
1541 for a := 0 to High(Chars) do
1542 if Chars[a].TextureID <> -1 then e_DeleteTexture(Chars[a].TextureID);
1543
1544 e_CharFonts[FontID].alive := False;
1545 end;
1546
1547 procedure e_CharFont_RemoveAll();
1548 var
1549 a: Integer;
1550 begin
1551 if e_CharFonts = nil then Exit;
1552
1553 for a := 0 to High(e_CharFonts) do
1554 e_CharFont_Remove(a);
1555
1556 e_CharFonts := nil;
1557 end;
1558
1559 procedure e_TextureFontBuild(Tex: DWORD; var FontID: DWORD; XCount, YCount: Word;
1560 Space: ShortInt=0);
1561 var
1562 {$IFDEF NOGL_LISTS}
1563 loop1 : GLuint;
1564 cx, cy : real;
1565 {$ENDIF}
1566 i, id: DWORD;
1567 begin
1568 if e_NoGraphics then Exit;
1569 e_WriteLog('Creating texture font...', TMsgType.Notify);
1570
1571 id := DWORD(-1);
1572
1573 if e_TextureFonts <> nil then
1574 for i := 0 to High(e_TextureFonts) do
1575 if e_TextureFonts[i].Base = 0 then
1576 begin
1577 id := i;
1578 Break;
1579 end;
1580
1581 if id = DWORD(-1) then
1582 begin
1583 SetLength(e_TextureFonts, Length(e_TextureFonts) + 1);
1584 id := High(e_TextureFonts);
1585 end;
1586
1587 with e_TextureFonts[id] do
1588 begin
1589 {$IFDEF NOGL_LISTS}
1590 Base := glGenLists(XCount*YCount);
1591 {$ENDIF}
1592 TextureID := e_Textures[Tex].tx.id;
1593 CharWidth := (e_Textures[Tex].tx.Width div XCount)+Space;
1594 CharHeight := e_Textures[Tex].tx.Height div YCount;
1595 XC := XCount;
1596 YC := YCount;
1597 Texture := Tex;
1598 SPC := Space;
1599 end;
1600
1601 {$IFDEF NOGL_LISTS}
1602 glBindTexture(GL_TEXTURE_2D, e_Textures[Tex].tx.id);
1603 for loop1 := 0 to XCount*YCount-1 do
1604 begin
1605 cx := (loop1 mod XCount)/XCount;
1606 cy := (loop1 div YCount)/YCount;
1607
1608 glNewList(e_TextureFonts[id].Base+loop1, GL_COMPILE);
1609 glBegin(GL_QUADS);
1610 glTexCoord2f(cx, 1.0-cy-1/YCount);
1611 glVertex2i(0, e_Textures[Tex].tx.Height div YCount);
1612
1613 glTexCoord2f(cx+1/XCount, 1.0-cy-1/YCount);
1614 glVertex2i(e_Textures[Tex].tx.Width div XCount, e_Textures[Tex].tx.Height div YCount);
1615
1616 glTexCoord2f(cx+1/XCount, 1.0-cy);
1617 glVertex2i(e_Textures[Tex].tx.Width div XCount, 0);
1618
1619 glTexCoord2f(cx, 1.0-cy);
1620 glVertex2i(0, 0);
1621 glEnd();
1622 glTranslated((e_Textures[Tex].tx.Width div XCount)+Space, 0, 0);
1623 glEndList();
1624 end;
1625 {$ENDIF}
1626
1627 FontID := id;
1628 end;
1629
1630 procedure e_TextureFontKill(FontID: DWORD);
1631 begin
1632 if e_NoGraphics then Exit;
1633 {$IFDEF NOGL_LISTS}
1634 glDeleteLists(e_TextureFonts[FontID].Base, 256);
1635 {$ENDIF}
1636 e_TextureFonts[FontID].Base := 0;
1637 end;
1638
1639 {$IFNDEF NOGL_LISTS}
1640 procedure e_TextureFontDrawChar(ch: Char; FontID: DWORD);
1641 var
1642 index: Integer;
1643 cx, cy: GLfloat;
1644 Tex: Integer;
1645 Width, Height: Integer;
1646 XCount, YCount: Integer;
1647 begin
1648 index := Ord(ch) - 32;
1649 Tex := e_TextureFonts[FontID].Texture;
1650 Width := e_Textures[Tex].tx.Width;
1651 Height := e_Textures[Tex].tx.Height;
1652 XCount := e_TextureFonts[FontID].XC;
1653 YCount := e_TextureFonts[FontID].YC;
1654 cx := (index mod XCount)/XCount;
1655 cy := (index div YCount)/YCount;
1656 glBegin(GL_QUADS);
1657 glTexCoord2f(cx, 1 - cy - 1/YCount);
1658 glVertex2i(0, Height div YCount);
1659 glTexCoord2f(cx + 1/XCount, 1 - cy - 1/YCount);
1660 glVertex2i(Width div XCount, Height div YCount);
1661 glTexCoord2f(cx + 1/XCount, 1 - cy);
1662 glVertex2i(Width div XCount, 0);
1663 glTexCoord2f(cx, 1 - cy);
1664 glVertex2i(0, 0);
1665 glEnd();
1666 glTranslatef((e_Textures[Tex].tx.Width div XCount) + e_TextureFonts[FontID].SPC, 0, 0);
1667 end;
1668
1669 procedure e_TextureFontDrawString(Text: String; FontID: DWORD);
1670 var
1671 i: Integer;
1672 begin
1673 for i := 1 to High(Text) do
1674 e_TextureFontDrawChar(Text[i], FontID);
1675 end;
1676 {$ENDIF}
1677
1678 procedure e_TextureFontPrint(X, Y: GLint; Text: string; FontID: DWORD);
1679 begin
1680 if e_NoGraphics then Exit;
1681 if Integer(FontID) > High(e_TextureFonts) then Exit;
1682 if Text = '' then Exit;
1683
1684 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1685 glEnable(GL_BLEND);
1686
1687 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1688
1689 glPushMatrix;
1690 glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1691 glEnable(GL_TEXTURE_2D);
1692 glTranslatef(x, y, 0);
1693 {$IFDEF NOGL_LISTS}
1694 glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1695 glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1696 {$ELSE}
1697 e_TextureFontDrawString(Text, FontID);
1698 {$ENDIF}
1699 glDisable(GL_TEXTURE_2D);
1700 glPopMatrix;
1701
1702 glDisable(GL_BLEND);
1703 end;
1704
1705 // god forgive me for this, but i cannot figure out how to do it without lists
1706 procedure e_TextureFontPrintChar(X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
1707 begin
1708 if e_NoGraphics then Exit;
1709 glPushMatrix;
1710
1711 if Shadow then
1712 begin
1713 glColor4ub(0, 0, 0, 128);
1714 glTranslatef(X+1, Y+1, 0);
1715 {$IFDEF NOGL_LISTS}
1716 glCallLists(1, GL_UNSIGNED_BYTE, @Ch);
1717 {$ELSE}
1718 e_TextureFontDrawChar(Ch, FontID);
1719 {$ENDIF}
1720 glPopMatrix;
1721 glPushMatrix;
1722 end;
1723
1724 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1725 glTranslatef(X, Y, 0);
1726 {$IFDEF NOGL_LISTS}
1727 glCallLists(1, GL_UNSIGNED_BYTE, @Ch);
1728 {$ELSE}
1729 e_TextureFontDrawChar(Ch, FontID);
1730 {$ENDIF}
1731
1732 glPopMatrix;
1733 end;
1734
1735 procedure e_TextureFontPrintCharEx (X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
1736 begin
1737 glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1738 glEnable(GL_TEXTURE_2D);
1739 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1740
1741 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1742 glEnable(GL_BLEND);
1743 e_TextureFontPrintChar(X, Y, Ch, FontID, Shadow);
1744 glDisable(GL_TEXTURE_2D);
1745 glDisable(GL_BLEND);
1746 end;
1747
1748 function e_TextureFontCharWidth (ch: Char; FontID: DWORD): Integer;
1749 begin
1750 result := e_TextureFonts[FontID].CharWidth;
1751 end;
1752
1753 procedure e_TextureFontPrintFmt(X, Y: GLint; Text: string; FontID: DWORD;
1754 Shadow: Boolean = False; Newlines: Boolean = False);
1755 var
1756 a, TX, TY, len: Integer;
1757 tc, c: TRGB;
1758 w, h: Word;
1759 begin
1760 if e_NoGraphics then Exit;
1761 if Text = '' then Exit;
1762 if e_TextureFonts = nil then Exit;
1763 if Integer(FontID) > High(e_TextureFonts) then Exit;
1764
1765 c.R := 255;
1766 c.G := 255;
1767 c.B := 255;
1768
1769 TX := X;
1770 TY := Y;
1771 len := Length(Text);
1772
1773 w := e_TextureFonts[FontID].CharWidth;
1774 h := e_TextureFonts[FontID].CharHeight;
1775
1776 with e_TextureFonts[FontID] do
1777 begin
1778 glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1779 glEnable(GL_TEXTURE_2D);
1780
1781 {$IFDEF NOGL_LISTS}
1782 glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1783 {$ENDIF}
1784
1785 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1786 glEnable(GL_BLEND);
1787
1788 for a := 1 to len do
1789 begin
1790 case Text[a] of
1791 #10: // line feed
1792 begin
1793 if Newlines then
1794 begin
1795 TX := X;
1796 TY := TY + h;
1797 continue;
1798 end;
1799 end;
1800 #1: // black
1801 begin
1802 c.R := 0; c.G := 0; c.B := 0;
1803 continue;
1804 end;
1805 #2: // white
1806 begin
1807 c.R := 255; c.G := 255; c.B := 255;
1808 continue;
1809 end;
1810 #3: // darker
1811 begin
1812 c.R := c.R div 2; c.G := c.G div 2; c.B := c.B div 2;
1813 continue;
1814 end;
1815 #4: // lighter
1816 begin
1817 c.R := Min(c.R * 2, 255); c.G := Min(c.G * 2, 255); c.B := Min(c.B * 2, 255);
1818 continue;
1819 end;
1820 #18: // red
1821 begin
1822 c.R := 255; c.G := 0; c.B := 0;
1823 continue;
1824 end;
1825 #19: // green
1826 begin
1827 c.R := 0; c.G := 255; c.B := 0;
1828 continue;
1829 end;
1830 #20: // blue
1831 begin
1832 c.R := 0; c.G := 0; c.B := 255;
1833 continue;
1834 end;
1835 #21: // yellow
1836 begin
1837 c.R := 255; c.G := 255; c.B := 0;
1838 continue;
1839 end;
1840 end;
1841
1842 tc := e_Colors;
1843 e_Colors := c;
1844 e_TextureFontPrintChar(TX, TY, Text[a], FontID, Shadow);
1845 e_Colors := tc;
1846
1847 TX := TX+w;
1848 end;
1849 glDisable(GL_TEXTURE_2D);
1850 glDisable(GL_BLEND);
1851 end;
1852 end;
1853
1854 procedure e_TextureFontPrintEx(X, Y: GLint; Text: string; FontID: DWORD; Red, Green,
1855 Blue: Byte; Scale: Single; Shadow: Boolean = False);
1856 begin
1857 if e_NoGraphics then Exit;
1858 if Text = '' then Exit;
1859
1860 glPushMatrix;
1861 glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1862 glEnable(GL_TEXTURE_2D);
1863
1864 {$IFDEF NOGL_LISTS}
1865 glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1866 {$ENDIF}
1867
1868 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1869 glEnable(GL_BLEND);
1870
1871 if Shadow then
1872 begin
1873 glColor4ub(0, 0, 0, 128);
1874 glTranslatef(x+1, y+1, 0);
1875 glScalef(Scale, Scale, 0);
1876 {$IFDEF NOGL_LISTS}
1877 glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1878 {$ELSE}
1879 e_TextureFontDrawString(Text, FontID);
1880 {$ENDIF}
1881 glPopMatrix;
1882 glPushMatrix;
1883 end;
1884
1885 glColor4ub(Red, Green, Blue, 255);
1886 glTranslatef(x, y, 0);
1887 glScalef(Scale, Scale, 0);
1888 {$IFDEF NOGL_LISTS}
1889 glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1890 {$ELSE}
1891 e_TextureFontDrawString(Text, FontID);
1892 {$ENDIF}
1893
1894 glDisable(GL_TEXTURE_2D);
1895 glPopMatrix;
1896 glColor3ub(e_Colors.R, e_Colors.G, e_Colors.B);
1897 glDisable(GL_BLEND);
1898 end;
1899
1900 procedure e_TextureFontGetSize(ID: DWORD; out CharWidth, CharHeight: Byte);
1901 begin
1902 CharWidth := 16;
1903 CharHeight := 16;
1904 if e_NoGraphics then Exit;
1905 if Integer(ID) > High(e_TextureFonts) then
1906 Exit;
1907 CharWidth := e_TextureFonts[ID].CharWidth;
1908 CharHeight := e_TextureFonts[ID].CharHeight;
1909 end;
1910
1911 procedure e_RemoveAllTextureFont();
1912 var
1913 i: integer;
1914 begin
1915 if e_NoGraphics then Exit;
1916 if e_TextureFonts = nil then Exit;
1917
1918 for i := 0 to High(e_TextureFonts) do
1919 if e_TextureFonts[i].Base <> 0 then
1920 begin
1921 {$IFDEF NOGL_LISTS}
1922 glDeleteLists(e_TextureFonts[i].Base, 256);
1923 {$ENDIF}
1924 e_TextureFonts[i].Base := 0;
1925 end;
1926
1927 e_TextureFonts := nil;
1928 end;
1929
1930 function _RGB(Red, Green, Blue: Byte): TRGB;
1931 begin
1932 Result.R := Red;
1933 Result.G := Green;
1934 Result.B := Blue;
1935 end;
1936
1937 function _Point(X, Y: Integer): TPoint2i;
1938 begin
1939 Result.X := X;
1940 Result.Y := Y;
1941 end;
1942
1943 function _Rect(X, Y: Integer; Width, Height: Word): TRectWH;
1944 begin
1945 Result.X := X;
1946 Result.Y := Y;
1947 Result.Width := Width;
1948 Result.Height := Height;
1949 end;
1950
1951 function _TRect(L, T, R, B: LongInt): TRect;
1952 begin
1953 Result.Top := T;
1954 Result.Left := L;
1955 Result.Right := R;
1956 Result.Bottom := B;
1957 end;
1958
1959
1960 procedure e_MakeScreenshot (st: TStream; Width, Height: Word);
1961 var
1962 pixels, obuf, scln, ps, pd: PByte;
1963 obufsize: Integer;
1964 dlen: Cardinal;
1965 i, x, y, res: Integer;
1966 sign: array [0..7] of Byte;
1967 hbuf: array [0..12] of Byte;
1968 crc: LongWord;
1969 img: TImageData;
1970 clr: TColor32Rec;
1971 begin
1972 if e_NoGraphics then Exit;
1973 obuf := nil;
1974
1975 // first, extract and pack graphics data
1976 if (Width mod 4) > 0 then Width := Width+4-(Width mod 4);
1977
1978 GetMem(pixels, Width*Height*3);
1979 try
1980 FillChar(pixels^, Width*Height*3, 0);
1981 glReadPixels(0, 0, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pixels);
1982 //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
1983
1984 if e_FastScreenshots then
1985 begin
1986 // create scanlines
1987 GetMem(scln, (Width*3+1)*Height);
1988 try
1989 ps := pixels;
1990 pd := scln;
1991 Inc(ps, (Width*3)*(Height-1));
1992 for i := 0 to Height-1 do
1993 begin
1994 pd^ := 0; // filter
1995 Inc(pd);
1996 Move(ps^, pd^, Width*3);
1997 Dec(ps, Width*3);
1998 Inc(pd, Width*3);
1999 end;
2000 except
2001 FreeMem(scln);
2002 raise;
2003 end;
2004 FreeMem(pixels);
2005 pixels := scln;
2006
2007 // pack it
2008 obufsize := (Width*3+1)*Height*2;
2009 GetMem(obuf, obufsize);
2010 try
2011 while true do
2012 begin
2013 dlen := obufsize;
2014 res := compress2(Pointer(obuf), dlen, Pointer(pixels), (Width*3+1)*Height, 9);
2015 if res = Z_OK then break;
2016 if res <> Z_BUF_ERROR then raise Exception.Create('can''t pack data for PNG');
2017 obufsize := obufsize*2;
2018 FreeMem(obuf);
2019 obuf := nil;
2020 GetMem(obuf, obufsize);
2021 end;
2022 //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
2023
2024 // now write PNG
2025
2026 // signature
2027 sign[0] := 137;
2028 sign[1] := 80;
2029 sign[2] := 78;
2030 sign[3] := 71;
2031 sign[4] := 13;
2032 sign[5] := 10;
2033 sign[6] := 26;
2034 sign[7] := 10;
2035 st.writeBuffer(sign, 8);
2036 //e_WriteLog('PNG: signature written', MSG_NOTIFY);
2037
2038 // header
2039 writeIntBE(st, LongWord(13));
2040 sign[0] := 73;
2041 sign[1] := 72;
2042 sign[2] := 68;
2043 sign[3] := 82;
2044 st.writeBuffer(sign, 4);
2045 crc := crc32(0, @sign[0], 4);
2046 hbuf[0] := 0;
2047 hbuf[1] := 0;
2048 hbuf[2] := (Width shr 8) and $ff;
2049 hbuf[3] := Width and $ff;
2050 hbuf[4] := 0;
2051 hbuf[5] := 0;
2052 hbuf[6] := (Height shr 8) and $ff;
2053 hbuf[7] := Height and $ff;
2054 hbuf[8] := 8; // bit depth
2055 hbuf[9] := 2; // RGB
2056 hbuf[10] := 0; // compression method
2057 hbuf[11] := 0; // filter method
2058 hbuf[12] := 0; // no interlace
2059 crc := crc32(crc, @hbuf[0], 13);
2060 st.writeBuffer(hbuf, 13);
2061 writeIntBE(st, crc);
2062 //e_WriteLog('PNG: header written', MSG_NOTIFY);
2063
2064 // image data
2065 writeIntBE(st, LongWord(dlen));
2066 sign[0] := 73;
2067 sign[1] := 68;
2068 sign[2] := 65;
2069 sign[3] := 84;
2070 st.writeBuffer(sign, 4);
2071 crc := crc32(0, @sign[0], 4);
2072 crc := crc32(crc, obuf, dlen);
2073 st.writeBuffer(obuf^, dlen);
2074 writeIntBE(st, crc);
2075 //e_WriteLog('PNG: image data written', MSG_NOTIFY);
2076
2077 // image data end
2078 writeIntBE(st, LongWord(0));
2079 sign[0] := 73;
2080 sign[1] := 69;
2081 sign[2] := 78;
2082 sign[3] := 68;
2083 st.writeBuffer(sign, 4);
2084 crc := crc32(0, @sign[0], 4);
2085 writeIntBE(st, crc);
2086 //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
2087 finally
2088 if obuf <> nil then FreeMem(obuf);
2089 end;
2090 end
2091 else
2092 begin
2093 Imaging.SetOption(ImagingPNGCompressLevel, 9);
2094 Imaging.SetOption(ImagingPNGPreFilter, 6);
2095 InitImage(img);
2096 try
2097 NewImage(Width, Height, TImageFormat.ifR8G8B8, img);
2098 ps := pixels;
2099 //writeln(stderr, 'moving pixels...');
2100 for y := Height-1 downto 0 do
2101 begin
2102 for x := 0 to Width-1 do
2103 begin
2104 clr.r := ps^; Inc(ps);
2105 clr.g := ps^; Inc(ps);
2106 clr.b := ps^; Inc(ps);
2107 clr.a := 255;
2108 SetPixel32(img, x, y, clr);
2109 end;
2110 end;
2111 GlobalMetadata.ClearMetaItems();
2112 GlobalMetadata.ClearMetaItemsForSaving();
2113 //writeln(stderr, 'compressing image...');
2114 if not SaveImageToStream('png', st, img) then raise Exception.Create('screenshot writing error');
2115 //writeln(stderr, 'done!');
2116 finally
2117 FreeImage(img);
2118 end;
2119 end;
2120 finally
2121 FreeMem(pixels);
2122 end;
2123 end;
2124
2125
2126 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024