DEADSOFTWARE

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