ded85939193aaba22a8f569de903b4ed3dd94504
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; ambientBlendMode
: Boolean=false);
74 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; alphachannel
: Boolean;
75 blending
: Boolean; scale
: Single; ambientBlendMode
: Boolean=false);
77 procedure e_AmbientQuad (x
, y
, w
, h
: Integer; r
, g
, b
, a
: Byte);
79 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
80 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
81 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
82 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
83 Blending
: TBlending
= B_NONE
);
84 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
85 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
87 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
88 function e_CreateTexture(FileName
: string; var ID
: DWORD
): Boolean;
89 function e_CreateTextureEx(FileName
: string; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
90 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
91 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
92 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
93 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
94 procedure e_DeleteTexture(ID
: DWORD
);
95 procedure e_RemoveAllTextures();
98 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
99 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
100 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
101 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
102 Color
: TRGB
; Scale
: Single = 1.0);
103 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
104 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
105 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
106 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
107 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
108 procedure e_CharFont_Remove(FontID
: DWORD
);
109 procedure e_CharFont_RemoveAll();
112 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
114 procedure e_TextureFontKill(FontID
: DWORD
);
115 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
116 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
117 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
118 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
119 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
120 procedure e_RemoveAllTextureFont();
122 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
123 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
125 procedure e_ReleaseEngine();
126 procedure e_BeginRender();
127 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
128 procedure e_Clear(); overload
;
129 procedure e_EndRender();
131 function e_GetGamma(win
: PSDL_Window
): Byte;
132 procedure e_SetGamma(win
: PSDL_Window
;Gamma
: Byte);
134 procedure e_MakeScreenshot(st
: TStream
; Width
, Height
: Word);
136 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
137 function _Point(X
, Y
: Integer): TPoint2i
;
138 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
139 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
141 //function e_getTextGLId (ID: DWORD): GLuint;
145 e_NoGraphics
: Boolean = False;
146 e_FastScreenshots
: Boolean = true; // it's REALLY SLOW with `false`
160 TTextureFont
= record
170 Chars
: array[0..255] of
180 TSavedTexture
= record
187 e_Textures
: array of TTexture
= nil;
188 e_TextureFonts
: array of TTextureFont
= nil;
189 e_CharFonts
: array of TCharFont
;
190 //e_SavedTextures: array of TSavedTexture;
192 //function e_getTextGLId (ID: DWORD): GLuint; begin result := e_Textures[ID].tx.id; end;
194 //------------------------------------------------------------------
195 // Èíèöèàëèçèðóåò OpenGL
196 //------------------------------------------------------------------
197 procedure e_InitGL();
201 e_DummyTextures
:= True;
207 glDisable(GL_DEPTH_TEST
);
208 glEnable(GL_SCISSOR_TEST
);
209 glClearColor(0, 0, 0, 0);
212 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
214 mat
: Array [0..15] of GLDouble
;
217 if e_NoGraphics
then Exit
;
219 glScissor(X
, Y
, Width
, Height
);
220 glViewport(X
, Y
, Width
, Height
);
221 //gluOrtho2D(0, Width, Height, 0);
223 glMatrixMode(GL_PROJECTION
);
225 mat
[ 0] := 2.0 / Width
;
231 mat
[ 5] := -2.0 / Height
;
245 glLoadMatrixd(@mat
[0]);
247 glMatrixMode(GL_MODELVIEW
);
251 //------------------------------------------------------------------
252 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
253 //------------------------------------------------------------------
254 function FindTexture(): DWORD
;
258 if e_Textures
<> nil then
259 for i
:= 0 to High(e_Textures
) do
260 if e_Textures
[i
].tx
.Width
= 0 then
266 if e_Textures
= nil then
268 SetLength(e_Textures
, 32);
273 Result
:= High(e_Textures
) + 1;
274 SetLength(e_Textures
, Length(e_Textures
) + 32);
278 //------------------------------------------------------------------
280 //------------------------------------------------------------------
281 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
288 e_WriteLog('Loading texture from '+FileName
, MSG_NOTIFY
);
290 find_id
:= FindTexture();
292 if not LoadTexture(FileName
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].tx
.Width
,
293 e_Textures
[find_id
].tx
.Height
, @fmt
) then Exit
;
300 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
307 find_id
:= FindTexture();
309 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
316 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
323 find_id
:= FindTexture
;
325 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
;
332 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
339 find_id
:= FindTexture();
341 if not LoadTextureMemEx(pData
, dataSize
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
348 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
354 find_id
:= FindTexture();
355 if not LoadTextureImg(img
, e_Textures
[find_id
].tx
, tw
, th
, @fmt
) then exit
;
360 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
362 if Width
<> nil then Width
^ := e_Textures
[ID
].tx
.Width
;
363 if Height
<> nil then Height
^ := e_Textures
[ID
].tx
.Height
;
366 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
374 w
:= e_Textures
[ID
].tx
.Width
;
375 h
:= e_Textures
[ID
].tx
.Height
;
382 if e_NoGraphics
then Exit
;
384 data
:= GetMemory(w
*h
*4);
385 glEnable(GL_TEXTURE_2D
);
386 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
387 glGetTexImage(GL_TEXTURE_2D
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, data
);
389 for y
:= h
-1 downto 0 do
396 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
402 Result
.Y
:= h
-lastline
;
414 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
420 Result
.Height
:= h
-lastline
-Result
.Y
;
432 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
438 Result
.X
:= lastline
+1;
443 for x
:= w
-1 downto 0 do
450 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
456 Result
.Width
:= lastline
-Result
.X
+1;
464 procedure e_ResizeWindow(Width
, Height
: Integer);
468 e_SetViewPort(0, 0, Width
, Height
);
471 procedure drawTxQuad (x0
, y0
, w
, h
: Integer; u
, v
: single; Mirror
: TMirrorType
);
473 x1
, y1
, tmp
: Integer;
475 if (w
< 1) or (h
< 1) then exit
;
478 if Mirror
= M_HORIZONTAL
then begin tmp
:= x1
; x1
:= x0
; x0
:= tmp
; end
479 else if Mirror
= M_VERTICAL
then begin tmp
:= y1
; y1
:= y0
; y0
:= tmp
; end;
480 glTexCoord2f(0, v
); glVertex2i(x0
, y0
);
481 glTexCoord2f(0, 0); glVertex2i(x0
, y1
);
482 glTexCoord2f(u
, 0); glVertex2i(x1
, y1
);
483 glTexCoord2f(u
, v
); glVertex2i(x1
, y0
);
486 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
487 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
489 if e_NoGraphics
then Exit
;
490 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
492 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
497 if (AlphaChannel
) or (Alpha
> 0) then
498 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
501 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
504 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
506 glEnable(GL_TEXTURE_2D
);
507 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
510 drawTxQuad(X
, Y
, e_Textures
[id
].tx
.width
, e_Textures
[id
].tx
.height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
512 //u := e_Textures[ID].tx.u;
513 //v := e_Textures[ID].tx.v;
516 if Mirror = M_NONE then
518 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
519 glTexCoord2f(0, 0); glVertex2i(X, Y);
520 glTexCoord2f(0, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
521 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
524 if Mirror = M_HORIZONTAL then
526 glTexCoord2f(u, 0); glVertex2i(X, Y);
527 glTexCoord2f(0, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
528 glTexCoord2f(0, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
529 glTexCoord2f(u, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
532 if Mirror = M_VERTICAL then
534 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y);
535 glTexCoord2f(0, -v); glVertex2i(X, Y);
536 glTexCoord2f(0, 0); glVertex2i(X, Y + e_Textures[id].tx.Height);
537 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
546 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
547 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
551 if e_NoGraphics
then Exit
;
552 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
554 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
559 if (AlphaChannel
) or (Alpha
> 0) then
560 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
563 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
566 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
568 glEnable(GL_TEXTURE_2D
);
569 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
571 u
:= e_Textures
[ID
].tx
.u
;
572 v
:= e_Textures
[ID
].tx
.v
;
575 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
576 glTexCoord2f(u
, v
); glVertex2i(X
+ Width
, Y
);
577 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
578 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
584 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
585 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
587 if e_NoGraphics
then Exit
;
588 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
590 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
595 if (AlphaChannel
) or (Alpha
> 0) then
596 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
599 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
602 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
604 glEnable(GL_TEXTURE_2D
);
605 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
607 drawTxQuad(X
, Y
, Width
, Height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
613 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
614 AlphaChannel
: Boolean; Blending
: Boolean; ambientBlendMode
: Boolean=false);
616 X2
, Y2
, dx
, w
, h
: Integer;
619 if e_NoGraphics
then Exit
;
620 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
621 ambientBlendMode
:= false;
623 if (Alpha
> 0) or AlphaChannel
or Blending
then
629 if not ambientBlendMode
then glDisable(GL_BLEND
);
631 if AlphaChannel
or (Alpha
> 0) then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
632 if (Alpha
> 0) then glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
633 if Blending
then glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
635 if (XCount
= 0) then XCount
:= 1;
636 if (YCount
= 0) then YCount
:= 1;
638 glEnable(GL_TEXTURE_2D
);
639 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
641 X2
:= X
+e_Textures
[ID
].tx
.width
*XCount
;
642 Y2
:= Y
+e_Textures
[ID
].tx
.height
*YCount
;
644 //k8: this SHOULD work... i hope
645 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
648 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
649 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
650 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
651 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
658 u
:= e_Textures
[ID
].tx
.u
;
659 v
:= e_Textures
[ID
].tx
.v
;
660 w
:= e_Textures
[ID
].tx
.width
;
661 h
:= e_Textures
[ID
].tx
.height
;
668 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
669 glTexCoord2f(u
, v
); glVertex2i(X
+w
, Y
);
670 glTexCoord2f(u
, 0); glVertex2i(X
+w
, Y
+h
);
671 glTexCoord2f(0, 0); glVertex2i(X
, Y
+h
);
686 //TODO: overflow checks
687 function intersectRect (var x0
, y0
, w0
, h0
: Integer; const x1
, y1
, w1
, h1
: Integer): Boolean;
692 if (w0
< 1) or (h0
< 1) or (w1
< 1) or (h1
< 1) then exit
;
693 // check for intersection
694 if (x0
+w0
<= x1
) or (y0
+h0
<= y1
) or (x1
+w1
<= x0
) or (y1
+h1
<= y0
) then exit
;
695 if (x0
>= x1
+w1
) or (y0
>= y1
+h1
) or (x1
>= x0
+h0
) or (y1
>= y0
+h0
) then exit
;
699 if (x0
< x1
) then x0
:= x1
;
700 if (y0
< y1
) then y0
:= y1
;
701 if (ex0
> x1
+w1
) then ex0
:= x1
+w1
;
702 if (ey0
> y1
+h1
) then ey0
:= y1
+h1
;
705 result
:= (w0
> 0) and (h0
> 0);
709 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; alphachannel
: Boolean;
710 blending
: Boolean; scale
: Single; ambientBlendMode
: Boolean=false);
715 scxywh: array[0..3] of GLint;
716 vpxywh: array[0..3] of GLint;
718 w
, h
, dw
, cw
, ch
, yofs
: Integer;
719 u
, v
, cu
, cv
: Single;
723 procedure setScissorGLInternal (x, y, w, h: Integer);
725 //if not scallowed then exit;
730 y := vpxywh[3]-(y+h);
731 if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then
733 glScissor(0, 0, 0, 0);
737 //writeln(' (', x, ',', y, ')-(', w, ',', h, ')');
738 glScissor(x, y, w, h);
744 if e_NoGraphics
then exit
;
745 ambientBlendMode
:= false;
747 if (wdt
< 1) or (hgt
< 1) then exit
;
749 if (wdt
mod e_Textures
[ID
].tx
.width
= 0) and (hgt
mod e_Textures
[ID
].tx
.height
= 0) then
751 e_DrawFill(id
, x
, y
, wdt
div e_Textures
[ID
].tx
.width
, hgt
div e_Textures
[ID
].tx
.height
, alpha
, alphachannel
, blending
, ambientBlendMode
);
755 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
757 if (Alpha
> 0) or AlphaChannel
or Blending
then
763 if not ambientBlendMode
then glDisable(GL_BLEND
);
765 if AlphaChannel
or (Alpha
> 0) then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
766 if (Alpha
> 0) then glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
767 if Blending
then glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
769 glEnable(GL_TEXTURE_2D
);
770 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
775 //k8: this SHOULD work... i hope
776 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
779 glTexCoord2f(0, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x
, y
);
780 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x2
, y
);
781 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, 0); glVertex2i(x2
, y2
);
782 glTexCoord2f(0, 0); glVertex2i(x
, y2
);
787 // hard day's night; setup scissor
789 glGetIntegerv(GL_VIEWPORT, @vpxywh[0]);
790 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
791 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
792 //writeln('(', scxywh[0], ',', scxywh[1], ')-(', scxywh[2], ',', scxywh[3], ')');
793 //glEnable(GL_SCISSOR_TEST);
794 setScissorGLInternal(x, y, wdt, hgt);
797 u
:= e_Textures
[ID
].tx
.u
;
798 v
:= e_Textures
[ID
].tx
.v
;
799 w
:= e_Textures
[ID
].tx
.width
;
800 h
:= e_Textures
[ID
].tx
.height
;
802 if (hgt
> h
) then begin y
+= hgt
-h
; onlyOneY
:= false; end else onlyOneY
:= true;
806 if (hgt
>= h
) then begin ch
:= h
; cv
:= v
; yofs
:= 0; end else begin ch
:= hgt
; cv
:= v
/(h
/hgt
); yofs
:= h
-hgt
; end;
807 if onlyOneY
then yofs
:= 0;
813 if (dw
>= w
) then begin cw
:= w
; cu
:= u
; end else begin cw
:= dw
; cu
:= u
/(w
/dw
); end;
815 glTexCoord2f(0, cv
); glVertex2i(X
, Y
+yofs
);
816 glTexCoord2f(cu
, cv
); glVertex2i(X
+cw
, Y
+yofs
);
817 glTexCoord2f(cu
, 0); glVertex2i(X
+cw
, Y
+ch
+yofs
);
818 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ch
+yofs
);
824 //if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
831 procedure e_AmbientQuad (x
, y
, w
, h
: Integer; r
, g
, b
, a
: Byte);
833 if e_NoGraphics
then exit
;
834 if (w
< 1) or (h
< 1) then exit
;
835 if (a
<> 255) or ((r
or g
or b
) <> 0) then
838 glDisable(GL_TEXTURE_2D
);
839 glColor4ub(r
, g
, b
, a
);
840 if ((r
or g
or b
) <> 0) then
842 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
846 glVertex2i(x
+w
, y
+h
);
850 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
854 glVertex2i(x
+w
, y
+h
);
862 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
863 Blending
: Boolean; Angle
: Single; RC
: PDFPoint
; Mirror
: TMirrorType
= M_NONE
);
865 if e_NoGraphics
then Exit
;
867 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
869 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
874 if (AlphaChannel
) or (Alpha
> 0) then
875 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
878 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
881 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
883 if (Angle
<> 0) and (RC
<> nil) then
886 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
887 glRotatef(Angle
, 0, 0, 1);
888 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
891 glEnable(GL_TEXTURE_2D
);
892 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
893 glBegin(GL_QUADS
); //0-1 1-1
895 drawTxQuad(X
, Y
, e_Textures
[id
].tx
.width
, e_Textures
[id
].tx
.height
, e_Textures
[ID
].tx
.u
, e_Textures
[ID
].tx
.v
, Mirror
);
904 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
906 if e_NoGraphics
then Exit
;
907 glDisable(GL_TEXTURE_2D
);
908 glColor3ub(Red
, Green
, Blue
);
911 if (Size
= 2) or (Size
= 4) then
915 glVertex2f(X
+0.3, Y
+1.0);
918 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
921 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
923 // Make lines only top-left/bottom-right and top-right/bottom-left
935 // Pixel-perfect hack
943 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
945 nX1
, nY1
, nX2
, nY2
: Integer;
947 if e_NoGraphics
then Exit
;
948 // Only top-left/bottom-right quad
965 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
969 glDisable(GL_TEXTURE_2D
);
970 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
974 nX1
:= X1
; nY1
:= Y1
;
975 nX2
:= X2
; nY2
:= Y1
;
976 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
977 glVertex2i(nX1
, nY1
);
978 glVertex2i(nX2
, nY2
);
980 nX1
:= X2
; nY1
:= Y1
;
981 nX2
:= X2
; nY2
:= Y2
;
982 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
983 glVertex2i(nX1
, nY1
);
984 glVertex2i(nX2
, nY2
);
986 nX1
:= X2
; nY1
:= Y2
;
987 nX2
:= X1
; nY2
:= Y2
;
988 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
989 glVertex2i(nX1
, nY1
);
990 glVertex2i(nX2
, nY2
);
992 nX1
:= X1
; nY1
:= Y2
;
993 nX2
:= X1
; nY2
:= Y1
;
994 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
995 glVertex2i(nX1
, nY1
);
996 glVertex2i(nX2
, nY2
);
999 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1001 glDisable(GL_BLEND
);
1004 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
1005 Blending
: TBlending
= B_NONE
);
1007 if e_NoGraphics
then Exit
;
1008 if (Alpha
> 0) or (Blending
<> B_NONE
) then
1011 glDisable(GL_BLEND
);
1013 if Blending
= B_BLEND
then
1014 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
1016 if Blending
= B_FILTER
then
1017 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
1019 if Blending
= B_INVERT
then
1020 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
1023 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1025 glDisable(GL_TEXTURE_2D
);
1026 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
1038 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1040 glDisable(GL_BLEND
);
1044 // ////////////////////////////////////////////////////////////////////////// //
1045 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
1047 if (a
< 0) then a
:= 0;
1048 if (a
> 255) then a
:= 255;
1050 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
1051 glDisable(GL_TEXTURE_2D
);
1052 glColor4ub(0, 0, 0, Byte(255-a
));
1059 //glRect(x, y, x+w, y+h);
1060 glColor4ub(1, 1, 1, 1);
1061 glDisable(GL_BLEND
);
1062 //glBlendEquation(GL_FUNC_ADD);
1065 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
1067 if (w
> 0) and (h
> 0) then e_DarkenQuad(x
, y
, x
+w
, y
+h
, a
);
1071 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
1073 if e_NoGraphics
then Exit
;
1074 // Pixel-perfect lines
1076 e_LineCorrection(X1
, Y1
, X2
, Y2
);
1081 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1083 glDisable(GL_BLEND
);
1085 glDisable(GL_TEXTURE_2D
);
1086 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
1094 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1096 glDisable(GL_BLEND
);
1099 //------------------------------------------------------------------
1100 // Óäàëÿåò òåêñòóðó èç ìàññèâà
1101 //------------------------------------------------------------------
1102 procedure e_DeleteTexture(ID
: DWORD
);
1104 if not e_NoGraphics
then
1105 glDeleteTextures(1, @e_Textures
[ID
].tx
.id
);
1106 e_Textures
[ID
].tx
.id
:= 0;
1107 e_Textures
[ID
].tx
.Width
:= 0;
1108 e_Textures
[ID
].tx
.Height
:= 0;
1111 //------------------------------------------------------------------
1112 // Óäàëÿåò âñå òåêñòóðû
1113 //------------------------------------------------------------------
1114 procedure e_RemoveAllTextures();
1118 if e_Textures
= nil then Exit
;
1120 for i
:= 0 to High(e_Textures
) do
1121 if e_Textures
[i
].tx
.Width
<> 0 then e_DeleteTexture(i
);
1125 //------------------------------------------------------------------
1127 //------------------------------------------------------------------
1128 procedure e_ReleaseEngine();
1130 e_RemoveAllTextures
;
1131 e_RemoveAllTextureFont
;
1134 procedure e_BeginRender();
1136 if e_NoGraphics
then Exit
;
1137 glEnable(GL_ALPHA_TEST
);
1138 glAlphaFunc(GL_GREATER
, 0.0);
1141 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
1143 if e_NoGraphics
then Exit
;
1144 glClearColor(Red
, Green
, Blue
, 0);
1148 procedure e_Clear(); overload
;
1150 if e_NoGraphics
then Exit
;
1151 glClearColor(0, 0, 0, 0);
1152 glClear(GL_COLOR_BUFFER_BIT
);
1155 procedure e_EndRender();
1157 if e_NoGraphics
then Exit
;
1161 function e_GetGamma(win
: PSDL_Window
): Byte;
1163 ramp
: array [0..256*3-1] of Word;
1164 rgb
: array [0..2] of Double;
1173 if e_NoGraphics
then Exit
;
1178 SDL_GetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1187 for j
:= min
to max
- 1 do
1190 B
:= (j
mod 256)/256;
1192 sum
:= sum
+ ln(A
)/ln(B
);
1195 rgb
[i
] := sum
/ count
;
1198 Result
:= 100 - Trunc(((rgb
[0] + rgb
[1] + rgb
[2])/3 - 0.23) * 100/(2.7 - 0.23));
1201 procedure e_SetGamma(win
: PSDL_Window
; Gamma
: Byte);
1203 ramp
: array [0..256*3-1] of Word;
1208 if e_NoGraphics
then Exit
;
1209 g
:= (100 - Gamma
)*(2.7 - 0.23)/100 + 0.23;
1211 for i
:= 0 to 255 do
1213 r
:= Exp(g
* ln(i
/256))*65536;
1214 if r
< 0 then r
:= 0
1215 else if r
> 65535 then r
:= 65535;
1216 ramp
[i
] := trunc(r
);
1217 ramp
[i
+ 256] := trunc(r
);
1218 ramp
[i
+ 512] := trunc(r
);
1221 SDL_SetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1224 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1228 e_WriteLog('Creating CharFont...', MSG_NOTIFY
);
1232 if e_CharFonts
<> nil then
1233 for i
:= 0 to High(e_CharFonts
) do
1234 if not e_CharFonts
[i
].alive
then
1240 if id
= DWORD(-1) then
1242 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1243 id
:= High(e_CharFonts
);
1246 with e_CharFonts
[id
] do
1248 for i
:= 0 to High(Chars
) do
1262 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1264 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1266 TextureID
:= Texture
;
1271 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1275 if e_NoGraphics
then Exit
;
1276 if Text = '' then Exit
;
1277 if e_CharFonts
= nil then Exit
;
1278 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1280 with e_CharFonts
[FontID
] do
1282 for a
:= 1 to Length(Text) do
1283 with Chars
[Ord(Text[a
])] do
1284 if TextureID
<> -1 then
1286 e_Draw(TextureID
, X
, Y
, 0, True, False);
1287 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1292 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1293 Color
: TRGB
; Scale
: Single = 1.0);
1298 if e_NoGraphics
then Exit
;
1299 if Text = '' then Exit
;
1300 if e_CharFonts
= nil then Exit
;
1301 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1303 with e_CharFonts
[FontID
] do
1305 for a
:= 1 to Length(Text) do
1306 with Chars
[Ord(Text[a
])] do
1307 if TextureID
<> -1 then
1309 if Scale
<> 1.0 then
1312 glScalef(Scale
, Scale
, 0);
1317 e_Draw(TextureID
, X
, Y
, 0, True, False);
1320 if Scale
<> 1.0 then glPopMatrix
;
1322 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1327 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1329 a
, TX
, TY
, len
: Integer;
1333 if e_NoGraphics
then Exit
;
1334 if Text = '' then Exit
;
1335 if e_CharFonts
= nil then Exit
;
1336 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1344 len
:= Length(Text);
1346 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1348 with e_CharFonts
[FontID
] do
1350 for a
:= 1 to len
do
1361 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1366 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1371 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1376 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1381 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1386 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1391 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1396 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1401 with Chars
[Ord(Text[a
])] do
1402 if TextureID
<> -1 then
1406 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1409 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1415 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1423 if Text = '' then Exit
;
1424 if e_CharFonts
= nil then Exit
;
1425 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1427 with e_CharFonts
[FontID
] do
1429 for a
:= 1 to Length(Text) do
1430 with Chars
[Ord(Text[a
])] do
1431 if TextureID
<> -1 then
1433 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1434 e_GetTextureSize(TextureID
, nil, @h2
);
1435 if h2
> h
then h
:= h2
;
1440 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1442 a
, lines
, len
: Integer;
1449 if Text = '' then Exit
;
1450 if e_CharFonts
= nil then Exit
;
1451 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1454 len
:= Length(Text);
1456 with e_CharFonts
[FontID
] do
1458 for a
:= 1 to len
do
1460 if Text[a
] = #10 then
1470 else if Text[a
] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1473 with Chars
[Ord(Text[a
])] do
1474 if TextureID
<> -1 then
1476 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1477 e_GetTextureSize(TextureID
, nil, @h2
);
1478 if h2
> h
then h
:= h2
;
1488 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1494 if e_CharFonts
= nil then Exit
;
1495 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1497 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1498 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1501 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1508 if e_CharFonts
= nil then Exit
;
1509 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1511 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1513 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1514 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1516 if h2
> Result
then Result
:= h2
;
1520 procedure e_CharFont_Remove(FontID
: DWORD
);
1524 with e_CharFonts
[FontID
] do
1525 for a
:= 0 to High(Chars
) do
1526 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1528 e_CharFonts
[FontID
].alive
:= False;
1531 procedure e_CharFont_RemoveAll();
1535 if e_CharFonts
= nil then Exit
;
1537 for a
:= 0 to High(e_CharFonts
) do
1538 e_CharFont_Remove(a
);
1543 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1550 if e_NoGraphics
then Exit
;
1551 e_WriteLog('Creating texture font...', MSG_NOTIFY
);
1555 if e_TextureFonts
<> nil then
1556 for i
:= 0 to High(e_TextureFonts
) do
1557 if e_TextureFonts
[i
].Base
= 0 then
1563 if id
= DWORD(-1) then
1565 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1566 id
:= High(e_TextureFonts
);
1569 with e_TextureFonts
[id
] do
1571 Base
:= glGenLists(XCount
*YCount
);
1572 TextureID
:= e_Textures
[Tex
].tx
.id
;
1573 CharWidth
:= (e_Textures
[Tex
].tx
.Width
div XCount
)+Space
;
1574 CharHeight
:= e_Textures
[Tex
].tx
.Height
div YCount
;
1581 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1582 for loop1
:= 0 to XCount
*YCount
-1 do
1584 cx
:= (loop1
mod XCount
)/XCount
;
1585 cy
:= (loop1
div YCount
)/YCount
;
1587 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1589 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1590 glVertex2i(0, e_Textures
[Tex
].tx
.Height
div YCount
);
1592 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1593 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, e_Textures
[Tex
].tx
.Height
div YCount
);
1595 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1596 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, 0);
1598 glTexCoord2f(cx
, 1.0-cy
);
1601 glTranslated((e_Textures
[Tex
].tx
.Width
div XCount
)+Space
, 0, 0);
1608 procedure e_TextureFontKill(FontID
: DWORD
);
1610 if e_NoGraphics
then Exit
;
1611 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1612 e_TextureFonts
[FontID
].Base
:= 0;
1615 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1617 if e_NoGraphics
then Exit
;
1618 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1619 if Text = '' then Exit
;
1621 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1624 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1627 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1628 glEnable(GL_TEXTURE_2D
);
1629 glTranslated(x
, y
, 0);
1630 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1631 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1632 glDisable(GL_TEXTURE_2D
);
1635 glDisable(GL_BLEND
);
1638 // god forgive me for this, but i cannot figure out how to do it without lists
1639 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1641 if e_NoGraphics
then Exit
;
1646 glColor4ub(0, 0, 0, 128);
1647 glTranslated(X
+1, Y
+1, 0);
1648 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1653 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1654 glTranslated(X
, Y
, 0);
1655 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1660 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1662 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1663 glEnable(GL_TEXTURE_2D
);
1664 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1666 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1668 e_TextureFontPrintChar(X
, Y
, Ch
, FontID
, Shadow
);
1669 glDisable(GL_TEXTURE_2D
);
1670 glDisable(GL_BLEND
);
1673 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
1675 result
:= e_TextureFonts
[FontID
].CharWidth
;
1678 procedure e_TextureFontPrintFmt(X
, Y
: Integer; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
1680 a
, TX
, TY
, len
: Integer;
1684 if e_NoGraphics
then Exit
;
1685 if Text = '' then Exit
;
1686 if e_TextureFonts
= nil then Exit
;
1687 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1695 len
:= Length(Text);
1697 w
:= e_TextureFonts
[FontID
].CharWidth
;
1699 with e_TextureFonts
[FontID
] do
1701 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1702 glEnable(GL_TEXTURE_2D
);
1703 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1705 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1708 for a
:= 1 to len
do
1719 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1724 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1729 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1734 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1739 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1744 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1749 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1754 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1761 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1766 glDisable(GL_TEXTURE_2D
);
1767 glDisable(GL_BLEND
);
1771 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1772 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1774 if e_NoGraphics
then Exit
;
1775 if Text = '' then Exit
;
1778 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1779 glEnable(GL_TEXTURE_2D
);
1780 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1782 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1787 glColor4ub(0, 0, 0, 128);
1788 glTranslated(x
+1, y
+1, 0);
1789 glScalef(Scale
, Scale
, 0);
1790 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1795 glColor4ub(Red
, Green
, Blue
, 255);
1796 glTranslated(x
, y
, 0);
1797 glScalef(Scale
, Scale
, 0);
1798 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1800 glDisable(GL_TEXTURE_2D
);
1802 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1803 glDisable(GL_BLEND
);
1806 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
1810 if e_NoGraphics
then Exit
;
1811 if Integer(ID
) > High(e_TextureFonts
) then
1813 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1814 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1817 procedure e_RemoveAllTextureFont();
1821 if e_NoGraphics
then Exit
;
1822 if e_TextureFonts
= nil then Exit
;
1824 for i
:= 0 to High(e_TextureFonts
) do
1825 if e_TextureFonts
[i
].Base
<> 0 then
1827 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1828 e_TextureFonts
[i
].Base
:= 0;
1831 e_TextureFonts
:= nil;
1834 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1841 function _Point(X
, Y
: Integer): TPoint2i
;
1847 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1851 Result
.Width
:= Width
;
1852 Result
.Height
:= Height
;
1855 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
1864 procedure e_MakeScreenshot (st
: TStream
; Width
, Height
: Word);
1866 pixels
, obuf
, scln
, ps
, pd
: PByte;
1869 i
, x
, y
, res
: Integer;
1870 sign
: array [0..7] of Byte;
1871 hbuf
: array [0..12] of Byte;
1876 if e_NoGraphics
then Exit
;
1879 // first, extract and pack graphics data
1880 if (Width
mod 4) > 0 then Width
:= Width
+4-(Width
mod 4);
1882 GetMem(pixels
, Width
*Height
*3);
1884 FillChar(pixels
^, Width
*Height
*3, 0);
1885 glReadPixels(0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pixels
);
1886 //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
1888 if e_FastScreenshots
then
1891 GetMem(scln
, (Width
*3+1)*Height
);
1895 Inc(ps
, (Width
*3)*(Height
-1));
1896 for i
:= 0 to Height
-1 do
1900 Move(ps
^, pd
^, Width
*3);
1912 obufsize
:= (Width
*3+1)*Height
*2;
1913 GetMem(obuf
, obufsize
);
1918 res
:= compress2(Pointer(obuf
), dlen
, Pointer(pixels
), (Width
*3+1)*Height
, 9);
1919 if res
= Z_OK
then break
;
1920 if res
<> Z_BUF_ERROR
then raise Exception
.Create('can''t pack data for PNG');
1921 obufsize
:= obufsize
*2;
1924 GetMem(obuf
, obufsize
);
1926 //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
1939 st
.writeBuffer(sign
, 8);
1940 //e_WriteLog('PNG: signature written', MSG_NOTIFY);
1943 writeIntBE(st
, LongWord(13));
1948 st
.writeBuffer(sign
, 4);
1949 crc
:= crc32(0, @sign
[0], 4);
1952 hbuf
[2] := (Width
shr 8) and $ff;
1953 hbuf
[3] := Width
and $ff;
1956 hbuf
[6] := (Height
shr 8) and $ff;
1957 hbuf
[7] := Height
and $ff;
1958 hbuf
[8] := 8; // bit depth
1959 hbuf
[9] := 2; // RGB
1960 hbuf
[10] := 0; // compression method
1961 hbuf
[11] := 0; // filter method
1962 hbuf
[12] := 0; // no interlace
1963 crc
:= crc32(crc
, @hbuf
[0], 13);
1964 st
.writeBuffer(hbuf
, 13);
1965 writeIntBE(st
, crc
);
1966 //e_WriteLog('PNG: header written', MSG_NOTIFY);
1969 writeIntBE(st
, LongWord(dlen
));
1974 st
.writeBuffer(sign
, 4);
1975 crc
:= crc32(0, @sign
[0], 4);
1976 crc
:= crc32(crc
, obuf
, dlen
);
1977 st
.writeBuffer(obuf
^, dlen
);
1978 writeIntBE(st
, crc
);
1979 //e_WriteLog('PNG: image data written', MSG_NOTIFY);
1982 writeIntBE(st
, LongWord(0));
1987 st
.writeBuffer(sign
, 4);
1988 crc
:= crc32(0, @sign
[0], 4);
1989 writeIntBE(st
, crc
);
1990 //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
1992 if obuf
<> nil then FreeMem(obuf
);
1997 Imaging
.SetOption(ImagingPNGCompressLevel
, 9);
1998 Imaging
.SetOption(ImagingPNGPreFilter
, 6);
2001 NewImage(Width
, Height
, TImageFormat
.ifR8G8B8
, img
);
2003 //writeln(stderr, 'moving pixels...');
2004 for y
:= Height
-1 downto 0 do
2006 for x
:= 0 to Width
-1 do
2008 clr
.r
:= ps
^; Inc(ps
);
2009 clr
.g
:= ps
^; Inc(ps
);
2010 clr
.b
:= ps
^; Inc(ps
);
2012 SetPixel32(img
, x
, y
, clr
);
2015 GlobalMetadata
.ClearMetaItems();
2016 GlobalMetadata
.ClearMetaItemsForSaving();
2017 //writeln(stderr, 'compressing image...');
2018 if not SaveImageToStream('png', st
, img
) then raise Exception
.Create('screenshot writing error');
2019 //writeln(stderr, 'done!');