DEADSOFTWARE

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