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_texture
, SDL2
, GL
, GLExt
, MAPDEF
, ImagingTypes
, Imaging
, ImagingUtility
;
25 TMirrorType
=(M_NONE
, M_HORIZONTAL
, M_VERTICAL
);
26 TBlending
=(B_NONE
, B_BLEND
, B_FILTER
, B_INVERT
);
37 Left
, Top
, Right
, Bottom
: Integer;
55 //------------------------------------------------------------------
57 //------------------------------------------------------------------
59 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
60 procedure e_ResizeWindow(Width
, Height
: Integer);
62 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
63 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
64 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
65 Blending
: Boolean; Angle
: Single; RC
: PDFPoint
; Mirror
: TMirrorType
= M_NONE
);
66 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
67 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
68 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
69 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
71 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
72 AlphaChannel
: Boolean; Blending
: Boolean);
74 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; 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 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
82 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
84 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
85 function e_CreateTexture(FileName
: string; var ID
: DWORD
): Boolean;
86 function e_CreateTextureEx(FileName
: string; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
87 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
88 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
89 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
90 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
91 procedure e_DeleteTexture(ID
: DWORD
);
92 procedure e_RemoveAllTextures();
95 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
96 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
97 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
98 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
99 Color
: TRGB
; Scale
: Single = 1.0);
100 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
101 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
102 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
103 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
104 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
105 procedure e_CharFont_Remove(FontID
: DWORD
);
106 procedure e_CharFont_RemoveAll();
109 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
111 procedure e_TextureFontKill(FontID
: DWORD
);
112 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
113 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
114 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
115 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
116 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
117 procedure e_RemoveAllTextureFont();
119 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
120 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
122 procedure e_ReleaseEngine();
123 procedure e_BeginRender();
124 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
125 procedure e_Clear(); overload
;
126 procedure e_EndRender();
128 function e_GetGamma(win
: PSDL_Window
): Byte;
129 procedure e_SetGamma(win
: PSDL_Window
;Gamma
: Byte);
131 procedure e_MakeScreenshot(st
: TStream
; Width
, Height
: Word);
133 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
134 function _Point(X
, Y
: Integer): TPoint2i
;
135 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
136 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
138 //function e_getTextGLId (ID: DWORD): GLuint;
142 e_NoGraphics
: Boolean = False;
143 e_FastScreenshots
: Boolean = true; // it's REALLY SLOW with `false`
157 TTextureFont
= record
167 Chars
: array[0..255] of
177 TSavedTexture
= record
184 e_Textures
: array of TTexture
= nil;
185 e_TextureFonts
: array of TTextureFont
= nil;
186 e_CharFonts
: array of TCharFont
;
187 //e_SavedTextures: array of TSavedTexture;
189 //function e_getTextGLId (ID: DWORD): GLuint; begin result := e_Textures[ID].tx.id; end;
191 //------------------------------------------------------------------
192 // Èíèöèàëèçèðóåò OpenGL
193 //------------------------------------------------------------------
194 procedure e_InitGL();
198 e_DummyTextures
:= True;
204 glDisable(GL_DEPTH_TEST
);
205 glEnable(GL_SCISSOR_TEST
);
206 glClearColor(0, 0, 0, 0);
209 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
211 mat
: Array [0..15] of GLDouble
;
214 if e_NoGraphics
then Exit
;
216 glScissor(X
, Y
, Width
, Height
);
217 glViewport(X
, Y
, Width
, Height
);
218 //gluOrtho2D(0, Width, Height, 0);
220 glMatrixMode(GL_PROJECTION
);
222 mat
[ 0] := 2.0 / Width
;
228 mat
[ 5] := -2.0 / Height
;
242 glLoadMatrixd(@mat
[0]);
244 glMatrixMode(GL_MODELVIEW
);
248 //------------------------------------------------------------------
249 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
250 //------------------------------------------------------------------
251 function FindTexture(): DWORD
;
255 if e_Textures
<> nil then
256 for i
:= 0 to High(e_Textures
) do
257 if e_Textures
[i
].tx
.Width
= 0 then
263 if e_Textures
= nil then
265 SetLength(e_Textures
, 32);
270 Result
:= High(e_Textures
) + 1;
271 SetLength(e_Textures
, Length(e_Textures
) + 32);
275 //------------------------------------------------------------------
277 //------------------------------------------------------------------
278 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
285 e_WriteLog('Loading texture from '+FileName
, MSG_NOTIFY
);
287 find_id
:= FindTexture();
289 if not LoadTexture(FileName
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].tx
.Width
,
290 e_Textures
[find_id
].tx
.Height
, @fmt
) then Exit
;
297 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
304 find_id
:= FindTexture();
306 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
313 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
320 find_id
:= FindTexture
;
322 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
;
329 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
336 find_id
:= FindTexture();
338 if not LoadTextureMemEx(pData
, dataSize
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
345 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
351 find_id
:= FindTexture();
352 if not LoadTextureImg(img
, e_Textures
[find_id
].tx
, tw
, th
, @fmt
) then exit
;
357 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
359 if Width
<> nil then Width
^ := e_Textures
[ID
].tx
.Width
;
360 if Height
<> nil then Height
^ := e_Textures
[ID
].tx
.Height
;
363 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
371 w
:= e_Textures
[ID
].tx
.Width
;
372 h
:= e_Textures
[ID
].tx
.Height
;
379 if e_NoGraphics
then Exit
;
381 data
:= GetMemory(w
*h
*4);
382 glEnable(GL_TEXTURE_2D
);
383 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
384 glGetTexImage(GL_TEXTURE_2D
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, data
);
386 for y
:= h
-1 downto 0 do
393 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
399 Result
.Y
:= h
-lastline
;
411 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
417 Result
.Height
:= h
-lastline
-Result
.Y
;
429 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
435 Result
.X
:= lastline
+1;
440 for x
:= w
-1 downto 0 do
447 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
453 Result
.Width
:= lastline
-Result
.X
+1;
461 procedure e_ResizeWindow(Width
, Height
: Integer);
465 e_SetViewPort(0, 0, Width
, Height
);
468 procedure drawTxQuad (x0
, y0
, w
, h
: Integer; u
, v
: single; Mirror
: TMirrorType
);
470 x1
, y1
, tmp
: Integer;
472 if (w
< 1) or (h
< 1) then exit
;
475 if Mirror
= M_HORIZONTAL
then begin tmp
:= x1
; x1
:= x0
; x0
:= tmp
; end
476 else if Mirror
= M_VERTICAL
then begin tmp
:= y1
; y1
:= y0
; y0
:= tmp
; end;
477 glTexCoord2f(0, v
); glVertex2i(x0
, y0
);
478 glTexCoord2f(0, 0); glVertex2i(x0
, y1
);
479 glTexCoord2f(u
, 0); glVertex2i(x1
, y1
);
480 glTexCoord2f(u
, v
); glVertex2i(x1
, y0
);
483 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
484 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
486 if e_NoGraphics
then Exit
;
487 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
489 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
494 if (AlphaChannel
) or (Alpha
> 0) then
495 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
498 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
501 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
503 glEnable(GL_TEXTURE_2D
);
504 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
507 drawTxQuad(X
, Y
, e_Textures
[id
].tx
.width
, e_Textures
[id
].tx
.height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
509 //u := e_Textures[ID].tx.u;
510 //v := e_Textures[ID].tx.v;
513 if Mirror = M_NONE then
515 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
516 glTexCoord2f(0, 0); glVertex2i(X, Y);
517 glTexCoord2f(0, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
518 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
521 if Mirror = M_HORIZONTAL then
523 glTexCoord2f(u, 0); glVertex2i(X, Y);
524 glTexCoord2f(0, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
525 glTexCoord2f(0, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
526 glTexCoord2f(u, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
529 if Mirror = M_VERTICAL then
531 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y);
532 glTexCoord2f(0, -v); glVertex2i(X, Y);
533 glTexCoord2f(0, 0); glVertex2i(X, Y + e_Textures[id].tx.Height);
534 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
543 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
544 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
548 if e_NoGraphics
then Exit
;
549 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
551 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
556 if (AlphaChannel
) or (Alpha
> 0) then
557 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
560 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
563 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
565 glEnable(GL_TEXTURE_2D
);
566 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
568 u
:= e_Textures
[ID
].tx
.u
;
569 v
:= e_Textures
[ID
].tx
.v
;
572 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
573 glTexCoord2f(u
, v
); glVertex2i(X
+ Width
, Y
);
574 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
575 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
581 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
582 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
584 if e_NoGraphics
then Exit
;
585 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
587 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
592 if (AlphaChannel
) or (Alpha
> 0) then
593 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
596 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
599 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
601 glEnable(GL_TEXTURE_2D
);
602 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
604 drawTxQuad(X
, Y
, Width
, Height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
610 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
611 AlphaChannel
: Boolean; Blending
: Boolean);
613 X2
, Y2
, dx
, w
, h
: Integer;
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
);
639 glEnable(GL_TEXTURE_2D
);
640 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
642 X2
:= X
+ e_Textures
[ID
].tx
.width
* XCount
;
643 Y2
:= Y
+ e_Textures
[ID
].tx
.height
* YCount
;
645 //k8: this SHOULD work... i hope
646 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
649 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
650 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
651 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
652 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
659 u
:= e_Textures
[ID
].tx
.u
;
660 v
:= e_Textures
[ID
].tx
.v
;
661 w
:= e_Textures
[ID
].tx
.width
;
662 h
:= e_Textures
[ID
].tx
.height
;
669 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
670 glTexCoord2f(u
, v
); glVertex2i(X
+w
, Y
);
671 glTexCoord2f(u
, 0); glVertex2i(X
+w
, Y
+h
);
672 glTexCoord2f(0, 0); glVertex2i(X
, Y
+h
);
686 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; alphachannel
: Boolean; blending
: Boolean);
692 if e_NoGraphics
then exit
;
694 if (wdt
< 1) or (hgt
< 1) then exit
;
696 if (wdt
mod e_Textures
[ID
].tx
.width
= 0) and (hgt
mod e_Textures
[ID
].tx
.height
= 0) then
698 e_DrawFill(id
, x
, y
, wdt
div e_Textures
[ID
].tx
.width
, hgt
div e_Textures
[ID
].tx
.height
, alpha
, alphachannel
, blending
);
702 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
704 if (Alpha
> 0) or AlphaChannel
or Blending
then
709 if AlphaChannel
or (Alpha
> 0) then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
711 if (Alpha
> 0) then glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
713 if Blending
then glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
715 glEnable(GL_TEXTURE_2D
);
716 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
721 //k8: this SHOULD work... i hope
722 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
725 glTexCoord2f(0, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x
, y
);
726 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x2
, y
);
727 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, 0); glVertex2i(x2
, y2
);
728 glTexCoord2f(0, 0); glVertex2i(x
, y2
);
736 u := e_Textures[ID].tx.u;
737 v := e_Textures[ID].tx.v;
738 w := e_Textures[ID].tx.width;
739 h := e_Textures[ID].tx.height;
746 glTexCoord2f(0, v); glVertex2i(X, Y);
747 glTexCoord2f(u, v); glVertex2i(X+w, Y);
748 glTexCoord2f(u, 0); glVertex2i(X+w, Y+h);
749 glTexCoord2f(0, 0); glVertex2i(X, Y+h);
765 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
766 Blending
: Boolean; Angle
: Single; RC
: PDFPoint
; Mirror
: TMirrorType
= M_NONE
);
768 if e_NoGraphics
then Exit
;
770 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
772 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
777 if (AlphaChannel
) or (Alpha
> 0) then
778 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
781 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
784 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
786 if (Angle
<> 0) and (RC
<> nil) then
789 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
790 glRotatef(Angle
, 0, 0, 1);
791 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
794 glEnable(GL_TEXTURE_2D
);
795 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
796 glBegin(GL_QUADS
); //0-1 1-1
798 drawTxQuad(X
, Y
, e_Textures
[id
].tx
.width
, e_Textures
[id
].tx
.height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
807 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
809 if e_NoGraphics
then Exit
;
810 glDisable(GL_TEXTURE_2D
);
811 glColor3ub(Red
, Green
, Blue
);
814 if (Size
= 2) or (Size
= 4) then
818 glVertex2f(X
+0.3, Y
+1.0);
821 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
824 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
826 // Make lines only top-left/bottom-right and top-right/bottom-left
838 // Pixel-perfect hack
846 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
848 nX1
, nY1
, nX2
, nY2
: Integer;
850 if e_NoGraphics
then Exit
;
851 // Only top-left/bottom-right quad
868 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
872 glDisable(GL_TEXTURE_2D
);
873 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
877 nX1
:= X1
; nY1
:= Y1
;
878 nX2
:= X2
; nY2
:= Y1
;
879 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
880 glVertex2i(nX1
, nY1
);
881 glVertex2i(nX2
, nY2
);
883 nX1
:= X2
; nY1
:= Y1
;
884 nX2
:= X2
; nY2
:= Y2
;
885 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
886 glVertex2i(nX1
, nY1
);
887 glVertex2i(nX2
, nY2
);
889 nX1
:= X2
; nY1
:= Y2
;
890 nX2
:= X1
; nY2
:= Y2
;
891 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
892 glVertex2i(nX1
, nY1
);
893 glVertex2i(nX2
, nY2
);
895 nX1
:= X1
; nY1
:= Y2
;
896 nX2
:= X1
; nY2
:= Y1
;
897 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
898 glVertex2i(nX1
, nY1
);
899 glVertex2i(nX2
, nY2
);
902 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
907 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
908 Blending
: TBlending
= B_NONE
);
910 if e_NoGraphics
then Exit
;
911 if (Alpha
> 0) or (Blending
<> B_NONE
) then
916 if Blending
= B_BLEND
then
917 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
919 if Blending
= B_FILTER
then
920 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
922 if Blending
= B_INVERT
then
923 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
926 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
928 glDisable(GL_TEXTURE_2D
);
929 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
941 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
947 // ////////////////////////////////////////////////////////////////////////// //
948 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
950 if (a
< 0) then a
:= 0;
951 if (a
> 255) then a
:= 255;
953 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
954 glDisable(GL_TEXTURE_2D
);
955 glColor4ub(0, 0, 0, Byte(255-a
));
962 //glRect(x, y, x+w, y+h);
963 glColor4ub(1, 1, 1, 1);
965 //glBlendEquation(GL_FUNC_ADD);
968 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
970 if (w
> 0) and (h
> 0) then e_DarkenQuad(x
, y
, x
+w
, y
+h
, a
);
974 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
976 if e_NoGraphics
then Exit
;
977 // Pixel-perfect lines
979 e_LineCorrection(X1
, Y1
, X2
, Y2
);
984 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
988 glDisable(GL_TEXTURE_2D
);
989 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
997 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1002 //------------------------------------------------------------------
1003 // Óäàëÿåò òåêñòóðó èç ìàññèâà
1004 //------------------------------------------------------------------
1005 procedure e_DeleteTexture(ID
: DWORD
);
1007 if not e_NoGraphics
then
1008 glDeleteTextures(1, @e_Textures
[ID
].tx
.id
);
1009 e_Textures
[ID
].tx
.id
:= 0;
1010 e_Textures
[ID
].tx
.Width
:= 0;
1011 e_Textures
[ID
].tx
.Height
:= 0;
1014 //------------------------------------------------------------------
1015 // Óäàëÿåò âñå òåêñòóðû
1016 //------------------------------------------------------------------
1017 procedure e_RemoveAllTextures();
1021 if e_Textures
= nil then Exit
;
1023 for i
:= 0 to High(e_Textures
) do
1024 if e_Textures
[i
].tx
.Width
<> 0 then e_DeleteTexture(i
);
1028 //------------------------------------------------------------------
1030 //------------------------------------------------------------------
1031 procedure e_ReleaseEngine();
1033 e_RemoveAllTextures
;
1034 e_RemoveAllTextureFont
;
1037 procedure e_BeginRender();
1039 if e_NoGraphics
then Exit
;
1040 glEnable(GL_ALPHA_TEST
);
1041 glAlphaFunc(GL_GREATER
, 0.0);
1044 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
1046 if e_NoGraphics
then Exit
;
1047 glClearColor(Red
, Green
, Blue
, 0);
1051 procedure e_Clear(); overload
;
1053 if e_NoGraphics
then Exit
;
1054 glClearColor(0, 0, 0, 0);
1055 glClear(GL_COLOR_BUFFER_BIT
);
1058 procedure e_EndRender();
1060 if e_NoGraphics
then Exit
;
1064 function e_GetGamma(win
: PSDL_Window
): Byte;
1066 ramp
: array [0..256*3-1] of Word;
1067 rgb
: array [0..2] of Double;
1076 if e_NoGraphics
then Exit
;
1081 SDL_GetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1090 for j
:= min
to max
- 1 do
1093 B
:= (j
mod 256)/256;
1095 sum
:= sum
+ ln(A
)/ln(B
);
1098 rgb
[i
] := sum
/ count
;
1101 Result
:= 100 - Trunc(((rgb
[0] + rgb
[1] + rgb
[2])/3 - 0.23) * 100/(2.7 - 0.23));
1104 procedure e_SetGamma(win
: PSDL_Window
; Gamma
: Byte);
1106 ramp
: array [0..256*3-1] of Word;
1111 if e_NoGraphics
then Exit
;
1112 g
:= (100 - Gamma
)*(2.7 - 0.23)/100 + 0.23;
1114 for i
:= 0 to 255 do
1116 r
:= Exp(g
* ln(i
/256))*65536;
1117 if r
< 0 then r
:= 0
1118 else if r
> 65535 then r
:= 65535;
1119 ramp
[i
] := trunc(r
);
1120 ramp
[i
+ 256] := trunc(r
);
1121 ramp
[i
+ 512] := trunc(r
);
1124 SDL_SetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1127 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1131 e_WriteLog('Creating CharFont...', MSG_NOTIFY
);
1135 if e_CharFonts
<> nil then
1136 for i
:= 0 to High(e_CharFonts
) do
1137 if not e_CharFonts
[i
].alive
then
1143 if id
= DWORD(-1) then
1145 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1146 id
:= High(e_CharFonts
);
1149 with e_CharFonts
[id
] do
1151 for i
:= 0 to High(Chars
) do
1165 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1167 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1169 TextureID
:= Texture
;
1174 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1178 if e_NoGraphics
then Exit
;
1179 if Text = '' then Exit
;
1180 if e_CharFonts
= nil then Exit
;
1181 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1183 with e_CharFonts
[FontID
] do
1185 for a
:= 1 to Length(Text) do
1186 with Chars
[Ord(Text[a
])] do
1187 if TextureID
<> -1 then
1189 e_Draw(TextureID
, X
, Y
, 0, True, False);
1190 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1195 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1196 Color
: TRGB
; Scale
: Single = 1.0);
1201 if e_NoGraphics
then Exit
;
1202 if Text = '' then Exit
;
1203 if e_CharFonts
= nil then Exit
;
1204 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1206 with e_CharFonts
[FontID
] do
1208 for a
:= 1 to Length(Text) do
1209 with Chars
[Ord(Text[a
])] do
1210 if TextureID
<> -1 then
1212 if Scale
<> 1.0 then
1215 glScalef(Scale
, Scale
, 0);
1220 e_Draw(TextureID
, X
, Y
, 0, True, False);
1223 if Scale
<> 1.0 then glPopMatrix
;
1225 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1230 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1232 a
, TX
, TY
, len
: Integer;
1236 if e_NoGraphics
then Exit
;
1237 if Text = '' then Exit
;
1238 if e_CharFonts
= nil then Exit
;
1239 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1247 len
:= Length(Text);
1249 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1251 with e_CharFonts
[FontID
] do
1253 for a
:= 1 to len
do
1264 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1269 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1274 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1279 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1284 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1289 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1294 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1299 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1304 with Chars
[Ord(Text[a
])] do
1305 if TextureID
<> -1 then
1309 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1312 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1318 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1326 if Text = '' then Exit
;
1327 if e_CharFonts
= nil then Exit
;
1328 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1330 with e_CharFonts
[FontID
] do
1332 for a
:= 1 to Length(Text) do
1333 with Chars
[Ord(Text[a
])] do
1334 if TextureID
<> -1 then
1336 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1337 e_GetTextureSize(TextureID
, nil, @h2
);
1338 if h2
> h
then h
:= h2
;
1343 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1345 a
, lines
, len
: Integer;
1352 if Text = '' then Exit
;
1353 if e_CharFonts
= nil then Exit
;
1354 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1357 len
:= Length(Text);
1359 with e_CharFonts
[FontID
] do
1361 for a
:= 1 to len
do
1363 if Text[a
] = #10 then
1373 else if Text[a
] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1376 with Chars
[Ord(Text[a
])] do
1377 if TextureID
<> -1 then
1379 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1380 e_GetTextureSize(TextureID
, nil, @h2
);
1381 if h2
> h
then h
:= h2
;
1391 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1397 if e_CharFonts
= nil then Exit
;
1398 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1400 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1401 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1404 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1411 if e_CharFonts
= nil then Exit
;
1412 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1414 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1416 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1417 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1419 if h2
> Result
then Result
:= h2
;
1423 procedure e_CharFont_Remove(FontID
: DWORD
);
1427 with e_CharFonts
[FontID
] do
1428 for a
:= 0 to High(Chars
) do
1429 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1431 e_CharFonts
[FontID
].alive
:= False;
1434 procedure e_CharFont_RemoveAll();
1438 if e_CharFonts
= nil then Exit
;
1440 for a
:= 0 to High(e_CharFonts
) do
1441 e_CharFont_Remove(a
);
1446 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1453 if e_NoGraphics
then Exit
;
1454 e_WriteLog('Creating texture font...', MSG_NOTIFY
);
1458 if e_TextureFonts
<> nil then
1459 for i
:= 0 to High(e_TextureFonts
) do
1460 if e_TextureFonts
[i
].Base
= 0 then
1466 if id
= DWORD(-1) then
1468 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1469 id
:= High(e_TextureFonts
);
1472 with e_TextureFonts
[id
] do
1474 Base
:= glGenLists(XCount
*YCount
);
1475 TextureID
:= e_Textures
[Tex
].tx
.id
;
1476 CharWidth
:= (e_Textures
[Tex
].tx
.Width
div XCount
)+Space
;
1477 CharHeight
:= e_Textures
[Tex
].tx
.Height
div YCount
;
1484 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1485 for loop1
:= 0 to XCount
*YCount
-1 do
1487 cx
:= (loop1
mod XCount
)/XCount
;
1488 cy
:= (loop1
div YCount
)/YCount
;
1490 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1492 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1493 glVertex2i(0, e_Textures
[Tex
].tx
.Height
div YCount
);
1495 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1496 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, e_Textures
[Tex
].tx
.Height
div YCount
);
1498 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1499 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, 0);
1501 glTexCoord2f(cx
, 1.0-cy
);
1504 glTranslated((e_Textures
[Tex
].tx
.Width
div XCount
)+Space
, 0, 0);
1511 procedure e_TextureFontKill(FontID
: DWORD
);
1513 if e_NoGraphics
then Exit
;
1514 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1515 e_TextureFonts
[FontID
].Base
:= 0;
1518 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1520 if e_NoGraphics
then Exit
;
1521 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1522 if Text = '' then Exit
;
1524 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1527 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1530 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1531 glEnable(GL_TEXTURE_2D
);
1532 glTranslated(x
, y
, 0);
1533 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1534 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1535 glDisable(GL_TEXTURE_2D
);
1538 glDisable(GL_BLEND
);
1541 // god forgive me for this, but i cannot figure out how to do it without lists
1542 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1544 if e_NoGraphics
then Exit
;
1549 glColor4ub(0, 0, 0, 128);
1550 glTranslated(X
+1, Y
+1, 0);
1551 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1556 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1557 glTranslated(X
, Y
, 0);
1558 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1563 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1565 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1566 glEnable(GL_TEXTURE_2D
);
1567 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1569 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1571 e_TextureFontPrintChar(X
, Y
, Ch
, FontID
, Shadow
);
1572 glDisable(GL_TEXTURE_2D
);
1573 glDisable(GL_BLEND
);
1576 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
1578 result
:= e_TextureFonts
[FontID
].CharWidth
;
1581 procedure e_TextureFontPrintFmt(X
, Y
: Integer; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
1583 a
, TX
, TY
, len
: Integer;
1587 if e_NoGraphics
then Exit
;
1588 if Text = '' then Exit
;
1589 if e_TextureFonts
= nil then Exit
;
1590 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1598 len
:= Length(Text);
1600 w
:= e_TextureFonts
[FontID
].CharWidth
;
1602 with e_TextureFonts
[FontID
] do
1604 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1605 glEnable(GL_TEXTURE_2D
);
1606 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1608 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1611 for a
:= 1 to len
do
1622 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1627 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1632 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1637 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1642 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1647 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1652 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1657 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1664 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1669 glDisable(GL_TEXTURE_2D
);
1670 glDisable(GL_BLEND
);
1674 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1675 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1677 if e_NoGraphics
then Exit
;
1678 if Text = '' then Exit
;
1681 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1682 glEnable(GL_TEXTURE_2D
);
1683 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1685 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1690 glColor4ub(0, 0, 0, 128);
1691 glTranslated(x
+1, y
+1, 0);
1692 glScalef(Scale
, Scale
, 0);
1693 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1698 glColor4ub(Red
, Green
, Blue
, 255);
1699 glTranslated(x
, y
, 0);
1700 glScalef(Scale
, Scale
, 0);
1701 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1703 glDisable(GL_TEXTURE_2D
);
1705 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1706 glDisable(GL_BLEND
);
1709 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
1713 if e_NoGraphics
then Exit
;
1714 if Integer(ID
) > High(e_TextureFonts
) then
1716 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1717 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1720 procedure e_RemoveAllTextureFont();
1724 if e_NoGraphics
then Exit
;
1725 if e_TextureFonts
= nil then Exit
;
1727 for i
:= 0 to High(e_TextureFonts
) do
1728 if e_TextureFonts
[i
].Base
<> 0 then
1730 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1731 e_TextureFonts
[i
].Base
:= 0;
1734 e_TextureFonts
:= nil;
1737 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1744 function _Point(X
, Y
: Integer): TPoint2i
;
1750 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1754 Result
.Width
:= Width
;
1755 Result
.Height
:= Height
;
1758 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
1767 procedure e_MakeScreenshot (st
: TStream
; Width
, Height
: Word);
1769 pixels
, obuf
, scln
, ps
, pd
: PByte;
1772 i
, x
, y
, res
: Integer;
1773 sign
: array [0..7] of Byte;
1774 hbuf
: array [0..12] of Byte;
1779 if e_NoGraphics
then Exit
;
1782 // first, extract and pack graphics data
1783 if (Width
mod 4) > 0 then Width
:= Width
+4-(Width
mod 4);
1785 GetMem(pixels
, Width
*Height
*3);
1787 FillChar(pixels
^, Width
*Height
*3, 0);
1788 glReadPixels(0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pixels
);
1789 //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
1791 if e_FastScreenshots
then
1794 GetMem(scln
, (Width
*3+1)*Height
);
1798 Inc(ps
, (Width
*3)*(Height
-1));
1799 for i
:= 0 to Height
-1 do
1803 Move(ps
^, pd
^, Width
*3);
1815 obufsize
:= (Width
*3+1)*Height
*2;
1816 GetMem(obuf
, obufsize
);
1821 res
:= compress2(Pointer(obuf
), dlen
, Pointer(pixels
), (Width
*3+1)*Height
, 9);
1822 if res
= Z_OK
then break
;
1823 if res
<> Z_BUF_ERROR
then raise Exception
.Create('can''t pack data for PNG');
1824 obufsize
:= obufsize
*2;
1827 GetMem(obuf
, obufsize
);
1829 //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
1842 st
.writeBuffer(sign
, 8);
1843 //e_WriteLog('PNG: signature written', MSG_NOTIFY);
1846 writeIntBE(st
, LongWord(13));
1851 st
.writeBuffer(sign
, 4);
1852 crc
:= crc32(0, @sign
[0], 4);
1855 hbuf
[2] := (Width
shr 8) and $ff;
1856 hbuf
[3] := Width
and $ff;
1859 hbuf
[6] := (Height
shr 8) and $ff;
1860 hbuf
[7] := Height
and $ff;
1861 hbuf
[8] := 8; // bit depth
1862 hbuf
[9] := 2; // RGB
1863 hbuf
[10] := 0; // compression method
1864 hbuf
[11] := 0; // filter method
1865 hbuf
[12] := 0; // no interlace
1866 crc
:= crc32(crc
, @hbuf
[0], 13);
1867 st
.writeBuffer(hbuf
, 13);
1868 writeIntBE(st
, crc
);
1869 //e_WriteLog('PNG: header written', MSG_NOTIFY);
1872 writeIntBE(st
, LongWord(dlen
));
1877 st
.writeBuffer(sign
, 4);
1878 crc
:= crc32(0, @sign
[0], 4);
1879 crc
:= crc32(crc
, obuf
, dlen
);
1880 st
.writeBuffer(obuf
^, dlen
);
1881 writeIntBE(st
, crc
);
1882 //e_WriteLog('PNG: image data written', MSG_NOTIFY);
1885 writeIntBE(st
, LongWord(0));
1890 st
.writeBuffer(sign
, 4);
1891 crc
:= crc32(0, @sign
[0], 4);
1892 writeIntBE(st
, crc
);
1893 //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
1895 if obuf
<> nil then FreeMem(obuf
);
1900 Imaging
.SetOption(ImagingPNGCompressLevel
, 9);
1901 Imaging
.SetOption(ImagingPNGPreFilter
, 6);
1904 NewImage(Width
, Height
, TImageFormat
.ifR8G8B8
, img
);
1906 //writeln(stderr, 'moving pixels...');
1907 for y
:= Height
-1 downto 0 do
1909 for x
:= 0 to Width
-1 do
1911 clr
.r
:= ps
^; Inc(ps
);
1912 clr
.g
:= ps
^; Inc(ps
);
1913 clr
.b
:= ps
^; Inc(ps
);
1915 SetPixel32(img
, x
, y
, clr
);
1918 GlobalMetadata
.ClearMetaItems();
1919 GlobalMetadata
.ClearMetaItemsForSaving();
1920 //writeln(stderr, 'compressing image...');
1921 if not SaveImageToStream('png', st
, img
) then raise Exception
.Create('screenshot writing error');
1922 //writeln(stderr, 'done!');