DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob


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