DEADSOFTWARE

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