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, either version 3 of the License, or
6 * (at your option) any later version.
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.
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/>.
16 {$INCLUDE ../shared/a_modes.inc}
22 SysUtils
, Classes
, Math
, e_log
, e_textures
, GL
, GLExt
, MAPDEF
,
23 ImagingTypes
, Imaging
, ImagingUtility
;
26 TMirrorType
=(M_NONE
, M_HORIZONTAL
, M_VERTICAL
);
27 TBlending
=(B_NONE
, B_BLEND
, B_FILTER
, B_INVERT
);
33 TPoint
= MAPDEF
.TPoint
; // TODO: create an utiltypes.pas or something
34 // for other types like rect as well
41 Left
, Top
, Right
, Bottom
: Integer;
59 //------------------------------------------------------------------
61 //------------------------------------------------------------------
63 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
64 procedure e_ResizeWindow(Width
, Height
: Integer);
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
);
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();
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();
107 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
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();
117 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
118 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
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();
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): TRectE
;
131 //function e_getTextGLId (ID: DWORD): GLuint;
135 e_NoGraphics
: Boolean = False;
136 e_FastScreenshots
: Boolean = true; // it's REALLY SLOW with `false`
150 TTextureFont
= record
160 Chars
: array[0..255] of
170 TSavedTexture
= record
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;
182 //function e_getTextGLId (ID: DWORD): GLuint; begin result := e_Textures[ID].tx.id; end;
184 //------------------------------------------------------------------
185 // Èíèöèàëèçèðóåò OpenGL
186 //------------------------------------------------------------------
187 procedure e_InitGL();
191 e_DummyTextures
:= True;
197 glDisable(GL_DEPTH_TEST
);
198 glEnable(GL_SCISSOR_TEST
);
199 glClearColor(0, 0, 0, 0);
202 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
204 mat
: Array [0..15] of GLDouble
;
207 if e_NoGraphics
then Exit
;
209 glScissor(X
, Y
, Width
, Height
);
210 glViewport(X
, Y
, Width
, Height
);
211 //gluOrtho2D(0, Width, Height, 0);
213 glMatrixMode(GL_PROJECTION
);
215 mat
[ 0] := 2.0 / Width
;
221 mat
[ 5] := -2.0 / Height
;
235 glLoadMatrixd(@mat
[0]);
237 glMatrixMode(GL_MODELVIEW
);
241 //------------------------------------------------------------------
242 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
243 //------------------------------------------------------------------
244 function FindTexture(): DWORD
;
248 if e_Textures
<> nil then
249 for i
:= 0 to High(e_Textures
) do
250 if e_Textures
[i
].tx
.Width
= 0 then
256 if e_Textures
= nil then
258 SetLength(e_Textures
, 32);
263 Result
:= High(e_Textures
) + 1;
264 SetLength(e_Textures
, Length(e_Textures
) + 32);
268 //------------------------------------------------------------------
270 //------------------------------------------------------------------
271 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
278 e_WriteLog('Loading texture from '+FileName
, MSG_NOTIFY
);
280 find_id
:= FindTexture();
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
;
290 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
297 find_id
:= FindTexture();
299 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
306 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
313 find_id
:= FindTexture
;
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
;
322 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
329 find_id
:= FindTexture();
331 if not LoadTextureMemEx(pData
, dataSize
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
338 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
344 find_id
:= FindTexture();
345 if not LoadTextureImg(img
, e_Textures
[find_id
].tx
, tw
, th
, @fmt
) then exit
;
350 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
352 if Width
<> nil then Width
^ := e_Textures
[ID
].tx
.Width
;
353 if Height
<> nil then Height
^ := e_Textures
[ID
].tx
.Height
;
356 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
364 w
:= e_Textures
[ID
].tx
.Width
;
365 h
:= e_Textures
[ID
].tx
.Height
;
372 if e_NoGraphics
then Exit
;
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
);
379 for y
:= h
-1 downto 0 do
386 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
392 Result
.Y
:= h
-lastline
;
404 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
410 Result
.Height
:= h
-lastline
-Result
.Y
;
422 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
428 Result
.X
:= lastline
+1;
433 for x
:= w
-1 downto 0 do
440 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
446 Result
.Width
:= lastline
-Result
.X
+1;
454 procedure e_ResizeWindow(Width
, Height
: Integer);
458 e_SetViewPort(0, 0, Width
, Height
);
461 procedure drawTxQuad (x0
, y0
, w
, h
: Integer; u
, v
: single; Mirror
: TMirrorType
);
463 x1
, y1
, tmp
: Integer;
465 if (w
< 1) or (h
< 1) then exit
;
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
);
476 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
477 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
479 if e_NoGraphics
then Exit
;
480 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
482 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
487 if (AlphaChannel
) or (Alpha
> 0) then
488 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
491 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
494 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
496 glEnable(GL_TEXTURE_2D
);
497 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
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
);
502 //u := e_Textures[ID].tx.u;
503 //v := e_Textures[ID].tx.v;
506 if Mirror = M_NONE then
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);
514 if Mirror = M_HORIZONTAL then
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);
522 if Mirror = M_VERTICAL then
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);
536 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
537 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
541 if e_NoGraphics
then Exit
;
542 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
544 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
549 if (AlphaChannel
) or (Alpha
> 0) then
550 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
553 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
556 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
558 glEnable(GL_TEXTURE_2D
);
559 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
561 u
:= e_Textures
[ID
].tx
.u
;
562 v
:= e_Textures
[ID
].tx
.v
;
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
);
574 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
575 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
577 if e_NoGraphics
then Exit
;
578 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
580 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
585 if (AlphaChannel
) or (Alpha
> 0) then
586 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
589 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
592 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
594 glEnable(GL_TEXTURE_2D
);
595 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
597 drawTxQuad(X
, Y
, Width
, Height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
603 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
604 AlphaChannel
: Boolean; Blending
: Boolean);
606 X2
, Y2
, dx
, w
, h
: Integer;
609 if e_NoGraphics
then Exit
;
610 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
612 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
617 if (AlphaChannel
) or (Alpha
> 0) then
618 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
621 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
624 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
632 glEnable(GL_TEXTURE_2D
);
633 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
635 X2
:= X
+ e_Textures
[ID
].tx
.width
* XCount
;
636 Y2
:= Y
+ e_Textures
[ID
].tx
.height
* YCount
;
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
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
);
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
;
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
);
679 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
680 Blending
: Boolean; Angle
: Single; RC
: PPoint
; Mirror
: TMirrorType
= M_NONE
);
682 if e_NoGraphics
then Exit
;
684 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
686 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
691 if (AlphaChannel
) or (Alpha
> 0) then
692 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
695 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
698 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
700 if (Angle
<> 0) and (RC
<> nil) then
703 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
704 glRotatef(Angle
, 0, 0, 1);
705 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
708 glEnable(GL_TEXTURE_2D
);
709 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
710 glBegin(GL_QUADS
); //0-1 1-1
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
);
721 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
723 if e_NoGraphics
then Exit
;
724 glDisable(GL_TEXTURE_2D
);
725 glColor3ub(Red
, Green
, Blue
);
728 if (Size
= 2) or (Size
= 4) then
732 glVertex2f(X
+0.3, Y
+1.0);
735 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
738 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
740 if e_NoGraphics
then Exit
;
745 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
749 glDisable(GL_TEXTURE_2D
);
750 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
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);
760 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
765 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
766 Blending
: TBlending
= B_NONE
);
768 if e_NoGraphics
then Exit
;
769 if (Alpha
> 0) or (Blending
<> B_NONE
) then
774 if Blending
= B_BLEND
then
775 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
777 if Blending
= B_FILTER
then
778 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
780 if Blending
= B_INVERT
then
781 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
784 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
786 glDisable(GL_TEXTURE_2D
);
787 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
799 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
804 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
806 if e_NoGraphics
then Exit
;
807 // Pixel-perfect lines
809 // e_LineCorrection(X1, Y1, X2, Y2);
814 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
818 glDisable(GL_TEXTURE_2D
);
819 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
827 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
832 //------------------------------------------------------------------
833 // Óäàëÿåò òåêñòóðó èç ìàññèâà
834 //------------------------------------------------------------------
835 procedure e_DeleteTexture(ID
: DWORD
);
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;
844 //------------------------------------------------------------------
845 // Óäàëÿåò âñå òåêñòóðû
846 //------------------------------------------------------------------
847 procedure e_RemoveAllTextures();
851 if e_Textures
= nil then Exit
;
853 for i
:= 0 to High(e_Textures
) do
854 if e_Textures
[i
].tx
.Width
<> 0 then e_DeleteTexture(i
);
858 //------------------------------------------------------------------
860 //------------------------------------------------------------------
861 procedure e_ReleaseEngine();
864 e_RemoveAllTextureFont
;
867 procedure e_BeginRender();
869 if e_NoGraphics
then Exit
;
870 glEnable(GL_ALPHA_TEST
);
871 glAlphaFunc(GL_GREATER
, 0.0);
874 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
876 if e_NoGraphics
then Exit
;
877 glClearColor(Red
, Green
, Blue
, 0);
881 procedure e_Clear(); overload
;
883 if e_NoGraphics
then Exit
;
884 glClearColor(0, 0, 0, 0);
885 glClear(GL_COLOR_BUFFER_BIT
);
888 procedure e_EndRender();
890 if e_NoGraphics
then Exit
;
894 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
898 e_WriteLog('Creating CharFont...', MSG_NOTIFY
);
902 if e_CharFonts
<> nil then
903 for i
:= 0 to High(e_CharFonts
) do
904 if not e_CharFonts
[i
].Live
then
910 if id
= DWORD(-1) then
912 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
913 id
:= High(e_CharFonts
);
916 with e_CharFonts
[id
] do
918 for i
:= 0 to High(Chars
) do
932 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
934 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
936 TextureID
:= Texture
;
941 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
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
;
950 with e_CharFonts
[FontID
] do
952 for a
:= 1 to Length(Text) do
953 with Chars
[Ord(Text[a
])] do
954 if TextureID
<> -1 then
956 e_Draw(TextureID
, X
, Y
, 0, True, False);
957 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
962 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
963 Color
: TRGB
; Scale
: Single = 1.0);
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
;
973 with e_CharFonts
[FontID
] do
975 for a
:= 1 to Length(Text) do
976 with Chars
[Ord(Text[a
])] do
977 if TextureID
<> -1 then
982 glScalef(Scale
, Scale
, 0);
987 e_Draw(TextureID
, X
, Y
, 0, True, False);
990 if Scale
<> 1.0 then glPopMatrix
;
992 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
997 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
999 a
, TX
, TY
, len
: Integer;
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
;
1014 len
:= Length(Text);
1016 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1018 with e_CharFonts
[FontID
] do
1020 for a
:= 1 to len
do
1031 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1036 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1041 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1046 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1051 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1056 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1061 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1066 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1071 with Chars
[Ord(Text[a
])] do
1072 if TextureID
<> -1 then
1076 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1079 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1085 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1093 if Text = '' then Exit
;
1094 if e_CharFonts
= nil then Exit
;
1095 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1097 with e_CharFonts
[FontID
] do
1099 for a
:= 1 to Length(Text) do
1100 with Chars
[Ord(Text[a
])] do
1101 if TextureID
<> -1 then
1103 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1104 e_GetTextureSize(TextureID
, nil, @h2
);
1105 if h2
> h
then h
:= h2
;
1110 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1112 a
, lines
, len
: Integer;
1119 if Text = '' then Exit
;
1120 if e_CharFonts
= nil then Exit
;
1121 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1124 len
:= Length(Text);
1126 with e_CharFonts
[FontID
] do
1128 for a
:= 1 to len
do
1130 if Text[a
] = #10 then
1140 else if Text[a
] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1143 with Chars
[Ord(Text[a
])] do
1144 if TextureID
<> -1 then
1146 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1147 e_GetTextureSize(TextureID
, nil, @h2
);
1148 if h2
> h
then h
:= h2
;
1158 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1164 if e_CharFonts
= nil then Exit
;
1165 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1167 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1168 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1171 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1178 if e_CharFonts
= nil then Exit
;
1179 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1181 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1183 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1184 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1186 if h2
> Result
then Result
:= h2
;
1190 procedure e_CharFont_Remove(FontID
: DWORD
);
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
);
1198 e_CharFonts
[FontID
].Live
:= False;
1201 procedure e_CharFont_RemoveAll();
1205 if e_CharFonts
= nil then Exit
;
1207 for a
:= 0 to High(e_CharFonts
) do
1208 e_CharFont_Remove(a
);
1213 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1220 if e_NoGraphics
then Exit
;
1221 e_WriteLog('Creating texture font...', MSG_NOTIFY
);
1225 if e_TextureFonts
<> nil then
1226 for i
:= 0 to High(e_TextureFonts
) do
1227 if e_TextureFonts
[i
].Base
= 0 then
1233 if id
= DWORD(-1) then
1235 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1236 id
:= High(e_TextureFonts
);
1239 with e_TextureFonts
[id
] do
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
;
1251 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1252 for loop1
:= 0 to XCount
*YCount
-1 do
1254 cx
:= (loop1
mod XCount
)/XCount
;
1255 cy
:= (loop1
div YCount
)/YCount
;
1257 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1259 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1260 glVertex2d(0, e_Textures
[Tex
].tx
.Height
div YCount
);
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
);
1265 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1266 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, 0);
1268 glTexCoord2f(cx
, 1.0-cy
);
1271 glTranslated((e_Textures
[Tex
].tx
.Width
div XCount
)+Space
, 0, 0);
1278 procedure e_TextureFontKill(FontID
: DWORD
);
1280 if e_NoGraphics
then Exit
;
1281 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1282 e_TextureFonts
[FontID
].Base
:= 0;
1285 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1287 if e_NoGraphics
then Exit
;
1288 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1289 if Text = '' then Exit
;
1291 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1294 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
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
);
1305 glDisable(GL_BLEND
);
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);
1311 if e_NoGraphics
then Exit
;
1316 glColor4ub(0, 0, 0, 128);
1317 glTranslated(X
+1, Y
+1, 0);
1318 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1323 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1324 glTranslated(X
, Y
, 0);
1325 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1330 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1332 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1333 glEnable(GL_TEXTURE_2D
);
1334 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1336 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1338 e_TextureFontPrintChar(X
, Y
, Ch
, FontID
, Shadow
);
1339 glDisable(GL_TEXTURE_2D
);
1340 glDisable(GL_BLEND
);
1343 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
1345 result
:= e_TextureFonts
[FontID
].CharWidth
;
1348 procedure e_TextureFontPrintFmt(X
, Y
: Integer; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
1350 a
, TX
, TY
, len
: Integer;
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
;
1365 len
:= Length(Text);
1367 w
:= e_TextureFonts
[FontID
].CharWidth
;
1369 with e_TextureFonts
[FontID
] do
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
);
1378 for a
:= 1 to len
do
1389 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1394 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1399 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1404 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1409 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1414 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1419 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1424 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1431 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1436 glDisable(GL_TEXTURE_2D
);
1437 glDisable(GL_BLEND
);
1441 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1442 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1444 if e_NoGraphics
then Exit
;
1445 if Text = '' then Exit
;
1448 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1449 glEnable(GL_TEXTURE_2D
);
1450 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1452 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
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));
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));
1470 glDisable(GL_TEXTURE_2D
);
1472 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1473 glDisable(GL_BLEND
);
1476 procedure e_TextureFontGetSize(ID
: DWORD
; var CharWidth
, CharHeight
: Byte);
1480 if e_NoGraphics
then Exit
;
1481 if Integer(ID
) > High(e_TextureFonts
) then
1483 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1484 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1487 procedure e_RemoveAllTextureFont();
1491 if e_NoGraphics
then Exit
;
1492 if e_TextureFonts
= nil then Exit
;
1494 for i
:= 0 to High(e_TextureFonts
) do
1495 if e_TextureFonts
[i
].Base
<> 0 then
1497 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1498 e_TextureFonts
[i
].Base
:= 0;
1501 e_TextureFonts
:= nil;
1504 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1511 function _Point(X
, Y
: Integer): TPoint2i
;
1517 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1521 Result
.Width
:= Width
;
1522 Result
.Height
:= Height
;
1525 function _TRect(L
, T
, R
, B
: LongInt): TRectE
;