DEADSOFTWARE

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