DEADSOFTWARE

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