DEADSOFTWARE

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