DEADSOFTWARE

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


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