DEADSOFTWARE

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