DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
untested code for NPOT resizing panels
[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 wassc: Boolean;
714 scxywh: array[0..3] of GLint;
715 vpxywh: array[0..3] of GLint;
716 w, h, dw: Integer;
717 u, v: Single;
718
719 procedure setScissorGLInternal (x, y, w, h: Integer);
720 begin
721 //if not scallowed then exit;
722 x := trunc(x*scale);
723 y := trunc(y*scale);
724 w := trunc(w*scale);
725 h := trunc(h*scale);
726 y := vpxywh[3]-(y+h);
727 if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then glScissor(0, 0, 0, 0) else glScissor(x, y, w, h);
728 end;
729
730 begin
731 if e_NoGraphics then exit;
732
733 if (wdt < 1) or (hgt < 1) then exit;
734
735 if (wdt mod e_Textures[ID].tx.width = 0) and (hgt mod e_Textures[ID].tx.height = 0) then
736 begin
737 e_DrawFill(id, x, y, wdt div e_Textures[ID].tx.width, hgt div e_Textures[ID].tx.height, alpha, alphachannel, blending);
738 exit;
739 end;
740
741 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
742
743 if (Alpha > 0) or AlphaChannel or Blending then
744 glEnable(GL_BLEND)
745 else
746 glDisable(GL_BLEND);
747
748 if AlphaChannel or (Alpha > 0) then glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
749
750 if (Alpha > 0) then glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
751
752 if Blending then glBlendFunc(GL_SRC_ALPHA, GL_ONE);
753
754 glEnable(GL_TEXTURE_2D);
755 glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
756
757 x2 := x+wdt;
758 y2 := y+hgt;
759
760 //k8: this SHOULD work... i hope
761 if (e_Textures[ID].tx.width = e_Textures[ID].tx.glwidth) and (e_Textures[ID].tx.height = e_Textures[ID].tx.glheight) then
762 begin
763 glBegin(GL_QUADS);
764 glTexCoord2f(0, hgt/e_Textures[ID].tx.height); glVertex2i(x, y);
765 glTexCoord2f(wdt/e_Textures[ID].tx.width, hgt/e_Textures[ID].tx.height); glVertex2i(x2, y);
766 glTexCoord2f(wdt/e_Textures[ID].tx.width, 0); glVertex2i(x2, y2);
767 glTexCoord2f(0, 0); glVertex2i(x, y2);
768 glEnd();
769 end
770 else
771 begin
772 // hard day's night; setup scissor
773 glGetIntegerv(GL_VIEWPORT, @vpxywh[0]);
774 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
775 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
776 //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
777 glEnable(GL_SCISSOR_TEST);
778 setScissorGLInternal(x, y, wdt, hgt);
779 // draw quads
780 u := e_Textures[ID].tx.u;
781 v := e_Textures[ID].tx.v;
782 w := e_Textures[ID].tx.width;
783 h := e_Textures[ID].tx.height;
784 x2 := x;
785 glBegin(GL_QUADS);
786 while (hgt > 0) do
787 begin
788 Dec(hgt, h);
789 dw := wdt;
790 x := x2;
791 while (dw > 0) do
792 begin
793 Dec(dw, w);
794 glTexCoord2f(0, v); glVertex2i(X, Y);
795 glTexCoord2f(u, v); glVertex2i(X+w, Y);
796 glTexCoord2f(u, 0); glVertex2i(X+w, Y+h);
797 glTexCoord2f(0, 0); glVertex2i(X, Y+h);
798 Inc(X, w);
799 end;
800 Inc(Y, h);
801 Dec(hgt, h);
802 end;
803 glEnd();
804 if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
805 end;
806
807 glDisable(GL_BLEND);
808 end;
809
810
811 procedure e_DrawAdv(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
812 Blending: Boolean; Angle: Single; RC: PDFPoint; Mirror: TMirrorType = M_NONE);
813 begin
814 if e_NoGraphics then Exit;
815
816 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
817
818 if (Alpha > 0) or (AlphaChannel) or (Blending) then
819 glEnable(GL_BLEND)
820 else
821 glDisable(GL_BLEND);
822
823 if (AlphaChannel) or (Alpha > 0) then
824 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
825
826 if Alpha > 0 then
827 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
828
829 if Blending then
830 glBlendFunc(GL_SRC_ALPHA, GL_ONE);
831
832 if (Angle <> 0) and (RC <> nil) then
833 begin
834 glPushMatrix();
835 glTranslatef(X+RC.X, Y+RC.Y, 0);
836 glRotatef(Angle, 0, 0, 1);
837 glTranslatef(-(X+RC.X), -(Y+RC.Y), 0);
838 end;
839
840 glEnable(GL_TEXTURE_2D);
841 glBindTexture(GL_TEXTURE_2D, e_Textures[id].tx.id);
842 glBegin(GL_QUADS); //0-1 1-1
843 //00 10
844 drawTxQuad(X, Y, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
845 glEnd();
846
847 if Angle <> 0 then
848 glPopMatrix();
849
850 glDisable(GL_BLEND);
851 end;
852
853 procedure e_DrawPoint(Size: Byte; X, Y: Integer; Red, Green, Blue: Byte);
854 begin
855 if e_NoGraphics then Exit;
856 glDisable(GL_TEXTURE_2D);
857 glColor3ub(Red, Green, Blue);
858 glPointSize(Size);
859
860 if (Size = 2) or (Size = 4) then
861 X := X + 1;
862
863 glBegin(GL_POINTS);
864 glVertex2f(X+0.3, Y+1.0);
865 glEnd();
866
867 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
868 end;
869
870 procedure e_LineCorrection(var X1, Y1, X2, Y2: Integer);
871 begin
872 // Make lines only top-left/bottom-right and top-right/bottom-left
873 if Y2 < Y1 then
874 begin
875 X1 := X1 xor X2;
876 X2 := X1 xor X2;
877 X1 := X1 xor X2;
878
879 Y1 := Y1 xor Y2;
880 Y2 := Y1 xor Y2;
881 Y1 := Y1 xor Y2;
882 end;
883
884 // Pixel-perfect hack
885 if X1 < X2 then
886 Inc(X2)
887 else
888 Inc(X1);
889 Inc(Y2);
890 end;
891
892 procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
893 var
894 nX1, nY1, nX2, nY2: Integer;
895 begin
896 if e_NoGraphics then Exit;
897 // Only top-left/bottom-right quad
898 if X1 > X2 then
899 begin
900 X1 := X1 xor X2;
901 X2 := X1 xor X2;
902 X1 := X1 xor X2;
903 end;
904 if Y1 > Y2 then
905 begin
906 Y1 := Y1 xor Y2;
907 Y2 := Y1 xor Y2;
908 Y1 := Y1 xor Y2;
909 end;
910
911 if Alpha > 0 then
912 begin
913 glEnable(GL_BLEND);
914 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
915 end else
916 glDisable(GL_BLEND);
917
918 glDisable(GL_TEXTURE_2D);
919 glColor4ub(Red, Green, Blue, 255-Alpha);
920 glLineWidth(1);
921
922 glBegin(GL_LINES);
923 nX1 := X1; nY1 := Y1;
924 nX2 := X2; nY2 := Y1;
925 e_LineCorrection(nX1, nY1, nX2, nY2); // Pixel-perfect lines
926 glVertex2i(nX1, nY1);
927 glVertex2i(nX2, nY2);
928
929 nX1 := X2; nY1 := Y1;
930 nX2 := X2; nY2 := Y2;
931 e_LineCorrection(nX1, nY1, nX2, nY2);
932 glVertex2i(nX1, nY1);
933 glVertex2i(nX2, nY2);
934
935 nX1 := X2; nY1 := Y2;
936 nX2 := X1; nY2 := Y2;
937 e_LineCorrection(nX1, nY1, nX2, nY2);
938 glVertex2i(nX1, nY1);
939 glVertex2i(nX2, nY2);
940
941 nX1 := X1; nY1 := Y2;
942 nX2 := X1; nY2 := Y1;
943 e_LineCorrection(nX1, nY1, nX2, nY2);
944 glVertex2i(nX1, nY1);
945 glVertex2i(nX2, nY2);
946 glEnd();
947
948 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
949
950 glDisable(GL_BLEND);
951 end;
952
953 procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte;
954 Blending: TBlending = B_NONE);
955 begin
956 if e_NoGraphics then Exit;
957 if (Alpha > 0) or (Blending <> B_NONE) then
958 glEnable(GL_BLEND)
959 else
960 glDisable(GL_BLEND);
961
962 if Blending = B_BLEND then
963 glBlendFunc(GL_SRC_ALPHA, GL_ONE)
964 else
965 if Blending = B_FILTER then
966 glBlendFunc(GL_DST_COLOR, GL_SRC_COLOR)
967 else
968 if Blending = B_INVERT then
969 glBlendFunc(GL_ONE_MINUS_DST_COLOR, GL_ZERO)
970 else
971 if Alpha > 0 then
972 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
973
974 glDisable(GL_TEXTURE_2D);
975 glColor4ub(Red, Green, Blue, 255-Alpha);
976
977 X2 := X2 + 1;
978 Y2 := Y2 + 1;
979
980 glBegin(GL_QUADS);
981 glVertex2i(X1, Y1);
982 glVertex2i(X2, Y1);
983 glVertex2i(X2, Y2);
984 glVertex2i(X1, Y2);
985 glEnd();
986
987 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
988
989 glDisable(GL_BLEND);
990 end;
991
992
993 // ////////////////////////////////////////////////////////////////////////// //
994 procedure e_DarkenQuad (x0, y0, x1, y1: Integer; a: Integer);
995 begin
996 if (a < 0) then a := 0;
997 if (a > 255) then a := 255;
998 glEnable(GL_BLEND);
999 glBlendFunc(GL_ZERO, GL_SRC_ALPHA);
1000 glDisable(GL_TEXTURE_2D);
1001 glColor4ub(0, 0, 0, Byte(255-a));
1002 glBegin(GL_QUADS);
1003 glVertex2i(x0, y0);
1004 glVertex2i(x1, y0);
1005 glVertex2i(x1, y1);
1006 glVertex2i(x0, y1);
1007 glEnd();
1008 //glRect(x, y, x+w, y+h);
1009 glColor4ub(1, 1, 1, 1);
1010 glDisable(GL_BLEND);
1011 //glBlendEquation(GL_FUNC_ADD);
1012 end;
1013
1014 procedure e_DarkenQuadWH (x, y, w, h: Integer; a: Integer);
1015 begin
1016 if (w > 0) and (h > 0) then e_DarkenQuad(x, y, x+w, y+h, a);
1017 end;
1018
1019
1020 procedure e_DrawLine(Width: Byte; X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
1021 begin
1022 if e_NoGraphics then Exit;
1023 // Pixel-perfect lines
1024 if Width = 1 then
1025 e_LineCorrection(X1, Y1, X2, Y2);
1026
1027 if Alpha > 0 then
1028 begin
1029 glEnable(GL_BLEND);
1030 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1031 end else
1032 glDisable(GL_BLEND);
1033
1034 glDisable(GL_TEXTURE_2D);
1035 glColor4ub(Red, Green, Blue, 255-Alpha);
1036 glLineWidth(Width);
1037
1038 glBegin(GL_LINES);
1039 glVertex2i(X1, Y1);
1040 glVertex2i(X2, Y2);
1041 glEnd();
1042
1043 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1044
1045 glDisable(GL_BLEND);
1046 end;
1047
1048 //------------------------------------------------------------------
1049 // Óäàëÿåò òåêñòóðó èç ìàññèâà
1050 //------------------------------------------------------------------
1051 procedure e_DeleteTexture(ID: DWORD);
1052 begin
1053 if not e_NoGraphics then
1054 glDeleteTextures(1, @e_Textures[ID].tx.id);
1055 e_Textures[ID].tx.id := 0;
1056 e_Textures[ID].tx.Width := 0;
1057 e_Textures[ID].tx.Height := 0;
1058 end;
1059
1060 //------------------------------------------------------------------
1061 // Óäàëÿåò âñå òåêñòóðû
1062 //------------------------------------------------------------------
1063 procedure e_RemoveAllTextures();
1064 var
1065 i: integer;
1066 begin
1067 if e_Textures = nil then Exit;
1068
1069 for i := 0 to High(e_Textures) do
1070 if e_Textures[i].tx.Width <> 0 then e_DeleteTexture(i);
1071 e_Textures := nil;
1072 end;
1073
1074 //------------------------------------------------------------------
1075 // Óäàëÿåò äâèæîê
1076 //------------------------------------------------------------------
1077 procedure e_ReleaseEngine();
1078 begin
1079 e_RemoveAllTextures;
1080 e_RemoveAllTextureFont;
1081 end;
1082
1083 procedure e_BeginRender();
1084 begin
1085 if e_NoGraphics then Exit;
1086 glEnable(GL_ALPHA_TEST);
1087 glAlphaFunc(GL_GREATER, 0.0);
1088 end;
1089
1090 procedure e_Clear(Mask: TGLbitfield; Red, Green, Blue: Single); overload;
1091 begin
1092 if e_NoGraphics then Exit;
1093 glClearColor(Red, Green, Blue, 0);
1094 glClear(Mask);
1095 end;
1096
1097 procedure e_Clear(); overload;
1098 begin
1099 if e_NoGraphics then Exit;
1100 glClearColor(0, 0, 0, 0);
1101 glClear(GL_COLOR_BUFFER_BIT);
1102 end;
1103
1104 procedure e_EndRender();
1105 begin
1106 if e_NoGraphics then Exit;
1107 glPopMatrix();
1108 end;
1109
1110 function e_GetGamma(win: PSDL_Window): Byte;
1111 var
1112 ramp: array [0..256*3-1] of Word;
1113 rgb: array [0..2] of Double;
1114 sum: double;
1115 count: integer;
1116 min: integer;
1117 max: integer;
1118 A, B: double;
1119 i, j: integer;
1120 begin
1121 Result := 0;
1122 if e_NoGraphics then Exit;
1123 rgb[0] := 1.0;
1124 rgb[1] := 1.0;
1125 rgb[2] := 1.0;
1126
1127 SDL_GetWindowGammaRamp(win, @ramp[0], @ramp[256], @ramp[512]);
1128
1129 for i := 0 to 2 do
1130 begin
1131 sum := 0;
1132 count := 0;
1133 min := 256 * i;
1134 max := min + 256;
1135
1136 for j := min to max - 1 do
1137 if ramp[j] > 0 then
1138 begin
1139 B := (j mod 256)/256;
1140 A := ramp[j]/65536;
1141 sum := sum + ln(A)/ln(B);
1142 inc(count);
1143 end;
1144 rgb[i] := sum / count;
1145 end;
1146
1147 Result := 100 - Trunc(((rgb[0] + rgb[1] + rgb[2])/3 - 0.23) * 100/(2.7 - 0.23));
1148 end;
1149
1150 procedure e_SetGamma(win: PSDL_Window; Gamma: Byte);
1151 var
1152 ramp: array [0..256*3-1] of Word;
1153 i: integer;
1154 r: double;
1155 g: double;
1156 begin
1157 if e_NoGraphics then Exit;
1158 g := (100 - Gamma)*(2.7 - 0.23)/100 + 0.23;
1159
1160 for i := 0 to 255 do
1161 begin
1162 r := Exp(g * ln(i/256))*65536;
1163 if r < 0 then r := 0
1164 else if r > 65535 then r := 65535;
1165 ramp[i] := trunc(r);
1166 ramp[i + 256] := trunc(r);
1167 ramp[i + 512] := trunc(r);
1168 end;
1169
1170 SDL_SetWindowGammaRamp(win, @ramp[0], @ramp[256], @ramp[512]);
1171 end;
1172
1173 function e_CharFont_Create(sp: ShortInt=0): DWORD;
1174 var
1175 i, id: DWORD;
1176 begin
1177 e_WriteLog('Creating CharFont...', MSG_NOTIFY);
1178
1179 id := DWORD(-1);
1180
1181 if e_CharFonts <> nil then
1182 for i := 0 to High(e_CharFonts) do
1183 if not e_CharFonts[i].alive then
1184 begin
1185 id := i;
1186 Break;
1187 end;
1188
1189 if id = DWORD(-1) then
1190 begin
1191 SetLength(e_CharFonts, Length(e_CharFonts) + 1);
1192 id := High(e_CharFonts);
1193 end;
1194
1195 with e_CharFonts[id] do
1196 begin
1197 for i := 0 to High(Chars) do
1198 with Chars[i] do
1199 begin
1200 TextureID := -1;
1201 Width := 0;
1202 end;
1203
1204 Space := sp;
1205 alive := True;
1206 end;
1207
1208 Result := id;
1209 end;
1210
1211 procedure e_CharFont_AddChar(FontID: DWORD; Texture: Integer; c: Char; w: Byte);
1212 begin
1213 with e_CharFonts[FontID].Chars[Ord(c)] do
1214 begin
1215 TextureID := Texture;
1216 Width := w;
1217 end;
1218 end;
1219
1220 procedure e_CharFont_Print(FontID: DWORD; X, Y: Integer; Text: string);
1221 var
1222 a: Integer;
1223 begin
1224 if e_NoGraphics then Exit;
1225 if Text = '' then Exit;
1226 if e_CharFonts = nil then Exit;
1227 if Integer(FontID) > High(e_CharFonts) then Exit;
1228
1229 with e_CharFonts[FontID] do
1230 begin
1231 for a := 1 to Length(Text) do
1232 with Chars[Ord(Text[a])] do
1233 if TextureID <> -1 then
1234 begin
1235 e_Draw(TextureID, X, Y, 0, True, False);
1236 X := X+Width+IfThen(a = Length(Text), 0, Space);
1237 end;
1238 end;
1239 end;
1240
1241 procedure e_CharFont_PrintEx(FontID: DWORD; X, Y: Integer; Text: string;
1242 Color: TRGB; Scale: Single = 1.0);
1243 var
1244 a: Integer;
1245 c: TRGB;
1246 begin
1247 if e_NoGraphics then Exit;
1248 if Text = '' then Exit;
1249 if e_CharFonts = nil then Exit;
1250 if Integer(FontID) > High(e_CharFonts) then Exit;
1251
1252 with e_CharFonts[FontID] do
1253 begin
1254 for a := 1 to Length(Text) do
1255 with Chars[Ord(Text[a])] do
1256 if TextureID <> -1 then
1257 begin
1258 if Scale <> 1.0 then
1259 begin
1260 glPushMatrix;
1261 glScalef(Scale, Scale, 0);
1262 end;
1263
1264 c := e_Colors;
1265 e_Colors := Color;
1266 e_Draw(TextureID, X, Y, 0, True, False);
1267 e_Colors := c;
1268
1269 if Scale <> 1.0 then glPopMatrix;
1270
1271 X := X+Width+IfThen(a = Length(Text), 0, Space);
1272 end;
1273 end;
1274 end;
1275
1276 procedure e_CharFont_PrintFmt(FontID: DWORD; X, Y: Integer; Text: string);
1277 var
1278 a, TX, TY, len: Integer;
1279 tc, c: TRGB;
1280 w, h: Word;
1281 begin
1282 if e_NoGraphics then Exit;
1283 if Text = '' then Exit;
1284 if e_CharFonts = nil then Exit;
1285 if Integer(FontID) > High(e_CharFonts) then Exit;
1286
1287 c.R := 255;
1288 c.G := 255;
1289 c.B := 255;
1290
1291 TX := X;
1292 TY := Y;
1293 len := Length(Text);
1294
1295 e_CharFont_GetSize(FontID, 'A', w, h);
1296
1297 with e_CharFonts[FontID] do
1298 begin
1299 for a := 1 to len do
1300 begin
1301 case Text[a] of
1302 #10: // line feed
1303 begin
1304 TX := X;
1305 TY := TY + h;
1306 continue;
1307 end;
1308 #1: // black
1309 begin
1310 c.R := 0; c.G := 0; c.B := 0;
1311 continue;
1312 end;
1313 #2: // white
1314 begin
1315 c.R := 255; c.G := 255; c.B := 255;
1316 continue;
1317 end;
1318 #3: // darker
1319 begin
1320 c.R := c.R div 2; c.G := c.G div 2; c.B := c.B div 2;
1321 continue;
1322 end;
1323 #4: // lighter
1324 begin
1325 c.R := Min(c.R * 2, 255); c.G := Min(c.G * 2, 255); c.B := Min(c.B * 2, 255);
1326 continue;
1327 end;
1328 #18: // red
1329 begin
1330 c.R := 255; c.G := 0; c.B := 0;
1331 continue;
1332 end;
1333 #19: // green
1334 begin
1335 c.R := 0; c.G := 255; c.B := 0;
1336 continue;
1337 end;
1338 #20: // blue
1339 begin
1340 c.R := 0; c.G := 0; c.B := 255;
1341 continue;
1342 end;
1343 #21: // yellow
1344 begin
1345 c.R := 255; c.G := 255; c.B := 0;
1346 continue;
1347 end;
1348 end;
1349
1350 with Chars[Ord(Text[a])] do
1351 if TextureID <> -1 then
1352 begin
1353 tc := e_Colors;
1354 e_Colors := c;
1355 e_Draw(TextureID, TX, TY, 0, True, False);
1356 e_Colors := tc;
1357
1358 TX := TX+Width+IfThen(a = Length(Text), 0, Space);
1359 end;
1360 end;
1361 end;
1362 end;
1363
1364 procedure e_CharFont_GetSize(FontID: DWORD; Text: string; var w, h: Word);
1365 var
1366 a: Integer;
1367 h2: Word;
1368 begin
1369 w := 0;
1370 h := 0;
1371
1372 if Text = '' then Exit;
1373 if e_CharFonts = nil then Exit;
1374 if Integer(FontID) > High(e_CharFonts) then Exit;
1375
1376 with e_CharFonts[FontID] do
1377 begin
1378 for a := 1 to Length(Text) do
1379 with Chars[Ord(Text[a])] do
1380 if TextureID <> -1 then
1381 begin
1382 w := w+Width+IfThen(a = Length(Text), 0, Space);
1383 e_GetTextureSize(TextureID, nil, @h2);
1384 if h2 > h then h := h2;
1385 end;
1386 end;
1387 end;
1388
1389 procedure e_CharFont_GetSizeFmt(FontID: DWORD; Text: string; var w, h: Word);
1390 var
1391 a, lines, len: Integer;
1392 h2, w2: Word;
1393 begin
1394 w2 := 0;
1395 w := 0;
1396 h := 0;
1397
1398 if Text = '' then Exit;
1399 if e_CharFonts = nil then Exit;
1400 if Integer(FontID) > High(e_CharFonts) then Exit;
1401
1402 lines := 1;
1403 len := Length(Text);
1404
1405 with e_CharFonts[FontID] do
1406 begin
1407 for a := 1 to len do
1408 begin
1409 if Text[a] = #10 then
1410 begin
1411 Inc(lines);
1412 if w2 > w then
1413 begin
1414 w := w2;
1415 w2 := 0;
1416 end;
1417 continue;
1418 end
1419 else if Text[a] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1420 continue;
1421
1422 with Chars[Ord(Text[a])] do
1423 if TextureID <> -1 then
1424 begin
1425 w2 := w2 + Width + IfThen(a = len, 0, Space);
1426 e_GetTextureSize(TextureID, nil, @h2);
1427 if h2 > h then h := h2;
1428 end;
1429 end;
1430 end;
1431
1432 if w2 > w then
1433 w := w2;
1434 h := h * lines;
1435 end;
1436
1437 function e_CharFont_GetMaxWidth(FontID: DWORD): Word;
1438 var
1439 a: Integer;
1440 begin
1441 Result := 0;
1442
1443 if e_CharFonts = nil then Exit;
1444 if Integer(FontID) > High(e_CharFonts) then Exit;
1445
1446 for a := 0 to High(e_CharFonts[FontID].Chars) do
1447 Result := Max(Result, e_CharFonts[FontID].Chars[a].Width);
1448 end;
1449
1450 function e_CharFont_GetMaxHeight(FontID: DWORD): Word;
1451 var
1452 a: Integer;
1453 h2: Word;
1454 begin
1455 Result := 0;
1456
1457 if e_CharFonts = nil then Exit;
1458 if Integer(FontID) > High(e_CharFonts) then Exit;
1459
1460 for a := 0 to High(e_CharFonts[FontID].Chars) do
1461 begin
1462 if e_CharFonts[FontID].Chars[a].TextureID <> -1 then
1463 e_GetTextureSize(e_CharFonts[FontID].Chars[a].TextureID, nil, @h2)
1464 else h2 := 0;
1465 if h2 > Result then Result := h2;
1466 end;
1467 end;
1468
1469 procedure e_CharFont_Remove(FontID: DWORD);
1470 var
1471 a: Integer;
1472 begin
1473 with e_CharFonts[FontID] do
1474 for a := 0 to High(Chars) do
1475 if Chars[a].TextureID <> -1 then e_DeleteTexture(Chars[a].TextureID);
1476
1477 e_CharFonts[FontID].alive := False;
1478 end;
1479
1480 procedure e_CharFont_RemoveAll();
1481 var
1482 a: Integer;
1483 begin
1484 if e_CharFonts = nil then Exit;
1485
1486 for a := 0 to High(e_CharFonts) do
1487 e_CharFont_Remove(a);
1488
1489 e_CharFonts := nil;
1490 end;
1491
1492 procedure e_TextureFontBuild(Tex: DWORD; var FontID: DWORD; XCount, YCount: Word;
1493 Space: ShortInt=0);
1494 var
1495 loop1 : GLuint;
1496 cx, cy : real;
1497 i, id: DWORD;
1498 begin
1499 if e_NoGraphics then Exit;
1500 e_WriteLog('Creating texture font...', MSG_NOTIFY);
1501
1502 id := DWORD(-1);
1503
1504 if e_TextureFonts <> nil then
1505 for i := 0 to High(e_TextureFonts) do
1506 if e_TextureFonts[i].Base = 0 then
1507 begin
1508 id := i;
1509 Break;
1510 end;
1511
1512 if id = DWORD(-1) then
1513 begin
1514 SetLength(e_TextureFonts, Length(e_TextureFonts) + 1);
1515 id := High(e_TextureFonts);
1516 end;
1517
1518 with e_TextureFonts[id] do
1519 begin
1520 Base := glGenLists(XCount*YCount);
1521 TextureID := e_Textures[Tex].tx.id;
1522 CharWidth := (e_Textures[Tex].tx.Width div XCount)+Space;
1523 CharHeight := e_Textures[Tex].tx.Height div YCount;
1524 XC := XCount;
1525 YC := YCount;
1526 Texture := Tex;
1527 SPC := Space;
1528 end;
1529
1530 glBindTexture(GL_TEXTURE_2D, e_Textures[Tex].tx.id);
1531 for loop1 := 0 to XCount*YCount-1 do
1532 begin
1533 cx := (loop1 mod XCount)/XCount;
1534 cy := (loop1 div YCount)/YCount;
1535
1536 glNewList(e_TextureFonts[id].Base+loop1, GL_COMPILE);
1537 glBegin(GL_QUADS);
1538 glTexCoord2f(cx, 1.0-cy-1/YCount);
1539 glVertex2i(0, e_Textures[Tex].tx.Height div YCount);
1540
1541 glTexCoord2f(cx+1/XCount, 1.0-cy-1/YCount);
1542 glVertex2i(e_Textures[Tex].tx.Width div XCount, e_Textures[Tex].tx.Height div YCount);
1543
1544 glTexCoord2f(cx+1/XCount, 1.0-cy);
1545 glVertex2i(e_Textures[Tex].tx.Width div XCount, 0);
1546
1547 glTexCoord2f(cx, 1.0-cy);
1548 glVertex2i(0, 0);
1549 glEnd();
1550 glTranslated((e_Textures[Tex].tx.Width div XCount)+Space, 0, 0);
1551 glEndList();
1552 end;
1553
1554 FontID := id;
1555 end;
1556
1557 procedure e_TextureFontKill(FontID: DWORD);
1558 begin
1559 if e_NoGraphics then Exit;
1560 glDeleteLists(e_TextureFonts[FontID].Base, 256);
1561 e_TextureFonts[FontID].Base := 0;
1562 end;
1563
1564 procedure e_TextureFontPrint(X, Y: GLint; Text: string; FontID: DWORD);
1565 begin
1566 if e_NoGraphics then Exit;
1567 if Integer(FontID) > High(e_TextureFonts) then Exit;
1568 if Text = '' then Exit;
1569
1570 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1571 glEnable(GL_BLEND);
1572
1573 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1574
1575 glPushMatrix;
1576 glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1577 glEnable(GL_TEXTURE_2D);
1578 glTranslated(x, y, 0);
1579 glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1580 glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1581 glDisable(GL_TEXTURE_2D);
1582 glPopMatrix;
1583
1584 glDisable(GL_BLEND);
1585 end;
1586
1587 // god forgive me for this, but i cannot figure out how to do it without lists
1588 procedure e_TextureFontPrintChar(X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
1589 begin
1590 if e_NoGraphics then Exit;
1591 glPushMatrix;
1592
1593 if Shadow then
1594 begin
1595 glColor4ub(0, 0, 0, 128);
1596 glTranslated(X+1, Y+1, 0);
1597 glCallLists(1, GL_UNSIGNED_BYTE, @Ch);
1598 glPopMatrix;
1599 glPushMatrix;
1600 end;
1601
1602 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1603 glTranslated(X, Y, 0);
1604 glCallLists(1, GL_UNSIGNED_BYTE, @Ch);
1605
1606 glPopMatrix;
1607 end;
1608
1609 procedure e_TextureFontPrintCharEx (X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
1610 begin
1611 glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1612 glEnable(GL_TEXTURE_2D);
1613 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1614
1615 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1616 glEnable(GL_BLEND);
1617 e_TextureFontPrintChar(X, Y, Ch, FontID, Shadow);
1618 glDisable(GL_TEXTURE_2D);
1619 glDisable(GL_BLEND);
1620 end;
1621
1622 function e_TextureFontCharWidth (ch: Char; FontID: DWORD): Integer;
1623 begin
1624 result := e_TextureFonts[FontID].CharWidth;
1625 end;
1626
1627 procedure e_TextureFontPrintFmt(X, Y: Integer; Text: string; FontID: DWORD; Shadow: Boolean = False);
1628 var
1629 a, TX, TY, len: Integer;
1630 tc, c: TRGB;
1631 w: Word;
1632 begin
1633 if e_NoGraphics then Exit;
1634 if Text = '' then Exit;
1635 if e_TextureFonts = nil then Exit;
1636 if Integer(FontID) > High(e_TextureFonts) then Exit;
1637
1638 c.R := 255;
1639 c.G := 255;
1640 c.B := 255;
1641
1642 TX := X;
1643 TY := Y;
1644 len := Length(Text);
1645
1646 w := e_TextureFonts[FontID].CharWidth;
1647
1648 with e_TextureFonts[FontID] do
1649 begin
1650 glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1651 glEnable(GL_TEXTURE_2D);
1652 glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1653
1654 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1655 glEnable(GL_BLEND);
1656
1657 for a := 1 to len do
1658 begin
1659 case Text[a] of
1660 {#10: // line feed
1661 begin
1662 TX := X;
1663 TY := TY + h;
1664 continue;
1665 end;}
1666 #1: // black
1667 begin
1668 c.R := 0; c.G := 0; c.B := 0;
1669 continue;
1670 end;
1671 #2: // white
1672 begin
1673 c.R := 255; c.G := 255; c.B := 255;
1674 continue;
1675 end;
1676 #3: // darker
1677 begin
1678 c.R := c.R div 2; c.G := c.G div 2; c.B := c.B div 2;
1679 continue;
1680 end;
1681 #4: // lighter
1682 begin
1683 c.R := Min(c.R * 2, 255); c.G := Min(c.G * 2, 255); c.B := Min(c.B * 2, 255);
1684 continue;
1685 end;
1686 #18: // red
1687 begin
1688 c.R := 255; c.G := 0; c.B := 0;
1689 continue;
1690 end;
1691 #19: // green
1692 begin
1693 c.R := 0; c.G := 255; c.B := 0;
1694 continue;
1695 end;
1696 #20: // blue
1697 begin
1698 c.R := 0; c.G := 0; c.B := 255;
1699 continue;
1700 end;
1701 #21: // yellow
1702 begin
1703 c.R := 255; c.G := 255; c.B := 0;
1704 continue;
1705 end;
1706 end;
1707
1708 tc := e_Colors;
1709 e_Colors := c;
1710 e_TextureFontPrintChar(TX, TY, Text[a], FontID, Shadow);
1711 e_Colors := tc;
1712
1713 TX := TX+w;
1714 end;
1715 glDisable(GL_TEXTURE_2D);
1716 glDisable(GL_BLEND);
1717 end;
1718 end;
1719
1720 procedure e_TextureFontPrintEx(X, Y: GLint; Text: string; FontID: DWORD; Red, Green,
1721 Blue: Byte; Scale: Single; Shadow: Boolean = False);
1722 begin
1723 if e_NoGraphics then Exit;
1724 if Text = '' then Exit;
1725
1726 glPushMatrix;
1727 glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1728 glEnable(GL_TEXTURE_2D);
1729 glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1730
1731 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1732 glEnable(GL_BLEND);
1733
1734 if Shadow then
1735 begin
1736 glColor4ub(0, 0, 0, 128);
1737 glTranslated(x+1, y+1, 0);
1738 glScalef(Scale, Scale, 0);
1739 glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1740 glPopMatrix;
1741 glPushMatrix;
1742 end;
1743
1744 glColor4ub(Red, Green, Blue, 255);
1745 glTranslated(x, y, 0);
1746 glScalef(Scale, Scale, 0);
1747 glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1748
1749 glDisable(GL_TEXTURE_2D);
1750 glPopMatrix;
1751 glColor3ub(e_Colors.R, e_Colors.G, e_Colors.B);
1752 glDisable(GL_BLEND);
1753 end;
1754
1755 procedure e_TextureFontGetSize(ID: DWORD; out CharWidth, CharHeight: Byte);
1756 begin
1757 CharWidth := 16;
1758 CharHeight := 16;
1759 if e_NoGraphics then Exit;
1760 if Integer(ID) > High(e_TextureFonts) then
1761 Exit;
1762 CharWidth := e_TextureFonts[ID].CharWidth;
1763 CharHeight := e_TextureFonts[ID].CharHeight;
1764 end;
1765
1766 procedure e_RemoveAllTextureFont();
1767 var
1768 i: integer;
1769 begin
1770 if e_NoGraphics then Exit;
1771 if e_TextureFonts = nil then Exit;
1772
1773 for i := 0 to High(e_TextureFonts) do
1774 if e_TextureFonts[i].Base <> 0 then
1775 begin
1776 glDeleteLists(e_TextureFonts[i].Base, 256);
1777 e_TextureFonts[i].Base := 0;
1778 end;
1779
1780 e_TextureFonts := nil;
1781 end;
1782
1783 function _RGB(Red, Green, Blue: Byte): TRGB;
1784 begin
1785 Result.R := Red;
1786 Result.G := Green;
1787 Result.B := Blue;
1788 end;
1789
1790 function _Point(X, Y: Integer): TPoint2i;
1791 begin
1792 Result.X := X;
1793 Result.Y := Y;
1794 end;
1795
1796 function _Rect(X, Y: Integer; Width, Height: Word): TRectWH;
1797 begin
1798 Result.X := X;
1799 Result.Y := Y;
1800 Result.Width := Width;
1801 Result.Height := Height;
1802 end;
1803
1804 function _TRect(L, T, R, B: LongInt): TRect;
1805 begin
1806 Result.Top := T;
1807 Result.Left := L;
1808 Result.Right := R;
1809 Result.Bottom := B;
1810 end;
1811
1812
1813 procedure e_MakeScreenshot (st: TStream; Width, Height: Word);
1814 var
1815 pixels, obuf, scln, ps, pd: PByte;
1816 obufsize: Integer;
1817 dlen: Cardinal;
1818 i, x, y, res: Integer;
1819 sign: array [0..7] of Byte;
1820 hbuf: array [0..12] of Byte;
1821 crc: LongWord;
1822 img: TImageData;
1823 clr: TColor32Rec;
1824 begin
1825 if e_NoGraphics then Exit;
1826 obuf := nil;
1827
1828 // first, extract and pack graphics data
1829 if (Width mod 4) > 0 then Width := Width+4-(Width mod 4);
1830
1831 GetMem(pixels, Width*Height*3);
1832 try
1833 FillChar(pixels^, Width*Height*3, 0);
1834 glReadPixels(0, 0, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pixels);
1835 //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
1836
1837 if e_FastScreenshots then
1838 begin
1839 // create scanlines
1840 GetMem(scln, (Width*3+1)*Height);
1841 try
1842 ps := pixels;
1843 pd := scln;
1844 Inc(ps, (Width*3)*(Height-1));
1845 for i := 0 to Height-1 do
1846 begin
1847 pd^ := 0; // filter
1848 Inc(pd);
1849 Move(ps^, pd^, Width*3);
1850 Dec(ps, Width*3);
1851 Inc(pd, Width*3);
1852 end;
1853 except
1854 FreeMem(scln);
1855 raise;
1856 end;
1857 FreeMem(pixels);
1858 pixels := scln;
1859
1860 // pack it
1861 obufsize := (Width*3+1)*Height*2;
1862 GetMem(obuf, obufsize);
1863 try
1864 while true do
1865 begin
1866 dlen := obufsize;
1867 res := compress2(Pointer(obuf), dlen, Pointer(pixels), (Width*3+1)*Height, 9);
1868 if res = Z_OK then break;
1869 if res <> Z_BUF_ERROR then raise Exception.Create('can''t pack data for PNG');
1870 obufsize := obufsize*2;
1871 FreeMem(obuf);
1872 obuf := nil;
1873 GetMem(obuf, obufsize);
1874 end;
1875 //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
1876
1877 // now write PNG
1878
1879 // signature
1880 sign[0] := 137;
1881 sign[1] := 80;
1882 sign[2] := 78;
1883 sign[3] := 71;
1884 sign[4] := 13;
1885 sign[5] := 10;
1886 sign[6] := 26;
1887 sign[7] := 10;
1888 st.writeBuffer(sign, 8);
1889 //e_WriteLog('PNG: signature written', MSG_NOTIFY);
1890
1891 // header
1892 writeIntBE(st, LongWord(13));
1893 sign[0] := 73;
1894 sign[1] := 72;
1895 sign[2] := 68;
1896 sign[3] := 82;
1897 st.writeBuffer(sign, 4);
1898 crc := crc32(0, @sign[0], 4);
1899 hbuf[0] := 0;
1900 hbuf[1] := 0;
1901 hbuf[2] := (Width shr 8) and $ff;
1902 hbuf[3] := Width and $ff;
1903 hbuf[4] := 0;
1904 hbuf[5] := 0;
1905 hbuf[6] := (Height shr 8) and $ff;
1906 hbuf[7] := Height and $ff;
1907 hbuf[8] := 8; // bit depth
1908 hbuf[9] := 2; // RGB
1909 hbuf[10] := 0; // compression method
1910 hbuf[11] := 0; // filter method
1911 hbuf[12] := 0; // no interlace
1912 crc := crc32(crc, @hbuf[0], 13);
1913 st.writeBuffer(hbuf, 13);
1914 writeIntBE(st, crc);
1915 //e_WriteLog('PNG: header written', MSG_NOTIFY);
1916
1917 // image data
1918 writeIntBE(st, LongWord(dlen));
1919 sign[0] := 73;
1920 sign[1] := 68;
1921 sign[2] := 65;
1922 sign[3] := 84;
1923 st.writeBuffer(sign, 4);
1924 crc := crc32(0, @sign[0], 4);
1925 crc := crc32(crc, obuf, dlen);
1926 st.writeBuffer(obuf^, dlen);
1927 writeIntBE(st, crc);
1928 //e_WriteLog('PNG: image data written', MSG_NOTIFY);
1929
1930 // image data end
1931 writeIntBE(st, LongWord(0));
1932 sign[0] := 73;
1933 sign[1] := 69;
1934 sign[2] := 78;
1935 sign[3] := 68;
1936 st.writeBuffer(sign, 4);
1937 crc := crc32(0, @sign[0], 4);
1938 writeIntBE(st, crc);
1939 //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
1940 finally
1941 if obuf <> nil then FreeMem(obuf);
1942 end;
1943 end
1944 else
1945 begin
1946 Imaging.SetOption(ImagingPNGCompressLevel, 9);
1947 Imaging.SetOption(ImagingPNGPreFilter, 6);
1948 InitImage(img);
1949 try
1950 NewImage(Width, Height, TImageFormat.ifR8G8B8, img);
1951 ps := pixels;
1952 //writeln(stderr, 'moving pixels...');
1953 for y := Height-1 downto 0 do
1954 begin
1955 for x := 0 to Width-1 do
1956 begin
1957 clr.r := ps^; Inc(ps);
1958 clr.g := ps^; Inc(ps);
1959 clr.b := ps^; Inc(ps);
1960 clr.a := 255;
1961 SetPixel32(img, x, y, clr);
1962 end;
1963 end;
1964 GlobalMetadata.ClearMetaItems();
1965 GlobalMetadata.ClearMetaItemsForSaving();
1966 //writeln(stderr, 'compressing image...');
1967 if not SaveImageToStream('png', st, img) then raise Exception.Create('screenshot writing error');
1968 //writeln(stderr, 'done!');
1969 finally
1970 FreeImage(img);
1971 end;
1972 end;
1973 finally
1974 FreeMem(pixels);
1975 end;
1976 end;
1977
1978
1979 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024