b47556bdbedce1eaee8dee480f7660c24ec366ac
1 (* Copyright (C) DooM 2D:Forever Developers
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.
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.
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/>.
15 {$INCLUDE ../shared/a_modes.inc}
21 SysUtils
, Classes
, Math
, e_log
, e_textures
, GL
, GLExt
, MAPDEF
,
22 ImagingTypes
, Imaging
, ImagingUtility
;
25 TMirrorType
=(M_NONE
, M_HORIZONTAL
, M_VERTICAL
);
26 TBlending
=(B_NONE
, B_BLEND
, B_FILTER
, B_INVERT
);
32 TPoint
= MAPDEF
.TPoint
; // TODO: create an utiltypes.pas or something
33 // for other types like rect as well
40 Left
, Top
, Right
, Bottom
: Integer;
58 //------------------------------------------------------------------
60 //------------------------------------------------------------------
62 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
63 procedure e_ResizeWindow(Width
, Height
: Integer);
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
);
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();
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();
106 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
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();
116 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
117 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
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();
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
;
130 //function e_getTextGLId (ID: DWORD): GLuint;
134 e_NoGraphics
: Boolean = False;
135 e_FastScreenshots
: Boolean = true; // it's REALLY SLOW with `false`
149 TTextureFont
= record
159 Chars
: array[0..255] of
169 TSavedTexture
= record
175 ArrayOfAnsiString
= array of AnsiString;
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;
183 //function e_getTextGLId (ID: DWORD): GLuint; begin result := e_Textures[ID].tx.id; end;
185 function GLExtensionList(): ArrayOfAnsiString
;
186 var s
: PChar; i
, j
, num
: GLint
;
189 s
:= glGetString(GL_EXTENSIONS
);
195 while (s
[i
] <> #0) and (s
[i
] = ' ') do Inc(i
);
196 while (s
[i
] <> #0) do
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
);
208 function GLExtensionSupported(ext
: AnsiString): Boolean;
212 for e
in GLExtensionList() do
214 if CompareText(e
, ext
) = 0 then
222 //------------------------------------------------------------------
223 // Èíèöèàëèçèðóåò OpenGL
224 //------------------------------------------------------------------
225 procedure e_InitGL();
229 e_DummyTextures
:= True;
232 e_glLegacyNPOT
:= not (GLExtensionSupported('GL_ARB_texture_non_power_of_two') or GLExtensionSupported('GL_OES_texture_npot'));
236 glDisable(GL_DEPTH_TEST
);
237 glEnable(GL_SCISSOR_TEST
);
238 glClearColor(0, 0, 0, 0);
241 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
243 mat
: Array [0..15] of GLDouble
;
246 if e_NoGraphics
then Exit
;
248 glScissor(X
, Y
, Width
, Height
);
249 glViewport(X
, Y
, Width
, Height
);
250 //gluOrtho2D(0, Width, Height, 0);
252 glMatrixMode(GL_PROJECTION
);
254 mat
[ 0] := 2.0 / Width
;
260 mat
[ 5] := -2.0 / Height
;
274 glLoadMatrixd(@mat
[0]);
276 glMatrixMode(GL_MODELVIEW
);
280 //------------------------------------------------------------------
281 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
282 //------------------------------------------------------------------
283 function FindTexture(): DWORD
;
287 if e_Textures
<> nil then
288 for i
:= 0 to High(e_Textures
) do
289 if e_Textures
[i
].tx
.Width
= 0 then
295 if e_Textures
= nil then
297 SetLength(e_Textures
, 32);
302 Result
:= High(e_Textures
) + 1;
303 SetLength(e_Textures
, Length(e_Textures
) + 32);
307 //------------------------------------------------------------------
309 //------------------------------------------------------------------
310 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
317 e_WriteLog('Loading texture from '+FileName
, MSG_NOTIFY
);
319 find_id
:= FindTexture();
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
;
329 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
336 find_id
:= FindTexture();
338 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
345 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
352 find_id
:= FindTexture
;
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
;
361 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
368 find_id
:= FindTexture();
370 if not LoadTextureMemEx(pData
, dataSize
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
377 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
383 find_id
:= FindTexture();
384 if not LoadTextureImg(img
, e_Textures
[find_id
].tx
, tw
, th
, @fmt
) then exit
;
389 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
391 if Width
<> nil then Width
^ := e_Textures
[ID
].tx
.Width
;
392 if Height
<> nil then Height
^ := e_Textures
[ID
].tx
.Height
;
395 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
403 w
:= e_Textures
[ID
].tx
.Width
;
404 h
:= e_Textures
[ID
].tx
.Height
;
411 if e_NoGraphics
then Exit
;
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
);
418 for y
:= h
-1 downto 0 do
425 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
431 Result
.Y
:= h
-lastline
;
443 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
449 Result
.Height
:= h
-lastline
-Result
.Y
;
461 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
467 Result
.X
:= lastline
+1;
472 for x
:= w
-1 downto 0 do
479 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
485 Result
.Width
:= lastline
-Result
.X
+1;
493 procedure e_ResizeWindow(Width
, Height
: Integer);
497 e_SetViewPort(0, 0, Width
, Height
);
500 procedure drawTxQuad (x0
, y0
, w
, h
: Integer; u
, v
: single; Mirror
: TMirrorType
);
502 x1
, y1
, tmp
: Integer;
504 if (w
< 1) or (h
< 1) then exit
;
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
);
515 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
516 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
518 if e_NoGraphics
then Exit
;
519 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
521 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
526 if (AlphaChannel
) or (Alpha
> 0) then
527 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
530 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
533 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
535 glEnable(GL_TEXTURE_2D
);
536 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
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
);
541 //u := e_Textures[ID].tx.u;
542 //v := e_Textures[ID].tx.v;
545 if Mirror = M_NONE then
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);
553 if Mirror = M_HORIZONTAL then
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);
561 if Mirror = M_VERTICAL then
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);
575 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
576 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
580 if e_NoGraphics
then Exit
;
581 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
583 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
588 if (AlphaChannel
) or (Alpha
> 0) then
589 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
592 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
595 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
597 glEnable(GL_TEXTURE_2D
);
598 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
600 u
:= e_Textures
[ID
].tx
.u
;
601 v
:= e_Textures
[ID
].tx
.v
;
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
);
613 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
614 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
616 if e_NoGraphics
then Exit
;
617 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
619 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
624 if (AlphaChannel
) or (Alpha
> 0) then
625 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
628 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
631 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
633 glEnable(GL_TEXTURE_2D
);
634 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
636 drawTxQuad(X
, Y
, Width
, Height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
642 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
643 AlphaChannel
: Boolean; Blending
: Boolean);
645 X2
, Y2
, dx
, w
, h
: Integer;
648 if e_NoGraphics
then Exit
;
649 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
651 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
656 if (AlphaChannel
) or (Alpha
> 0) then
657 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
660 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
663 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
671 glEnable(GL_TEXTURE_2D
);
672 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
674 X2
:= X
+ e_Textures
[ID
].tx
.width
* XCount
;
675 Y2
:= Y
+ e_Textures
[ID
].tx
.height
* YCount
;
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
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
);
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
;
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
);
718 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
719 Blending
: Boolean; Angle
: Single; RC
: PPoint
; Mirror
: TMirrorType
= M_NONE
);
721 if e_NoGraphics
then Exit
;
723 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
725 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
730 if (AlphaChannel
) or (Alpha
> 0) then
731 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
734 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
737 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
739 if (Angle
<> 0) and (RC
<> nil) then
742 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
743 glRotatef(Angle
, 0, 0, 1);
744 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
747 glEnable(GL_TEXTURE_2D
);
748 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
749 glBegin(GL_QUADS
); //0-1 1-1
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
);
760 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
762 if e_NoGraphics
then Exit
;
763 glDisable(GL_TEXTURE_2D
);
764 glColor3ub(Red
, Green
, Blue
);
767 if (Size
= 2) or (Size
= 4) then
771 glVertex2f(X
+0.3, Y
+1.0);
774 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
777 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
779 if e_NoGraphics
then Exit
;
784 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
788 glDisable(GL_TEXTURE_2D
);
789 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
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);
799 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
804 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
805 Blending
: TBlending
= B_NONE
);
807 if e_NoGraphics
then Exit
;
808 if (Alpha
> 0) or (Blending
<> B_NONE
) then
813 if Blending
= B_BLEND
then
814 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
816 if Blending
= B_FILTER
then
817 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
819 if Blending
= B_INVERT
then
820 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
823 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
825 glDisable(GL_TEXTURE_2D
);
826 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
838 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
843 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
845 if e_NoGraphics
then Exit
;
846 // Pixel-perfect lines
848 // e_LineCorrection(X1, Y1, X2, Y2);
853 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
857 glDisable(GL_TEXTURE_2D
);
858 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
866 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
871 //------------------------------------------------------------------
872 // Óäàëÿåò òåêñòóðó èç ìàññèâà
873 //------------------------------------------------------------------
874 procedure e_DeleteTexture(ID
: DWORD
);
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;
883 //------------------------------------------------------------------
884 // Óäàëÿåò âñå òåêñòóðû
885 //------------------------------------------------------------------
886 procedure e_RemoveAllTextures();
890 if e_Textures
= nil then Exit
;
892 for i
:= 0 to High(e_Textures
) do
893 if e_Textures
[i
].tx
.Width
<> 0 then e_DeleteTexture(i
);
897 //------------------------------------------------------------------
899 //------------------------------------------------------------------
900 procedure e_ReleaseEngine();
903 e_RemoveAllTextureFont
;
906 procedure e_BeginRender();
908 if e_NoGraphics
then Exit
;
909 glEnable(GL_ALPHA_TEST
);
910 glAlphaFunc(GL_GREATER
, 0.0);
913 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
915 if e_NoGraphics
then Exit
;
916 glClearColor(Red
, Green
, Blue
, 0);
920 procedure e_Clear(); overload
;
922 if e_NoGraphics
then Exit
;
923 glClearColor(0, 0, 0, 0);
924 glClear(GL_COLOR_BUFFER_BIT
);
927 procedure e_EndRender();
929 if e_NoGraphics
then Exit
;
933 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
937 e_WriteLog('Creating CharFont...', MSG_NOTIFY
);
941 if e_CharFonts
<> nil then
942 for i
:= 0 to High(e_CharFonts
) do
943 if not e_CharFonts
[i
].Live
then
949 if id
= DWORD(-1) then
951 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
952 id
:= High(e_CharFonts
);
955 with e_CharFonts
[id
] do
957 for i
:= 0 to High(Chars
) do
971 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
973 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
975 TextureID
:= Texture
;
980 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
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
;
989 with e_CharFonts
[FontID
] do
991 for a
:= 1 to Length(Text) do
992 with Chars
[Ord(Text[a
])] do
993 if TextureID
<> -1 then
995 e_Draw(TextureID
, X
, Y
, 0, True, False);
996 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1001 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1002 Color
: TRGB
; Scale
: Single = 1.0);
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
;
1012 with e_CharFonts
[FontID
] do
1014 for a
:= 1 to Length(Text) do
1015 with Chars
[Ord(Text[a
])] do
1016 if TextureID
<> -1 then
1018 if Scale
<> 1.0 then
1021 glScalef(Scale
, Scale
, 0);
1026 e_Draw(TextureID
, X
, Y
, 0, True, False);
1029 if Scale
<> 1.0 then glPopMatrix
;
1031 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1036 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1038 a
, TX
, TY
, len
: Integer;
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
;
1053 len
:= Length(Text);
1055 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1057 with e_CharFonts
[FontID
] do
1059 for a
:= 1 to len
do
1070 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1075 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1080 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1085 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1090 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1095 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1100 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1105 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1110 with Chars
[Ord(Text[a
])] do
1111 if TextureID
<> -1 then
1115 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1118 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1124 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1132 if Text = '' then Exit
;
1133 if e_CharFonts
= nil then Exit
;
1134 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1136 with e_CharFonts
[FontID
] do
1138 for a
:= 1 to Length(Text) do
1139 with Chars
[Ord(Text[a
])] do
1140 if TextureID
<> -1 then
1142 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1143 e_GetTextureSize(TextureID
, nil, @h2
);
1144 if h2
> h
then h
:= h2
;
1149 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1151 a
, lines
, len
: Integer;
1158 if Text = '' then Exit
;
1159 if e_CharFonts
= nil then Exit
;
1160 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1163 len
:= Length(Text);
1165 with e_CharFonts
[FontID
] do
1167 for a
:= 1 to len
do
1169 if Text[a
] = #10 then
1179 else if Text[a
] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1182 with Chars
[Ord(Text[a
])] do
1183 if TextureID
<> -1 then
1185 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1186 e_GetTextureSize(TextureID
, nil, @h2
);
1187 if h2
> h
then h
:= h2
;
1197 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1203 if e_CharFonts
= nil then Exit
;
1204 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1206 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1207 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1210 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1217 if e_CharFonts
= nil then Exit
;
1218 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1220 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1222 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1223 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1225 if h2
> Result
then Result
:= h2
;
1229 procedure e_CharFont_Remove(FontID
: DWORD
);
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
);
1237 e_CharFonts
[FontID
].Live
:= False;
1240 procedure e_CharFont_RemoveAll();
1244 if e_CharFonts
= nil then Exit
;
1246 for a
:= 0 to High(e_CharFonts
) do
1247 e_CharFont_Remove(a
);
1252 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1259 if e_NoGraphics
then Exit
;
1260 e_WriteLog('Creating texture font...', MSG_NOTIFY
);
1264 if e_TextureFonts
<> nil then
1265 for i
:= 0 to High(e_TextureFonts
) do
1266 if e_TextureFonts
[i
].Base
= 0 then
1272 if id
= DWORD(-1) then
1274 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1275 id
:= High(e_TextureFonts
);
1278 with e_TextureFonts
[id
] do
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
;
1290 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1291 for loop1
:= 0 to XCount
*YCount
-1 do
1293 cx
:= (loop1
mod XCount
)/XCount
;
1294 cy
:= (loop1
div YCount
)/YCount
;
1296 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1298 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1299 glVertex2d(0, e_Textures
[Tex
].tx
.Height
div YCount
);
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
);
1304 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1305 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, 0);
1307 glTexCoord2f(cx
, 1.0-cy
);
1310 glTranslated((e_Textures
[Tex
].tx
.Width
div XCount
)+Space
, 0, 0);
1317 procedure e_TextureFontKill(FontID
: DWORD
);
1319 if e_NoGraphics
then Exit
;
1320 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1321 e_TextureFonts
[FontID
].Base
:= 0;
1324 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1326 if e_NoGraphics
then Exit
;
1327 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1328 if Text = '' then Exit
;
1330 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1333 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
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
);
1344 glDisable(GL_BLEND
);
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);
1350 if e_NoGraphics
then Exit
;
1355 glColor4ub(0, 0, 0, 128);
1356 glTranslated(X
+1, Y
+1, 0);
1357 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1362 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1363 glTranslated(X
, Y
, 0);
1364 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1369 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1371 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1372 glEnable(GL_TEXTURE_2D
);
1373 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1375 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1377 e_TextureFontPrintChar(X
, Y
, Ch
, FontID
, Shadow
);
1378 glDisable(GL_TEXTURE_2D
);
1379 glDisable(GL_BLEND
);
1382 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
1384 result
:= e_TextureFonts
[FontID
].CharWidth
;
1387 procedure e_TextureFontPrintFmt(X
, Y
: Integer; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
1389 a
, TX
, TY
, len
: Integer;
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
;
1404 len
:= Length(Text);
1406 w
:= e_TextureFonts
[FontID
].CharWidth
;
1408 with e_TextureFonts
[FontID
] do
1410 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1411 glEnable(GL_TEXTURE_2D
);
1412 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1414 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1417 for a
:= 1 to len
do
1428 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1433 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1438 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1443 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1448 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1453 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1458 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1463 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1470 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1475 glDisable(GL_TEXTURE_2D
);
1476 glDisable(GL_BLEND
);
1480 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1481 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1483 if e_NoGraphics
then Exit
;
1484 if Text = '' then Exit
;
1487 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1488 glEnable(GL_TEXTURE_2D
);
1489 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1491 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
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));
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));
1509 glDisable(GL_TEXTURE_2D
);
1511 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1512 glDisable(GL_BLEND
);
1515 procedure e_TextureFontGetSize(ID
: DWORD
; var CharWidth
, CharHeight
: Byte);
1519 if e_NoGraphics
then Exit
;
1520 if Integer(ID
) > High(e_TextureFonts
) then
1522 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1523 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1526 procedure e_RemoveAllTextureFont();
1530 if e_NoGraphics
then Exit
;
1531 if e_TextureFonts
= nil then Exit
;
1533 for i
:= 0 to High(e_TextureFonts
) do
1534 if e_TextureFonts
[i
].Base
<> 0 then
1536 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1537 e_TextureFonts
[i
].Base
:= 0;
1540 e_TextureFonts
:= nil;
1543 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1550 function _Point(X
, Y
: Integer): TPoint2i
;
1556 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1560 Result
.Width
:= Width
;
1561 Result
.Height
:= Height
;
1564 function _TRect(L
, T
, R
, B
: LongInt): TRectE
;