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}
27 SysUtils
, Classes
, Math
, e_log
, e_texture
, SDL2
, MAPDEF
, ImagingTypes
, Imaging
, ImagingUtility
;
30 TMirrorType
=(None
, Horizontal
, Vertical
);
31 TBlending
=(None
, Blend
, Filter
, Invert
);
42 Left
, Top
, Right
, Bottom
: Integer;
60 //------------------------------------------------------------------
62 //------------------------------------------------------------------
64 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
65 procedure e_ResizeWindow(Width
, Height
: Integer);
67 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
68 Blending
: Boolean; Mirror
: TMirrorType
= TMirrorType
.None
);
69 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
70 Blending
: Boolean; Angle
: Single; RC
: PDFPoint
; Mirror
: TMirrorType
= TMirrorType
.None
);
71 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
72 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
73 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
74 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
76 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
77 AlphaChannel
: Boolean; Blending
: Boolean; ambientBlendMode
: Boolean=false);
79 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; alphachannel
: Boolean;
80 blending
: Boolean; scale
: Single; ambientBlendMode
: Boolean=false);
82 procedure e_AmbientQuad (x
, y
, w
, h
: Integer; r
, g
, b
, a
: Byte);
84 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
85 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
86 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
87 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
88 Blending
: TBlending
= TBlending
.None
);
89 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
90 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
92 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
93 function e_CreateTexture(FileName
: string; var ID
: DWORD
): Boolean;
94 function e_CreateTextureEx(FileName
: string; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
95 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
96 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
97 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
98 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
99 procedure e_DeleteTexture(ID
: DWORD
);
100 procedure e_RemoveAllTextures();
103 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
104 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
105 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
106 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
107 Color
: TRGB
; Scale
: Single = 1.0);
108 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
109 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
110 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
111 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
112 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
113 procedure e_CharFont_Remove(FontID
: DWORD
);
114 procedure e_CharFont_RemoveAll();
117 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
119 procedure e_TextureFontKill(FontID
: DWORD
);
120 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
121 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
122 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
123 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
124 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
125 procedure e_RemoveAllTextureFont();
127 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
128 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
130 procedure e_ReleaseEngine();
131 procedure e_BeginRender();
132 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
133 procedure e_Clear(); overload
;
134 procedure e_EndRender();
136 function e_GetGamma(win
: PSDL_Window
): Byte;
137 procedure e_SetGamma(win
: PSDL_Window
;Gamma
: Byte);
139 procedure e_MakeScreenshot(st
: TStream
; Width
, Height
: Word);
141 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
142 function _Point(X
, Y
: Integer): TPoint2i
;
143 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
144 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
146 //function e_getTextGLId (ID: DWORD): GLuint;
150 e_NoGraphics
: Boolean = False;
151 e_FastScreenshots
: Boolean = true; // it's REALLY SLOW with `false`
152 g_dbg_scale
: Single = 1.0;
166 TTextureFont
= record
177 Chars
: array[0..255] of
187 TSavedTexture
= record
194 e_Textures
: array of TTexture
= nil;
195 e_TextureFonts
: array of TTextureFont
= nil;
196 e_CharFonts
: array of TCharFont
;
197 //e_SavedTextures: array of TSavedTexture;
199 //function e_getTextGLId (ID: DWORD): GLuint; begin result := e_Textures[ID].tx.id; end;
201 //------------------------------------------------------------------
202 // Èíèöèàëèçèðóåò OpenGL
203 //------------------------------------------------------------------
204 procedure e_InitGL();
208 e_DummyTextures
:= True;
214 glDisable(GL_DEPTH_TEST
);
215 glEnable(GL_SCISSOR_TEST
);
216 glClearColor(0, 0, 0, 0);
219 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
221 mat
: Array [0..15] of GLDouble
;
224 if e_NoGraphics
then Exit
;
226 glScissor(X
, Y
, Width
, Height
);
227 glViewport(X
, Y
, Width
, Height
);
228 //gluOrtho2D(0, Width, Height, 0);
230 glMatrixMode(GL_PROJECTION
);
232 mat
[ 0] := 2.0 / Width
;
238 mat
[ 5] := -2.0 / Height
;
252 glLoadMatrixd(@mat
[0]);
254 glMatrixMode(GL_MODELVIEW
);
258 //------------------------------------------------------------------
259 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
260 //------------------------------------------------------------------
261 function FindTexture(): DWORD
;
265 if e_Textures
<> nil then
266 for i
:= 0 to High(e_Textures
) do
267 if e_Textures
[i
].tx
.Width
= 0 then
273 if e_Textures
= nil then
275 SetLength(e_Textures
, 32);
280 Result
:= High(e_Textures
) + 1;
281 SetLength(e_Textures
, Length(e_Textures
) + 32);
285 //------------------------------------------------------------------
287 //------------------------------------------------------------------
288 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
295 e_WriteLog('Loading texture from '+FileName
, TMsgType
.Notify
);
297 find_id
:= FindTexture();
299 if not LoadTexture(FileName
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].tx
.Width
,
300 e_Textures
[find_id
].tx
.Height
, @fmt
) then Exit
;
307 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
314 find_id
:= FindTexture();
316 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
323 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
330 find_id
:= FindTexture
;
332 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
;
339 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
346 find_id
:= FindTexture();
348 if not LoadTextureMemEx(pData
, dataSize
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
355 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
361 find_id
:= FindTexture();
362 if not LoadTextureImg(img
, e_Textures
[find_id
].tx
, tw
, th
, @fmt
) then exit
;
367 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
369 if Width
<> nil then Width
^ := e_Textures
[ID
].tx
.Width
;
370 if Height
<> nil then Height
^ := e_Textures
[ID
].tx
.Height
;
373 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
381 w
:= e_Textures
[ID
].tx
.Width
;
382 h
:= e_Textures
[ID
].tx
.Height
;
389 {$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support glGetTexImage
390 if e_NoGraphics
then Exit
;
392 data
:= GetMemory(w
*h
*4);
393 glEnable(GL_TEXTURE_2D
);
394 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
395 glGetTexImage(GL_TEXTURE_2D
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, data
);
397 for y
:= h
-1 downto 0 do
404 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
410 Result
.Y
:= h
-lastline
;
422 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
428 Result
.Height
:= h
-lastline
-Result
.Y
;
440 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
446 Result
.X
:= lastline
+1;
451 for x
:= w
-1 downto 0 do
458 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
464 Result
.Width
:= lastline
-Result
.X
+1;
473 procedure e_ResizeWindow(Width
, Height
: Integer);
477 e_SetViewPort(0, 0, Width
, Height
);
480 procedure drawTxQuad (x0
, y0
, w
, h
, tw
, th
: Integer; u
, v
: single; Mirror
: TMirrorType
);
482 x1
, y1
, tmp
: Integer;
484 if (w
< 1) or (h
< 1) then exit
;
487 if Mirror
= TMirrorType
.Horizontal
then begin tmp
:= x1
; x1
:= x0
; x0
:= tmp
; end
488 else if Mirror
= TMirrorType
.Vertical
then begin tmp
:= y1
; y1
:= y0
; y0
:= tmp
; end;
489 //HACK: make texture one pixel shorter, so it won't wrap
490 if (g_dbg_scale
<> 1.0) then
495 glTexCoord2f(0, v
); glVertex2i(x0
, y0
);
496 glTexCoord2f(0, 0); glVertex2i(x0
, y1
);
497 glTexCoord2f(u
, 0); glVertex2i(x1
, y1
);
498 glTexCoord2f(u
, v
); glVertex2i(x1
, y0
);
501 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
502 Blending
: Boolean; Mirror
: TMirrorType
= TMirrorType
.None
);
504 if e_NoGraphics
then Exit
;
505 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
507 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
512 if (AlphaChannel
) or (Alpha
> 0) then
513 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
516 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
519 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
521 glEnable(GL_TEXTURE_2D
);
522 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
525 drawTxQuad(X
, Y
, e_Textures
[id
].tx
.width
, e_Textures
[id
].tx
.height
, e_Textures
[id
].tx
.width
, e_Textures
[id
].tx
.height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
527 //u := e_Textures[ID].tx.u;
528 //v := e_Textures[ID].tx.v;
531 if Mirror = M_NONE then
533 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
534 glTexCoord2f(0, 0); glVertex2i(X, Y);
535 glTexCoord2f(0, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
536 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
539 if Mirror = M_HORIZONTAL then
541 glTexCoord2f(u, 0); glVertex2i(X, Y);
542 glTexCoord2f(0, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
543 glTexCoord2f(0, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
544 glTexCoord2f(u, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
547 if Mirror = M_VERTICAL then
549 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y);
550 glTexCoord2f(0, -v); glVertex2i(X, Y);
551 glTexCoord2f(0, 0); glVertex2i(X, Y + e_Textures[id].tx.Height);
552 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
561 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
562 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
566 if e_NoGraphics
then Exit
;
567 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
569 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
574 if (AlphaChannel
) or (Alpha
> 0) then
575 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
578 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
581 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
583 glEnable(GL_TEXTURE_2D
);
584 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
586 u
:= e_Textures
[ID
].tx
.u
;
587 v
:= e_Textures
[ID
].tx
.v
;
590 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
591 glTexCoord2f(u
, v
); glVertex2i(X
+ Width
, Y
);
592 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
593 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
599 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
600 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
602 if e_NoGraphics
then Exit
;
603 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
605 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
610 if (AlphaChannel
) or (Alpha
> 0) then
611 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
614 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
617 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
619 glEnable(GL_TEXTURE_2D
);
620 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
622 drawTxQuad(X
, Y
, Width
, Height
, e_Textures
[id
].tx
.width
, e_Textures
[id
].tx
.height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
628 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
629 AlphaChannel
: Boolean; Blending
: Boolean; ambientBlendMode
: Boolean=false);
631 X2
, Y2
, dx
, w
, h
: Integer;
634 if e_NoGraphics
then Exit
;
635 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
636 ambientBlendMode
:= false;
638 if (Alpha
> 0) or AlphaChannel
or Blending
then
644 if not ambientBlendMode
then glDisable(GL_BLEND
);
646 if AlphaChannel
or (Alpha
> 0) then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
647 if (Alpha
> 0) then glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
648 if Blending
then glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
650 if (XCount
= 0) then XCount
:= 1;
651 if (YCount
= 0) then YCount
:= 1;
653 glEnable(GL_TEXTURE_2D
);
654 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
656 X2
:= X
+e_Textures
[ID
].tx
.width
*XCount
;
657 Y2
:= Y
+e_Textures
[ID
].tx
.height
*YCount
;
659 //k8: this SHOULD work... i hope
660 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
663 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
664 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
665 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
666 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
673 u
:= e_Textures
[ID
].tx
.u
;
674 v
:= e_Textures
[ID
].tx
.v
;
675 w
:= e_Textures
[ID
].tx
.width
;
676 h
:= e_Textures
[ID
].tx
.height
;
683 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
684 glTexCoord2f(u
, v
); glVertex2i(X
+w
, Y
);
685 glTexCoord2f(u
, 0); glVertex2i(X
+w
, Y
+h
);
686 glTexCoord2f(0, 0); glVertex2i(X
, Y
+h
);
701 //TODO: overflow checks
702 function intersectRect (var x0
, y0
, w0
, h0
: Integer; const x1
, y1
, w1
, h1
: Integer): Boolean;
707 if (w0
< 1) or (h0
< 1) or (w1
< 1) or (h1
< 1) then exit
;
708 // check for intersection
709 if (x0
+w0
<= x1
) or (y0
+h0
<= y1
) or (x1
+w1
<= x0
) or (y1
+h1
<= y0
) then exit
;
710 if (x0
>= x1
+w1
) or (y0
>= y1
+h1
) or (x1
>= x0
+h0
) or (y1
>= y0
+h0
) then exit
;
714 if (x0
< x1
) then x0
:= x1
;
715 if (y0
< y1
) then y0
:= y1
;
716 if (ex0
> x1
+w1
) then ex0
:= x1
+w1
;
717 if (ey0
> y1
+h1
) then ey0
:= y1
+h1
;
720 result
:= (w0
> 0) and (h0
> 0);
724 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; alphachannel
: Boolean;
725 blending
: Boolean; scale
: Single; ambientBlendMode
: Boolean=false);
730 scxywh: array[0..3] of GLint;
731 vpxywh: array[0..3] of GLint;
733 w
, h
, dw
, cw
, ch
, yofs
: Integer;
734 u
, v
, cu
, cv
: Single;
738 procedure setScissorGLInternal (x, y, w, h: Integer);
740 //if not scallowed then exit;
745 y := vpxywh[3]-(y+h);
746 if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then
748 glScissor(0, 0, 0, 0);
752 //writeln(' (', x, ',', y, ')-(', w, ',', h, ')');
753 glScissor(x, y, w, h);
759 if e_NoGraphics
then exit
;
760 ambientBlendMode
:= false;
762 if (wdt
< 1) or (hgt
< 1) then exit
;
764 if (wdt
mod e_Textures
[ID
].tx
.width
= 0) and (hgt
mod e_Textures
[ID
].tx
.height
= 0) then
766 e_DrawFill(id
, x
, y
, wdt
div e_Textures
[ID
].tx
.width
, hgt
div e_Textures
[ID
].tx
.height
, alpha
, alphachannel
, blending
, ambientBlendMode
);
770 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
772 if (Alpha
> 0) or AlphaChannel
or Blending
then
778 if not ambientBlendMode
then glDisable(GL_BLEND
);
780 if AlphaChannel
or (Alpha
> 0) then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
781 if (Alpha
> 0) then glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
782 if Blending
then glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
784 glEnable(GL_TEXTURE_2D
);
785 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
790 //k8: this SHOULD work... i hope
791 if {false and} (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
794 glTexCoord2f(0, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x
, y
);
795 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x2
, y
);
796 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, 0); glVertex2i(x2
, y2
);
797 glTexCoord2f(0, 0); glVertex2i(x
, y2
);
802 // hard day's night; setup scissor
804 glGetIntegerv(GL_VIEWPORT, @vpxywh[0]);
805 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
806 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
807 //writeln('(', scxywh[0], ',', scxywh[1], ')-(', scxywh[2], ',', scxywh[3], ')');
808 //glEnable(GL_SCISSOR_TEST);
809 setScissorGLInternal(x, y, wdt, hgt);
812 u
:= e_Textures
[ID
].tx
.u
;
813 v
:= e_Textures
[ID
].tx
.v
;
814 w
:= e_Textures
[ID
].tx
.width
;
815 h
:= e_Textures
[ID
].tx
.height
;
817 if (hgt
> h
) then begin y
+= hgt
-h
; onlyOneY
:= false; end else onlyOneY
:= true;
821 if (hgt
>= h
) then begin ch
:= h
; cv
:= v
; yofs
:= 0; end else begin ch
:= hgt
; cv
:= v
/(h
/hgt
); yofs
:= h
-hgt
; end;
822 if onlyOneY
then yofs
:= 0;
828 if (dw
>= w
) then begin cw
:= w
; cu
:= u
; end else begin cw
:= dw
; cu
:= u
/(w
/dw
); end;
830 glTexCoord2f(0, cv
); glVertex2i(X
, Y
+yofs
);
831 glTexCoord2f(cu
, cv
); glVertex2i(X
+cw
, Y
+yofs
);
832 glTexCoord2f(cu
, 0); glVertex2i(X
+cw
, Y
+ch
+yofs
);
833 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ch
+yofs
);
839 //if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
846 procedure e_AmbientQuad (x
, y
, w
, h
: Integer; r
, g
, b
, a
: Byte);
848 if e_NoGraphics
then exit
;
849 if (w
< 1) or (h
< 1) then exit
;
850 if (a
<> 255) or ((r
or g
or b
) <> 0) then
853 glDisable(GL_TEXTURE_2D
);
854 glColor4ub(r
, g
, b
, a
);
855 if ((r
or g
or b
) <> 0) then
857 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
861 glVertex2i(x
+w
, y
+h
);
865 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
869 glVertex2i(x
+w
, y
+h
);
877 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
878 Blending
: Boolean; Angle
: Single; RC
: PDFPoint
; Mirror
: TMirrorType
= TMirrorType
.None
);
880 if e_NoGraphics
then Exit
;
882 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
884 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
889 if (AlphaChannel
) or (Alpha
> 0) then
890 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
893 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
896 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
898 if (Angle
<> 0) and (RC
<> nil) then
901 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
902 glRotatef(Angle
, 0, 0, 1);
903 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
906 glEnable(GL_TEXTURE_2D
);
907 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
908 glBegin(GL_QUADS
); //0-1 1-1
910 drawTxQuad(X
, Y
, e_Textures
[id
].tx
.width
, e_Textures
[id
].tx
.height
, e_Textures
[id
].tx
.width
, e_Textures
[id
].tx
.height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
919 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
921 if e_NoGraphics
then Exit
;
922 glDisable(GL_TEXTURE_2D
);
923 glColor3ub(Red
, Green
, Blue
);
926 if (Size
= 2) or (Size
= 4) then
930 glVertex2f(X
+0.3, Y
+1.0);
933 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
936 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
938 // Make lines only top-left/bottom-right and top-right/bottom-left
950 // Pixel-perfect hack
958 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
960 nX1
, nY1
, nX2
, nY2
: Integer;
962 v
: array [0..15] of GLfloat
;
965 if e_NoGraphics
then Exit
;
966 // Only top-left/bottom-right quad
983 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
987 glDisable(GL_TEXTURE_2D
);
988 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
991 nX1
:= X1
; nY1
:= Y1
;
992 nX2
:= X2
; nY2
:= Y1
;
993 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
994 v
[0] := nX1
; v
[1] := nY1
; v
[2] := nX2
; v
[3] := nY2
;
996 nX1
:= X2
; nY1
:= Y1
;
997 nX2
:= X2
; nY2
:= Y2
;
998 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
999 v
[4] := nX1
; v
[5] := nY1
; v
[6] := nX2
; v
[7] := nY2
;
1001 nX1
:= X2
; nY1
:= Y2
;
1002 nX2
:= X1
; nY2
:= Y2
;
1003 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
1004 v
[8] := nX1
; v
[9] := nY1
; v
[10] := nX2
; v
[11] := nY2
;
1006 nX1
:= X1
; nY1
:= Y2
;
1007 nX2
:= X1
; nY2
:= Y1
;
1008 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
1009 v
[12] := nX1
; v
[13] := nY1
; v
[14] := nX2
; v
[15] := nY2
;
1011 glVertexPointer(2, GL_FLOAT
, 0, @v
[0]);
1012 glEnableClientState(GL_VERTEX_ARRAY
);
1013 glDisableClientState(GL_COLOR_ARRAY
);
1014 glDisableClientState(GL_NORMAL_ARRAY
);
1015 glDisableClientState(GL_TEXTURE_COORD_ARRAY
);
1016 glDrawArrays(GL_LINES
, 0, 16);
1019 nX1
:= X1
; nY1
:= Y1
;
1020 nX2
:= X2
; nY2
:= Y1
;
1021 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
1022 glVertex2i(nX1
, nY1
);
1023 glVertex2i(nX2
, nY2
);
1025 nX1
:= X2
; nY1
:= Y1
;
1026 nX2
:= X2
; nY2
:= Y2
;
1027 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
1028 glVertex2i(nX1
, nY1
);
1029 glVertex2i(nX2
, nY2
);
1031 nX1
:= X2
; nY1
:= Y2
;
1032 nX2
:= X1
; nY2
:= Y2
;
1033 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
1034 glVertex2i(nX1
, nY1
);
1035 glVertex2i(nX2
, nY2
);
1037 nX1
:= X1
; nY1
:= Y2
;
1038 nX2
:= X1
; nY2
:= Y1
;
1039 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
1040 glVertex2i(nX1
, nY1
);
1041 glVertex2i(nX2
, nY2
);
1045 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1047 glDisable(GL_BLEND
);
1050 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
1051 Blending
: TBlending
= TBlending
.None
);
1053 if e_NoGraphics
then Exit
;
1054 if (Alpha
> 0) or (Blending
<> TBlending
.None
) then
1057 glDisable(GL_BLEND
);
1059 if Blending
= TBlending
.Blend
then
1060 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
1062 if Blending
= TBlending
.Filter
then
1063 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
1065 if Blending
= TBlending
.Invert
then
1066 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
1069 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1071 glDisable(GL_TEXTURE_2D
);
1072 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
1084 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1086 glDisable(GL_BLEND
);
1090 // ////////////////////////////////////////////////////////////////////////// //
1091 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
1093 if (a
< 0) then a
:= 0;
1094 if (a
> 255) then a
:= 255;
1096 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
1097 glDisable(GL_TEXTURE_2D
);
1098 glColor4ub(0, 0, 0, Byte(255-a
));
1105 //glRect(x, y, x+w, y+h);
1106 glColor4ub(1, 1, 1, 1);
1107 glDisable(GL_BLEND
);
1108 //glBlendEquation(GL_FUNC_ADD);
1111 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
1113 if (w
> 0) and (h
> 0) then e_DarkenQuad(x
, y
, x
+w
, y
+h
, a
);
1117 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
1120 v
: array [0..3] of GLfloat
;
1123 if e_NoGraphics
then Exit
;
1124 // Pixel-perfect lines
1126 e_LineCorrection(X1
, Y1
, X2
, Y2
);
1131 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1133 glDisable(GL_BLEND
);
1135 glDisable(GL_TEXTURE_2D
);
1136 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
1140 v
[0] := X1
; v
[1] := Y1
; v
[2] := X2
; v
[3] := Y2
;
1141 glVertexPointer(2, GL_FLOAT
, 0, @v
[0]);
1142 glEnableClientState(GL_VERTEX_ARRAY
);
1143 glDisableClientState(GL_COLOR_ARRAY
);
1144 glDisableClientState(GL_NORMAL_ARRAY
);
1145 glDisableClientState(GL_TEXTURE_COORD_ARRAY
);
1146 glDrawArrays(GL_LINES
, 0, 4);
1154 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1156 glDisable(GL_BLEND
);
1159 //------------------------------------------------------------------
1160 // Óäàëÿåò òåêñòóðó èç ìàññèâà
1161 //------------------------------------------------------------------
1162 procedure e_DeleteTexture(ID
: DWORD
);
1164 if not e_NoGraphics
then
1165 glDeleteTextures(1, @e_Textures
[ID
].tx
.id
);
1166 e_Textures
[ID
].tx
.id
:= 0;
1167 e_Textures
[ID
].tx
.Width
:= 0;
1168 e_Textures
[ID
].tx
.Height
:= 0;
1171 //------------------------------------------------------------------
1172 // Óäàëÿåò âñå òåêñòóðû
1173 //------------------------------------------------------------------
1174 procedure e_RemoveAllTextures();
1178 if e_Textures
= nil then Exit
;
1180 for i
:= 0 to High(e_Textures
) do
1181 if e_Textures
[i
].tx
.Width
<> 0 then e_DeleteTexture(i
);
1185 //------------------------------------------------------------------
1187 //------------------------------------------------------------------
1188 procedure e_ReleaseEngine();
1190 e_RemoveAllTextures
;
1191 e_RemoveAllTextureFont
;
1194 procedure e_BeginRender();
1196 if e_NoGraphics
then Exit
;
1197 glEnable(GL_ALPHA_TEST
);
1198 glAlphaFunc(GL_GREATER
, 0.0);
1201 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
1203 if e_NoGraphics
then Exit
;
1204 glClearColor(Red
, Green
, Blue
, 0);
1208 procedure e_Clear(); overload
;
1210 if e_NoGraphics
then Exit
;
1211 glClearColor(0, 0, 0, 0);
1212 glClear(GL_COLOR_BUFFER_BIT
);
1215 procedure e_EndRender();
1217 if e_NoGraphics
then Exit
;
1221 function e_GetGamma(win
: PSDL_Window
): Byte;
1223 ramp
: array [0..256*3-1] of Word;
1224 rgb
: array [0..2] of Double;
1233 if e_NoGraphics
then Exit
;
1238 SDL_GetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1247 for j
:= min
to max
- 1 do
1250 B
:= (j
mod 256)/256;
1252 sum
:= sum
+ ln(A
)/ln(B
);
1255 rgb
[i
] := sum
/ count
;
1258 Result
:= 100 - Trunc(((rgb
[0] + rgb
[1] + rgb
[2])/3 - 0.23) * 100/(2.7 - 0.23));
1261 procedure e_SetGamma(win
: PSDL_Window
; Gamma
: Byte);
1263 ramp
: array [0..256*3-1] of Word;
1268 if e_NoGraphics
then Exit
;
1269 g
:= (100 - Gamma
)*(2.7 - 0.23)/100 + 0.23;
1271 for i
:= 0 to 255 do
1273 r
:= Exp(g
* ln(i
/256))*65536;
1274 if r
< 0 then r
:= 0
1275 else if r
> 65535 then r
:= 65535;
1276 ramp
[i
] := trunc(r
);
1277 ramp
[i
+ 256] := trunc(r
);
1278 ramp
[i
+ 512] := trunc(r
);
1281 SDL_SetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1284 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1288 e_WriteLog('Creating CharFont...', TMsgType
.Notify
);
1292 if e_CharFonts
<> nil then
1293 for i
:= 0 to High(e_CharFonts
) do
1294 if not e_CharFonts
[i
].alive
then
1300 if id
= DWORD(-1) then
1302 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1303 id
:= High(e_CharFonts
);
1306 with e_CharFonts
[id
] do
1308 for i
:= 0 to High(Chars
) do
1322 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1324 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1326 TextureID
:= Texture
;
1331 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1335 if e_NoGraphics
then Exit
;
1336 if Text = '' then Exit
;
1337 if e_CharFonts
= nil then Exit
;
1338 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1340 with e_CharFonts
[FontID
] do
1342 for a
:= 1 to Length(Text) do
1343 with Chars
[Ord(Text[a
])] do
1344 if TextureID
<> -1 then
1346 e_Draw(TextureID
, X
, Y
, 0, True, False);
1347 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1352 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1353 Color
: TRGB
; Scale
: Single = 1.0);
1358 if e_NoGraphics
then Exit
;
1359 if Text = '' then Exit
;
1360 if e_CharFonts
= nil then Exit
;
1361 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1363 with e_CharFonts
[FontID
] do
1365 for a
:= 1 to Length(Text) do
1366 with Chars
[Ord(Text[a
])] do
1367 if TextureID
<> -1 then
1369 if Scale
<> 1.0 then
1372 glScalef(Scale
, Scale
, 0);
1377 e_Draw(TextureID
, X
, Y
, 0, True, False);
1380 if Scale
<> 1.0 then glPopMatrix
;
1382 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1387 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1389 a
, TX
, TY
, len
: Integer;
1393 if e_NoGraphics
then Exit
;
1394 if Text = '' then Exit
;
1395 if e_CharFonts
= nil then Exit
;
1396 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1404 len
:= Length(Text);
1406 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1408 with e_CharFonts
[FontID
] do
1410 for a
:= 1 to len
do
1421 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1426 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1431 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1436 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1441 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1446 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1451 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1456 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1461 with Chars
[Ord(Text[a
])] do
1462 if TextureID
<> -1 then
1466 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1469 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1475 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1483 if Text = '' then Exit
;
1484 if e_CharFonts
= nil then Exit
;
1485 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1487 with e_CharFonts
[FontID
] do
1489 for a
:= 1 to Length(Text) do
1490 with Chars
[Ord(Text[a
])] do
1491 if TextureID
<> -1 then
1493 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1494 e_GetTextureSize(TextureID
, nil, @h2
);
1495 if h2
> h
then h
:= h2
;
1500 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1502 a
, lines
, len
: Integer;
1503 h2
, w2
, tw
, th
: Word;
1510 if Text = '' then Exit
;
1511 if e_CharFonts
= nil then Exit
;
1512 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1515 len
:= Length(Text);
1517 with e_CharFonts
[FontID
] do
1519 for a
:= 1 to len
do
1521 if Text[a
] = #10 then
1524 if w2
> tw
then tw
:= w2
;
1529 with Chars
[Ord(Text[a
])] do
1530 if TextureID
<> -1 then
1532 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1533 e_GetTextureSize(TextureID
, nil, @h2
);
1534 if h2
> th
then th
:= h2
;
1546 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1552 if e_CharFonts
= nil then Exit
;
1553 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1555 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1556 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1559 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1566 if e_CharFonts
= nil then Exit
;
1567 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1569 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1571 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1572 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1574 if h2
> Result
then Result
:= h2
;
1578 procedure e_CharFont_Remove(FontID
: DWORD
);
1582 with e_CharFonts
[FontID
] do
1583 for a
:= 0 to High(Chars
) do
1584 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1586 e_CharFonts
[FontID
].alive
:= False;
1589 procedure e_CharFont_RemoveAll();
1593 if e_CharFonts
= nil then Exit
;
1595 for a
:= 0 to High(e_CharFonts
) do
1596 e_CharFont_Remove(a
);
1601 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1608 if e_NoGraphics
then Exit
;
1609 e_WriteLog('Creating texture font...', TMsgType
.Notify
);
1613 if e_TextureFonts
<> nil then
1614 for i
:= 0 to High(e_TextureFonts
) do
1615 if e_TextureFonts
[i
].Base
= 0 then
1621 if id
= DWORD(-1) then
1623 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1624 id
:= High(e_TextureFonts
);
1627 with e_TextureFonts
[id
] do
1629 {$IF not DEFINED(USE_NANOGL)}
1630 Base
:= glGenLists(XCount
*YCount
);
1632 TextureID
:= e_Textures
[Tex
].tx
.id
;
1633 CharWidth
:= (e_Textures
[Tex
].tx
.Width
div XCount
)+Space
;
1634 CharHeight
:= e_Textures
[Tex
].tx
.Height
div YCount
;
1641 {$IF not DEFINED(USE_NANOGL)}
1642 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1643 for loop1
:= 0 to XCount
*YCount
-1 do
1645 cx
:= (loop1
mod XCount
)/XCount
;
1646 cy
:= (loop1
div YCount
)/YCount
;
1648 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1650 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1651 glVertex2i(0, e_Textures
[Tex
].tx
.Height
div YCount
);
1653 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1654 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, e_Textures
[Tex
].tx
.Height
div YCount
);
1656 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1657 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, 0);
1659 glTexCoord2f(cx
, 1.0-cy
);
1662 glTranslated((e_Textures
[Tex
].tx
.Width
div XCount
)+Space
, 0, 0);
1670 procedure e_TextureFontKill(FontID
: DWORD
);
1672 if e_NoGraphics
then Exit
;
1673 {$IF not DEFINED(USE_NANOGL)}
1674 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1676 e_TextureFonts
[FontID
].Base
:= 0;
1680 procedure e_TextureFontDrawChar(ch
: Char; FontID
: DWORD
);
1685 Width
, Height
: Integer;
1686 XCount
, YCount
: Integer;
1688 index
:= Ord(ch
) - 32;
1689 Tex
:= e_TextureFonts
[FontID
].Texture
;
1690 Width
:= e_Textures
[Tex
].tx
.Width
;
1691 Height
:= e_Textures
[Tex
].tx
.Height
;
1692 XCount
:= e_TextureFonts
[FontID
].XC
;
1693 YCount
:= e_TextureFonts
[FontID
].YC
;
1694 cx
:= (index
mod XCount
)/XCount
;
1695 cy
:= (index
div YCount
)/YCount
;
1697 glTexCoord2f(cx
, 1 - cy
- 1/YCount
);
1698 glVertex2i(0, Height
div YCount
);
1699 glTexCoord2f(cx
+ 1/XCount
, 1 - cy
- 1/YCount
);
1700 glVertex2i(Width
div XCount
, Height
div YCount
);
1701 glTexCoord2f(cx
+ 1/XCount
, 1 - cy
);
1702 glVertex2i(Width
div XCount
, 0);
1703 glTexCoord2f(cx
, 1 - cy
);
1706 glTranslatef((e_Textures
[Tex
].tx
.Width
div XCount
) + e_TextureFonts
[FontID
].SPC
, 0, 0);
1709 procedure e_TextureFontDrawString(Text: String; FontID
: DWORD
);
1713 for i
:= 1 to High(Text) do
1714 e_TextureFontDrawChar(Text[i
], FontID
);
1718 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1720 if e_NoGraphics
then Exit
;
1721 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1722 if Text = '' then Exit
;
1724 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1727 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1730 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1731 glEnable(GL_TEXTURE_2D
);
1732 glTranslatef(x
, y
, 0);
1734 e_TextureFontDrawString(Text, FontID
);
1736 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1737 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1739 glDisable(GL_TEXTURE_2D
);
1742 glDisable(GL_BLEND
);
1745 // god forgive me for this, but i cannot figure out how to do it without lists
1746 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1748 if e_NoGraphics
then Exit
;
1753 glColor4ub(0, 0, 0, 128);
1754 glTranslatef(X
+1, Y
+1, 0);
1756 e_TextureFontDrawChar(Ch
, FontID
);
1758 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1764 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1765 glTranslatef(X
, Y
, 0);
1767 e_TextureFontDrawChar(Ch
, FontID
);
1769 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1775 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1777 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1778 glEnable(GL_TEXTURE_2D
);
1779 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1781 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1783 e_TextureFontPrintChar(X
, Y
, Ch
, FontID
, Shadow
);
1784 glDisable(GL_TEXTURE_2D
);
1785 glDisable(GL_BLEND
);
1788 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
1790 result
:= e_TextureFonts
[FontID
].CharWidth
;
1793 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
1795 a
, TX
, TY
, len
: Integer;
1799 if e_NoGraphics
then Exit
;
1800 if Text = '' then Exit
;
1801 if e_TextureFonts
= nil then Exit
;
1802 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1810 len
:= Length(Text);
1812 w
:= e_TextureFonts
[FontID
].CharWidth
;
1814 with e_TextureFonts
[FontID
] do
1816 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1817 glEnable(GL_TEXTURE_2D
);
1819 {$IF not DEFINED(USE_NANOGL)}
1820 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1823 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1826 for a
:= 1 to len
do
1837 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1842 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1847 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1852 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1857 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1862 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1867 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1872 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1879 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1884 glDisable(GL_TEXTURE_2D
);
1885 glDisable(GL_BLEND
);
1889 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1890 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1892 if e_NoGraphics
then Exit
;
1893 if Text = '' then Exit
;
1896 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1897 glEnable(GL_TEXTURE_2D
);
1899 {$IF not DEFINED(USE_NANOGL)}
1900 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1903 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1908 glColor4ub(0, 0, 0, 128);
1909 glTranslatef(x
+1, y
+1, 0);
1910 glScalef(Scale
, Scale
, 0);
1912 e_TextureFontDrawString(Text, FontID
);
1914 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1920 glColor4ub(Red
, Green
, Blue
, 255);
1921 glTranslatef(x
, y
, 0);
1922 glScalef(Scale
, Scale
, 0);
1924 e_TextureFontDrawString(Text, FontID
);
1926 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1929 glDisable(GL_TEXTURE_2D
);
1931 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1932 glDisable(GL_BLEND
);
1935 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
1939 if e_NoGraphics
then Exit
;
1940 if Integer(ID
) > High(e_TextureFonts
) then
1942 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1943 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1946 procedure e_RemoveAllTextureFont();
1950 if e_NoGraphics
then Exit
;
1951 if e_TextureFonts
= nil then Exit
;
1953 for i
:= 0 to High(e_TextureFonts
) do
1954 if e_TextureFonts
[i
].Base
<> 0 then
1956 {$IFNDEF USE_NANOGL}
1957 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1959 e_TextureFonts
[i
].Base
:= 0;
1962 e_TextureFonts
:= nil;
1965 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1972 function _Point(X
, Y
: Integer): TPoint2i
;
1978 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1982 Result
.Width
:= Width
;
1983 Result
.Height
:= Height
;
1986 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
1995 procedure e_MakeScreenshot (st
: TStream
; Width
, Height
: Word);
1997 pixels
, obuf
, scln
, ps
, pd
: PByte;
2000 i
, x
, y
, res
: Integer;
2001 sign
: array [0..7] of Byte;
2002 hbuf
: array [0..12] of Byte;
2007 if e_NoGraphics
then Exit
;
2010 // first, extract and pack graphics data
2011 if (Width
mod 4) > 0 then Width
:= Width
+4-(Width
mod 4);
2013 GetMem(pixels
, Width
*Height
*3);
2015 FillChar(pixels
^, Width
*Height
*3, 0);
2016 glReadPixels(0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pixels
);
2017 //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
2019 if e_FastScreenshots
then
2022 GetMem(scln
, (Width
*3+1)*Height
);
2026 Inc(ps
, (Width
*3)*(Height
-1));
2027 for i
:= 0 to Height
-1 do
2031 Move(ps
^, pd
^, Width
*3);
2043 obufsize
:= (Width
*3+1)*Height
*2;
2044 GetMem(obuf
, obufsize
);
2049 res
:= compress2(Pointer(obuf
), dlen
, Pointer(pixels
), (Width
*3+1)*Height
, 9);
2050 if res
= Z_OK
then break
;
2051 if res
<> Z_BUF_ERROR
then raise Exception
.Create('can''t pack data for PNG');
2052 obufsize
:= obufsize
*2;
2055 GetMem(obuf
, obufsize
);
2057 //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
2070 st
.writeBuffer(sign
, 8);
2071 //e_WriteLog('PNG: signature written', MSG_NOTIFY);
2074 writeIntBE(st
, LongWord(13));
2079 st
.writeBuffer(sign
, 4);
2080 crc
:= crc32(0, @sign
[0], 4);
2083 hbuf
[2] := (Width
shr 8) and $ff;
2084 hbuf
[3] := Width
and $ff;
2087 hbuf
[6] := (Height
shr 8) and $ff;
2088 hbuf
[7] := Height
and $ff;
2089 hbuf
[8] := 8; // bit depth
2090 hbuf
[9] := 2; // RGB
2091 hbuf
[10] := 0; // compression method
2092 hbuf
[11] := 0; // filter method
2093 hbuf
[12] := 0; // no interlace
2094 crc
:= crc32(crc
, @hbuf
[0], 13);
2095 st
.writeBuffer(hbuf
, 13);
2096 writeIntBE(st
, crc
);
2097 //e_WriteLog('PNG: header written', MSG_NOTIFY);
2100 writeIntBE(st
, LongWord(dlen
));
2105 st
.writeBuffer(sign
, 4);
2106 crc
:= crc32(0, @sign
[0], 4);
2107 crc
:= crc32(crc
, obuf
, dlen
);
2108 st
.writeBuffer(obuf
^, dlen
);
2109 writeIntBE(st
, crc
);
2110 //e_WriteLog('PNG: image data written', MSG_NOTIFY);
2113 writeIntBE(st
, LongWord(0));
2118 st
.writeBuffer(sign
, 4);
2119 crc
:= crc32(0, @sign
[0], 4);
2120 writeIntBE(st
, crc
);
2121 //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
2123 if obuf
<> nil then FreeMem(obuf
);
2128 Imaging
.SetOption(ImagingPNGCompressLevel
, 9);
2129 Imaging
.SetOption(ImagingPNGPreFilter
, 6);
2132 NewImage(Width
, Height
, TImageFormat
.ifR8G8B8
, img
);
2134 //writeln(stderr, 'moving pixels...');
2135 for y
:= Height
-1 downto 0 do
2137 for x
:= 0 to Width
-1 do
2139 clr
.r
:= ps
^; Inc(ps
);
2140 clr
.g
:= ps
^; Inc(ps
);
2141 clr
.b
:= ps
^; Inc(ps
);
2143 SetPixel32(img
, x
, y
, clr
);
2146 GlobalMetadata
.ClearMetaItems();
2147 GlobalMetadata
.ClearMetaItemsForSaving();
2148 //writeln(stderr, 'compressing image...');
2149 if not SaveImageToStream('png', st
, img
) then raise Exception
.Create('screenshot writing error');
2150 //writeln(stderr, 'done!');