DEADSOFTWARE

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