DEADSOFTWARE

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