DEADSOFTWARE

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


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