DEADSOFTWARE

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