DEADSOFTWARE

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