DEADSOFTWARE

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