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
176 e_Textures
: array of TTexture
= nil;
177 e_TextureFonts
: array of TTextureFont
= nil;
178 e_CharFonts
: array of TCharFont
;
179 //e_SavedTextures: array of TSavedTexture;
181 //function e_getTextGLId (ID: DWORD): GLuint; begin result := e_Textures[ID].tx.id; end;
183 //------------------------------------------------------------------
184 // Èíèöèàëèçèðóåò OpenGL
185 //------------------------------------------------------------------
186 procedure e_InitGL();
190 e_DummyTextures
:= True;
196 glDisable(GL_DEPTH_TEST
);
197 glEnable(GL_SCISSOR_TEST
);
198 glClearColor(0, 0, 0, 0);
201 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
203 mat
: Array [0..15] of GLDouble
;
206 if e_NoGraphics
then Exit
;
208 glScissor(X
, Y
, Width
, Height
);
209 glViewport(X
, Y
, Width
, Height
);
210 //gluOrtho2D(0, Width, Height, 0);
212 glMatrixMode(GL_PROJECTION
);
214 mat
[ 0] := 2.0 / Width
;
220 mat
[ 5] := -2.0 / Height
;
234 glLoadMatrixd(@mat
[0]);
236 glMatrixMode(GL_MODELVIEW
);
240 //------------------------------------------------------------------
241 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
242 //------------------------------------------------------------------
243 function FindTexture(): DWORD
;
247 if e_Textures
<> nil then
248 for i
:= 0 to High(e_Textures
) do
249 if e_Textures
[i
].tx
.Width
= 0 then
255 if e_Textures
= nil then
257 SetLength(e_Textures
, 32);
262 Result
:= High(e_Textures
) + 1;
263 SetLength(e_Textures
, Length(e_Textures
) + 32);
267 //------------------------------------------------------------------
269 //------------------------------------------------------------------
270 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
277 e_WriteLog('Loading texture from '+FileName
, MSG_NOTIFY
);
279 find_id
:= FindTexture();
281 if not LoadTexture(FileName
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].tx
.Width
,
282 e_Textures
[find_id
].tx
.Height
, @fmt
) then Exit
;
289 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
296 find_id
:= FindTexture();
298 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
305 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
312 find_id
:= FindTexture
;
314 if not LoadTextureMem(pData
, dataSize
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].tx
.Width
, e_Textures
[find_id
].tx
.Height
, @fmt
) then exit
;
321 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
328 find_id
:= FindTexture();
330 if not LoadTextureMemEx(pData
, dataSize
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
337 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
343 find_id
:= FindTexture();
344 if not LoadTextureImg(img
, e_Textures
[find_id
].tx
, tw
, th
, @fmt
) then exit
;
349 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
351 if Width
<> nil then Width
^ := e_Textures
[ID
].tx
.Width
;
352 if Height
<> nil then Height
^ := e_Textures
[ID
].tx
.Height
;
355 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
363 w
:= e_Textures
[ID
].tx
.Width
;
364 h
:= e_Textures
[ID
].tx
.Height
;
371 if e_NoGraphics
then Exit
;
373 data
:= GetMemory(w
*h
*4);
374 glEnable(GL_TEXTURE_2D
);
375 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
376 glGetTexImage(GL_TEXTURE_2D
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, data
);
378 for y
:= h
-1 downto 0 do
385 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
391 Result
.Y
:= h
-lastline
;
403 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
409 Result
.Height
:= h
-lastline
-Result
.Y
;
421 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
427 Result
.X
:= lastline
+1;
432 for x
:= w
-1 downto 0 do
439 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
445 Result
.Width
:= lastline
-Result
.X
+1;
453 procedure e_ResizeWindow(Width
, Height
: Integer);
457 e_SetViewPort(0, 0, Width
, Height
);
460 procedure drawTxQuad (x0
, y0
, w
, h
: Integer; u
, v
: single; Mirror
: TMirrorType
);
462 x1
, y1
, tmp
: Integer;
464 if (w
< 1) or (h
< 1) then exit
;
467 if Mirror
= M_HORIZONTAL
then begin tmp
:= x1
; x1
:= x0
; x0
:= tmp
; end
468 else if Mirror
= M_VERTICAL
then begin tmp
:= y1
; y1
:= y0
; y0
:= tmp
; end;
469 glTexCoord2f(0, v
); glVertex2i(x0
, y0
);
470 glTexCoord2f(0, 0); glVertex2i(x0
, y1
);
471 glTexCoord2f(u
, 0); glVertex2i(x1
, y1
);
472 glTexCoord2f(u
, v
); glVertex2i(x1
, y0
);
475 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
476 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
478 if e_NoGraphics
then Exit
;
479 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
481 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
486 if (AlphaChannel
) or (Alpha
> 0) then
487 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
490 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
493 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
495 glEnable(GL_TEXTURE_2D
);
496 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
499 drawTxQuad(X
, Y
, e_Textures
[id
].tx
.width
, e_Textures
[id
].tx
.height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
501 //u := e_Textures[ID].tx.u;
502 //v := e_Textures[ID].tx.v;
505 if Mirror = M_NONE then
507 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
508 glTexCoord2f(0, 0); glVertex2i(X, Y);
509 glTexCoord2f(0, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
510 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
513 if Mirror = M_HORIZONTAL then
515 glTexCoord2f(u, 0); glVertex2i(X, Y);
516 glTexCoord2f(0, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
517 glTexCoord2f(0, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
518 glTexCoord2f(u, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
521 if Mirror = M_VERTICAL then
523 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y);
524 glTexCoord2f(0, -v); glVertex2i(X, Y);
525 glTexCoord2f(0, 0); glVertex2i(X, Y + e_Textures[id].tx.Height);
526 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
535 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
536 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
540 if e_NoGraphics
then Exit
;
541 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
543 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
548 if (AlphaChannel
) or (Alpha
> 0) then
549 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
552 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
555 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
557 glEnable(GL_TEXTURE_2D
);
558 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
560 u
:= e_Textures
[ID
].tx
.u
;
561 v
:= e_Textures
[ID
].tx
.v
;
564 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
565 glTexCoord2f(u
, v
); glVertex2i(X
+ Width
, Y
);
566 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
567 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
573 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
574 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
576 if e_NoGraphics
then Exit
;
577 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
579 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
584 if (AlphaChannel
) or (Alpha
> 0) then
585 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
588 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
591 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
593 glEnable(GL_TEXTURE_2D
);
594 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
596 drawTxQuad(X
, Y
, Width
, Height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
602 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
603 AlphaChannel
: Boolean; Blending
: Boolean);
605 X2
, Y2
, dx
, w
, h
: Integer;
608 if e_NoGraphics
then Exit
;
609 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
611 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
616 if (AlphaChannel
) or (Alpha
> 0) then
617 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
620 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
623 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
631 glEnable(GL_TEXTURE_2D
);
632 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
634 X2
:= X
+ e_Textures
[ID
].tx
.width
* XCount
;
635 Y2
:= Y
+ e_Textures
[ID
].tx
.height
* YCount
;
637 //k8: this SHOULD work... i hope
638 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
641 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
642 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
643 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
644 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
651 u
:= e_Textures
[ID
].tx
.u
;
652 v
:= e_Textures
[ID
].tx
.v
;
653 w
:= e_Textures
[ID
].tx
.width
;
654 h
:= e_Textures
[ID
].tx
.height
;
661 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
662 glTexCoord2f(u
, v
); glVertex2i(X
+w
, Y
);
663 glTexCoord2f(u
, 0); glVertex2i(X
+w
, Y
+h
);
664 glTexCoord2f(0, 0); glVertex2i(X
, Y
+h
);
678 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
679 Blending
: Boolean; Angle
: Single; RC
: PPoint
; Mirror
: TMirrorType
= M_NONE
);
681 if e_NoGraphics
then Exit
;
683 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
685 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
690 if (AlphaChannel
) or (Alpha
> 0) then
691 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
694 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
697 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
699 if (Angle
<> 0) and (RC
<> nil) then
702 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
703 glRotatef(Angle
, 0, 0, 1);
704 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
707 glEnable(GL_TEXTURE_2D
);
708 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
709 glBegin(GL_QUADS
); //0-1 1-1
711 drawTxQuad(X
, Y
, e_Textures
[id
].tx
.width
, e_Textures
[id
].tx
.height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
720 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
722 if e_NoGraphics
then Exit
;
723 glDisable(GL_TEXTURE_2D
);
724 glColor3ub(Red
, Green
, Blue
);
727 if (Size
= 2) or (Size
= 4) then
731 glVertex2f(X
+0.3, Y
+1.0);
734 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
737 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
739 if e_NoGraphics
then Exit
;
744 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
748 glDisable(GL_TEXTURE_2D
);
749 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
752 glBegin(GL_LINE_LOOP
);
753 glVertex2f(X1
+ 0.5, Y1
+ 0.5);
754 glVertex2f(X2
+ 0.5, Y1
+ 0.5);
755 glVertex2f(X2
+ 0.5, Y2
+ 0.5);
756 glVertex2f(X1
+ 0.5, Y2
+ 0.5);
759 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
764 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
765 Blending
: TBlending
= B_NONE
);
767 if e_NoGraphics
then Exit
;
768 if (Alpha
> 0) or (Blending
<> B_NONE
) then
773 if Blending
= B_BLEND
then
774 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
776 if Blending
= B_FILTER
then
777 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
779 if Blending
= B_INVERT
then
780 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
783 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
785 glDisable(GL_TEXTURE_2D
);
786 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
798 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
803 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
805 if e_NoGraphics
then Exit
;
806 // Pixel-perfect lines
808 // e_LineCorrection(X1, Y1, X2, Y2);
813 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
817 glDisable(GL_TEXTURE_2D
);
818 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
826 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
831 //------------------------------------------------------------------
832 // Óäàëÿåò òåêñòóðó èç ìàññèâà
833 //------------------------------------------------------------------
834 procedure e_DeleteTexture(ID
: DWORD
);
836 if not e_NoGraphics
then
837 glDeleteTextures(1, @e_Textures
[ID
].tx
.id
);
838 e_Textures
[ID
].tx
.id
:= 0;
839 e_Textures
[ID
].tx
.Width
:= 0;
840 e_Textures
[ID
].tx
.Height
:= 0;
843 //------------------------------------------------------------------
844 // Óäàëÿåò âñå òåêñòóðû
845 //------------------------------------------------------------------
846 procedure e_RemoveAllTextures();
850 if e_Textures
= nil then Exit
;
852 for i
:= 0 to High(e_Textures
) do
853 if e_Textures
[i
].tx
.Width
<> 0 then e_DeleteTexture(i
);
857 //------------------------------------------------------------------
859 //------------------------------------------------------------------
860 procedure e_ReleaseEngine();
863 e_RemoveAllTextureFont
;
866 procedure e_BeginRender();
868 if e_NoGraphics
then Exit
;
869 glEnable(GL_ALPHA_TEST
);
870 glAlphaFunc(GL_GREATER
, 0.0);
873 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
875 if e_NoGraphics
then Exit
;
876 glClearColor(Red
, Green
, Blue
, 0);
880 procedure e_Clear(); overload
;
882 if e_NoGraphics
then Exit
;
883 glClearColor(0, 0, 0, 0);
884 glClear(GL_COLOR_BUFFER_BIT
);
887 procedure e_EndRender();
889 if e_NoGraphics
then Exit
;
893 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
897 e_WriteLog('Creating CharFont...', MSG_NOTIFY
);
901 if e_CharFonts
<> nil then
902 for i
:= 0 to High(e_CharFonts
) do
903 if not e_CharFonts
[i
].Live
then
909 if id
= DWORD(-1) then
911 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
912 id
:= High(e_CharFonts
);
915 with e_CharFonts
[id
] do
917 for i
:= 0 to High(Chars
) do
931 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
933 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
935 TextureID
:= Texture
;
940 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
944 if e_NoGraphics
then Exit
;
945 if Text = '' then Exit
;
946 if e_CharFonts
= nil then Exit
;
947 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
949 with e_CharFonts
[FontID
] do
951 for a
:= 1 to Length(Text) do
952 with Chars
[Ord(Text[a
])] do
953 if TextureID
<> -1 then
955 e_Draw(TextureID
, X
, Y
, 0, True, False);
956 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
961 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
962 Color
: TRGB
; Scale
: Single = 1.0);
967 if e_NoGraphics
then Exit
;
968 if Text = '' then Exit
;
969 if e_CharFonts
= nil then Exit
;
970 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
972 with e_CharFonts
[FontID
] do
974 for a
:= 1 to Length(Text) do
975 with Chars
[Ord(Text[a
])] do
976 if TextureID
<> -1 then
981 glScalef(Scale
, Scale
, 0);
986 e_Draw(TextureID
, X
, Y
, 0, True, False);
989 if Scale
<> 1.0 then glPopMatrix
;
991 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
996 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
998 a
, TX
, TY
, len
: Integer;
1002 if e_NoGraphics
then Exit
;
1003 if Text = '' then Exit
;
1004 if e_CharFonts
= nil then Exit
;
1005 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1013 len
:= Length(Text);
1015 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1017 with e_CharFonts
[FontID
] do
1019 for a
:= 1 to len
do
1030 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1035 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1040 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1045 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1050 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1055 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1060 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1065 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1070 with Chars
[Ord(Text[a
])] do
1071 if TextureID
<> -1 then
1075 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1078 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1084 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1092 if Text = '' then Exit
;
1093 if e_CharFonts
= nil then Exit
;
1094 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1096 with e_CharFonts
[FontID
] do
1098 for a
:= 1 to Length(Text) do
1099 with Chars
[Ord(Text[a
])] do
1100 if TextureID
<> -1 then
1102 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1103 e_GetTextureSize(TextureID
, nil, @h2
);
1104 if h2
> h
then h
:= h2
;
1109 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1111 a
, lines
, len
: Integer;
1118 if Text = '' then Exit
;
1119 if e_CharFonts
= nil then Exit
;
1120 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1123 len
:= Length(Text);
1125 with e_CharFonts
[FontID
] do
1127 for a
:= 1 to len
do
1129 if Text[a
] = #10 then
1139 else if Text[a
] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1142 with Chars
[Ord(Text[a
])] do
1143 if TextureID
<> -1 then
1145 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1146 e_GetTextureSize(TextureID
, nil, @h2
);
1147 if h2
> h
then h
:= h2
;
1157 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1163 if e_CharFonts
= nil then Exit
;
1164 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1166 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1167 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1170 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1177 if e_CharFonts
= nil then Exit
;
1178 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1180 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1182 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1183 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1185 if h2
> Result
then Result
:= h2
;
1189 procedure e_CharFont_Remove(FontID
: DWORD
);
1193 with e_CharFonts
[FontID
] do
1194 for a
:= 0 to High(Chars
) do
1195 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1197 e_CharFonts
[FontID
].Live
:= False;
1200 procedure e_CharFont_RemoveAll();
1204 if e_CharFonts
= nil then Exit
;
1206 for a
:= 0 to High(e_CharFonts
) do
1207 e_CharFont_Remove(a
);
1212 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1219 if e_NoGraphics
then Exit
;
1220 e_WriteLog('Creating texture font...', MSG_NOTIFY
);
1224 if e_TextureFonts
<> nil then
1225 for i
:= 0 to High(e_TextureFonts
) do
1226 if e_TextureFonts
[i
].Base
= 0 then
1232 if id
= DWORD(-1) then
1234 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1235 id
:= High(e_TextureFonts
);
1238 with e_TextureFonts
[id
] do
1240 Base
:= glGenLists(XCount
*YCount
);
1241 TextureID
:= e_Textures
[Tex
].tx
.id
;
1242 CharWidth
:= (e_Textures
[Tex
].tx
.Width
div XCount
)+Space
;
1243 CharHeight
:= e_Textures
[Tex
].tx
.Height
div YCount
;
1250 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1251 for loop1
:= 0 to XCount
*YCount
-1 do
1253 cx
:= (loop1
mod XCount
)/XCount
;
1254 cy
:= (loop1
div YCount
)/YCount
;
1256 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1258 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1259 glVertex2d(0, e_Textures
[Tex
].tx
.Height
div YCount
);
1261 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1262 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, e_Textures
[Tex
].tx
.Height
div YCount
);
1264 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1265 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, 0);
1267 glTexCoord2f(cx
, 1.0-cy
);
1270 glTranslated((e_Textures
[Tex
].tx
.Width
div XCount
)+Space
, 0, 0);
1277 procedure e_TextureFontKill(FontID
: DWORD
);
1279 if e_NoGraphics
then Exit
;
1280 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1281 e_TextureFonts
[FontID
].Base
:= 0;
1284 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1286 if e_NoGraphics
then Exit
;
1287 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1288 if Text = '' then Exit
;
1290 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1293 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1296 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1297 glEnable(GL_TEXTURE_2D
);
1298 glTranslated(x
, y
, 0);
1299 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1300 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1301 glDisable(GL_TEXTURE_2D
);
1304 glDisable(GL_BLEND
);
1307 // god forgive me for this, but i cannot figure out how to do it without lists
1308 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1310 if e_NoGraphics
then Exit
;
1315 glColor4ub(0, 0, 0, 128);
1316 glTranslated(X
+1, Y
+1, 0);
1317 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1322 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1323 glTranslated(X
, Y
, 0);
1324 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1329 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1331 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1332 glEnable(GL_TEXTURE_2D
);
1333 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1335 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1337 e_TextureFontPrintChar(X
, Y
, Ch
, FontID
, Shadow
);
1338 glDisable(GL_TEXTURE_2D
);
1339 glDisable(GL_BLEND
);
1342 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
1344 result
:= e_TextureFonts
[FontID
].CharWidth
;
1347 procedure e_TextureFontPrintFmt(X
, Y
: Integer; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
1349 a
, TX
, TY
, len
: Integer;
1353 if e_NoGraphics
then Exit
;
1354 if Text = '' then Exit
;
1355 if e_TextureFonts
= nil then Exit
;
1356 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1364 len
:= Length(Text);
1366 w
:= e_TextureFonts
[FontID
].CharWidth
;
1368 with e_TextureFonts
[FontID
] do
1370 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1371 glEnable(GL_TEXTURE_2D
);
1372 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1374 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1377 for a
:= 1 to len
do
1388 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1393 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1398 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1403 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1408 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1413 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1418 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1423 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1430 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1435 glDisable(GL_TEXTURE_2D
);
1436 glDisable(GL_BLEND
);
1440 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1441 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1443 if e_NoGraphics
then Exit
;
1444 if Text = '' then Exit
;
1447 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1448 glEnable(GL_TEXTURE_2D
);
1449 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1451 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1456 glColor4ub(0, 0, 0, 128);
1457 glTranslated(x
+1, y
+1, 0);
1458 glScalef(Scale
, Scale
, 0);
1459 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1464 glColor4ub(Red
, Green
, Blue
, 255);
1465 glTranslated(x
, y
, 0);
1466 glScalef(Scale
, Scale
, 0);
1467 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1469 glDisable(GL_TEXTURE_2D
);
1471 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1472 glDisable(GL_BLEND
);
1475 procedure e_TextureFontGetSize(ID
: DWORD
; var CharWidth
, CharHeight
: Byte);
1479 if e_NoGraphics
then Exit
;
1480 if Integer(ID
) > High(e_TextureFonts
) then
1482 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1483 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1486 procedure e_RemoveAllTextureFont();
1490 if e_NoGraphics
then Exit
;
1491 if e_TextureFonts
= nil then Exit
;
1493 for i
:= 0 to High(e_TextureFonts
) do
1494 if e_TextureFonts
[i
].Base
<> 0 then
1496 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1497 e_TextureFonts
[i
].Base
:= 0;
1500 e_TextureFonts
:= nil;
1503 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1510 function _Point(X
, Y
: Integer): TPoint2i
;
1516 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1520 Result
.Width
:= Width
;
1521 Result
.Height
:= Height
;
1524 function _TRect(L
, T
, R
, B
: LongInt): TRectE
;