1 (* Copyright (C) Doom 2D: Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, version 3 of the License ONLY.
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 {$INCLUDE ../shared/a_modes.inc}
21 {$INCLUDE ../nogl/noGLuses.inc}
25 SysUtils
, Classes
, Math
, e_log
, e_texture
,
26 MAPDEF
, ImagingTypes
, Imaging
, ImagingUtility
;
29 TMirrorType
=(None
, Horizontal
, Vertical
);
30 TBlending
=(None
, Blend
, Filter
, Invert
);
41 Left
, Top
, Right
, Bottom
: Integer;
59 //------------------------------------------------------------------
61 //------------------------------------------------------------------
63 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
64 procedure e_ResizeWindow(Width
, Height
: Integer);
65 procedure e_ResizeFramebuffer(Width
, Height
: Integer);
66 procedure e_BlitFramebuffer(WinWidth
, WinHeight
: Integer);
68 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
69 Blending
: Boolean; Mirror
: TMirrorType
= TMirrorType
.None
);
70 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
71 Blending
: Boolean; Angle
: Single; RC
: PDFPoint
; Mirror
: TMirrorType
= TMirrorType
.None
);
72 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
73 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
74 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
75 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
77 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
78 AlphaChannel
: Boolean; Blending
: Boolean; ambientBlendMode
: Boolean=false);
80 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; alphachannel
: Boolean;
81 blending
: Boolean; scale
: Single; ambientBlendMode
: Boolean=false);
83 procedure e_AmbientQuad (x
, y
, w
, h
: Integer; r
, g
, b
, a
: Byte);
85 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
86 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
87 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
88 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
89 Blending
: TBlending
= TBlending
.None
);
90 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
91 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
93 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
94 function e_CreateTexture(FileName
: string; var ID
: DWORD
): Boolean;
95 function e_CreateTextureEx(FileName
: string; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
96 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
97 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
98 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
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
;
124 Shadow
: Boolean = False; Newlines
: Boolean = False);
125 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
126 procedure e_RemoveAllTextureFont();
128 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
129 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
131 procedure e_ReleaseEngine();
132 procedure e_BeginRender();
133 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
134 procedure e_Clear(); overload
;
135 procedure e_EndRender();
138 function e_GetGamma(win
: PSDL_Window
): Byte;
139 procedure e_SetGamma(win
: PSDL_Window
;Gamma
: Byte);
142 procedure e_MakeScreenshot(st
: TStream
; Width
, Height
: Word);
144 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
145 function _Point(X
, Y
: Integer): TPoint2i
;
146 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
147 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
149 //function e_getTextGLId (ID: DWORD): GLuint;
153 e_NoGraphics
: Boolean = False;
154 e_FastScreenshots
: Boolean = true; // it's REALLY SLOW with `false`
155 g_dbg_scale
: Single = 1.0;
156 r_pixel_scale
: Single = 1.0;
170 TTextureFont
= record
181 Chars
: array[0..255] of
191 TSavedTexture
= record
198 e_Textures
: array of TTexture
= nil;
199 e_TextureFonts
: array of TTextureFont
= nil;
200 e_CharFonts
: array of TCharFont
;
201 //e_SavedTextures: array of TSavedTexture;
205 e_FrameW
: Integer = -1;
206 e_FrameH
: Integer = -1;
208 //function e_getTextGLId (ID: DWORD): GLuint; begin result := e_Textures[ID].tx.id; end;
210 //------------------------------------------------------------------
211 // Èíèöèàëèçèðóåò OpenGL
212 //------------------------------------------------------------------
213 procedure e_InitGL();
217 e_DummyTextures
:= True;
223 glDisable(GL_DEPTH_TEST
);
224 glEnable(GL_SCISSOR_TEST
);
225 glClearColor(0, 0, 0, 0);
228 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
230 mat
: Array [0..15] of GLDouble
;
233 if e_NoGraphics
then Exit
;
235 glScissor(X
, Y
, Width
, Height
);
236 glViewport(X
, Y
, Width
, Height
);
237 //gluOrtho2D(0, Width, Height, 0);
239 glMatrixMode(GL_PROJECTION
);
241 mat
[ 0] := 2.0 / Width
;
247 mat
[ 5] := -2.0 / Height
;
261 glLoadMatrixd(@mat
[0]);
263 glMatrixMode(GL_MODELVIEW
);
267 //------------------------------------------------------------------
268 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
269 //------------------------------------------------------------------
270 function FindTexture(): DWORD
;
274 if e_Textures
<> nil then
275 for i
:= 0 to High(e_Textures
) do
276 if e_Textures
[i
].tx
.Width
= 0 then
282 if e_Textures
= nil then
284 SetLength(e_Textures
, 32);
289 Result
:= High(e_Textures
) + 1;
290 SetLength(e_Textures
, Length(e_Textures
) + 32);
294 //------------------------------------------------------------------
296 //------------------------------------------------------------------
297 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
304 e_WriteLog('Loading texture from '+FileName
, TMsgType
.Notify
);
306 find_id
:= FindTexture();
308 if not LoadTexture(FileName
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].tx
.Width
,
309 e_Textures
[find_id
].tx
.Height
, @fmt
) then Exit
;
316 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
323 find_id
:= FindTexture();
325 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
332 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
339 find_id
:= FindTexture
;
341 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
;
348 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
355 find_id
:= FindTexture();
357 if not LoadTextureMemEx(pData
, dataSize
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
364 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
370 find_id
:= FindTexture();
371 if not LoadTextureImg(img
, e_Textures
[find_id
].tx
, tw
, th
, @fmt
) then exit
;
376 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
378 if Width
<> nil then Width
^ := e_Textures
[ID
].tx
.Width
;
379 if Height
<> nil then Height
^ := e_Textures
[ID
].tx
.Height
;
382 procedure e_ResizeFramebuffer(Width
, Height
: Integer);
384 if e_NoGraphics
then Exit
;
386 glBindTexture(GL_TEXTURE_2D
, 0);
387 glBindRenderbuffer(GL_RENDERBUFFER
, 0);
388 glBindFramebuffer(GL_FRAMEBUFFER
, 0);
392 glDeleteTextures(1, @e_Frame
);
398 glDeleteRenderbuffers(1, @e_RBO
);
404 glDeleteFramebuffers(1, @e_FBO
);
411 glGenFramebuffers(1, @e_FBO
);
413 glGenTextures(1, @e_Frame
);
414 glBindTexture(GL_TEXTURE_2D
, e_Frame
);
415 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGB
, Width
, Height
, 0, GL_RGB
, GL_UNSIGNED_BYTE
, nil);
416 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, GL_NEAREST
);
417 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, GL_NEAREST
);
419 glGenRenderbuffers(1, @e_RBO
);
420 glBindRenderbuffer(GL_RENDERBUFFER
, e_RBO
);
421 glRenderbufferStorage(GL_RENDERBUFFER
, {$IFNDEF USE_GLES1}GL_DEPTH24_STENCIL8
{$ELSE}GL_DEPTH_COMPONENT16
{$ENDIF}, Width
, Height
);
423 glBindFramebuffer(GL_FRAMEBUFFER
, e_FBO
);
424 glFramebufferTexture2D(GL_FRAMEBUFFER
, GL_COLOR_ATTACHMENT0
, GL_TEXTURE_2D
, e_Frame
, 0);
425 glFramebufferRenderbuffer(GL_FRAMEBUFFER
, {$IFNDEF USE_GLES1}GL_DEPTH_STENCIL_ATTACHMENT
{$ELSE}GL_DEPTH_ATTACHMENT
{$ENDIF}, GL_RENDERBUFFER
, e_RBO
);
428 procedure e_ResizeWindow(Width
, Height
: Integer);
432 e_SetViewPort(0, 0, Width
, Height
);
435 procedure drawTxQuad (x0
, y0
, w
, h
, tw
, th
: Integer; u
, v
: single; Mirror
: TMirrorType
);
437 x1
, y1
, tmp
: Integer;
439 if (w
< 1) or (h
< 1) then exit
;
442 if Mirror
= TMirrorType
.Horizontal
then begin tmp
:= x1
; x1
:= x0
; x0
:= tmp
; end
443 else if Mirror
= TMirrorType
.Vertical
then begin tmp
:= y1
; y1
:= y0
; y0
:= tmp
; end;
444 glTexCoord2f(0, v
); glVertex2i(x0
, y0
);
445 glTexCoord2f(0, 0); glVertex2i(x0
, y1
);
446 glTexCoord2f(u
, 0); glVertex2i(x1
, y1
);
447 glTexCoord2f(u
, v
); glVertex2i(x1
, y0
);
450 procedure e_BlitFramebuffer(WinWidth
, WinHeight
: Integer);
452 if (e_FBO
= 0) or (e_Frame
= 0) or e_NoGraphics
then exit
;
455 glEnable(GL_TEXTURE_2D
);
456 glBindFramebuffer(GL_FRAMEBUFFER
, 0);
457 glBindTexture(GL_TEXTURE_2D
, e_Frame
);
458 e_SetViewPort(0, 0, WinWidth
, WinHeight
);
459 glColor4ub(255, 255, 255, 255);
462 glTexCoord2f(0, 1); glVertex2i( 0, 0);
463 glTexCoord2f(0, 0); glVertex2i( 0, WinHeight
);
464 glTexCoord2f(1, 0); glVertex2i(WinWidth
, WinHeight
);
465 glTexCoord2f(1, 1); glVertex2i(WinWidth
, 0);
468 glBindFramebuffer(GL_FRAMEBUFFER
, e_FBO
);
469 e_SetViewPort(0, 0, e_FrameW
, e_FrameH
);
472 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
473 Blending
: Boolean; Mirror
: TMirrorType
= TMirrorType
.None
);
475 if e_NoGraphics
then Exit
;
476 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
478 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
483 if (AlphaChannel
) or (Alpha
> 0) then
484 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
487 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
490 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
492 glEnable(GL_TEXTURE_2D
);
493 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
496 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
);
498 //u := e_Textures[ID].tx.u;
499 //v := e_Textures[ID].tx.v;
502 if Mirror = M_NONE then
504 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
505 glTexCoord2f(0, 0); glVertex2i(X, Y);
506 glTexCoord2f(0, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
507 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
510 if Mirror = M_HORIZONTAL then
512 glTexCoord2f(u, 0); glVertex2i(X, Y);
513 glTexCoord2f(0, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
514 glTexCoord2f(0, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
515 glTexCoord2f(u, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
518 if Mirror = M_VERTICAL then
520 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y);
521 glTexCoord2f(0, -v); glVertex2i(X, Y);
522 glTexCoord2f(0, 0); glVertex2i(X, Y + e_Textures[id].tx.Height);
523 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
532 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
533 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
537 if e_NoGraphics
then Exit
;
538 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
540 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
545 if (AlphaChannel
) or (Alpha
> 0) then
546 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
549 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
552 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
554 glEnable(GL_TEXTURE_2D
);
555 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
557 u
:= e_Textures
[ID
].tx
.u
;
558 v
:= e_Textures
[ID
].tx
.v
;
561 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
562 glTexCoord2f(u
, v
); glVertex2i(X
+ Width
, Y
);
563 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
564 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
570 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
571 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
573 if e_NoGraphics
then Exit
;
574 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
576 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
581 if (AlphaChannel
) or (Alpha
> 0) then
582 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
585 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
588 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
590 glEnable(GL_TEXTURE_2D
);
591 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
593 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
);
599 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
600 AlphaChannel
: Boolean; Blending
: Boolean; ambientBlendMode
: Boolean=false);
602 X2
, Y2
, dx
, w
, h
: Integer;
605 if e_NoGraphics
then Exit
;
606 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
607 ambientBlendMode
:= false;
609 if (Alpha
> 0) or AlphaChannel
or Blending
then
615 if not ambientBlendMode
then glDisable(GL_BLEND
);
617 if AlphaChannel
or (Alpha
> 0) then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
618 if (Alpha
> 0) then glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
619 if Blending
then glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
621 if (XCount
= 0) then XCount
:= 1;
622 if (YCount
= 0) then YCount
:= 1;
624 glEnable(GL_TEXTURE_2D
);
625 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
627 X2
:= X
+e_Textures
[ID
].tx
.width
*XCount
;
628 Y2
:= Y
+e_Textures
[ID
].tx
.height
*YCount
;
630 //k8: this SHOULD work... i hope
631 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
634 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
635 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
636 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
637 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
644 u
:= e_Textures
[ID
].tx
.u
;
645 v
:= e_Textures
[ID
].tx
.v
;
646 w
:= e_Textures
[ID
].tx
.width
;
647 h
:= e_Textures
[ID
].tx
.height
;
654 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
655 glTexCoord2f(u
, v
); glVertex2i(X
+w
, Y
);
656 glTexCoord2f(u
, 0); glVertex2i(X
+w
, Y
+h
);
657 glTexCoord2f(0, 0); glVertex2i(X
, Y
+h
);
672 //TODO: overflow checks
673 function intersectRect (var x0
, y0
, w0
, h0
: Integer; const x1
, y1
, w1
, h1
: Integer): Boolean;
678 if (w0
< 1) or (h0
< 1) or (w1
< 1) or (h1
< 1) then exit
;
679 // check for intersection
680 if (x0
+w0
<= x1
) or (y0
+h0
<= y1
) or (x1
+w1
<= x0
) or (y1
+h1
<= y0
) then exit
;
681 if (x0
>= x1
+w1
) or (y0
>= y1
+h1
) or (x1
>= x0
+h0
) or (y1
>= y0
+h0
) then exit
;
685 if (x0
< x1
) then x0
:= x1
;
686 if (y0
< y1
) then y0
:= y1
;
687 if (ex0
> x1
+w1
) then ex0
:= x1
+w1
;
688 if (ey0
> y1
+h1
) then ey0
:= y1
+h1
;
691 result
:= (w0
> 0) and (h0
> 0);
695 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; alphachannel
: Boolean;
696 blending
: Boolean; scale
: Single; ambientBlendMode
: Boolean=false);
701 scxywh: array[0..3] of GLint;
702 vpxywh: array[0..3] of GLint;
704 w
, h
, dw
, cw
, ch
, yofs
: Integer;
705 u
, v
, cu
, cv
: Single;
709 procedure setScissorGLInternal (x, y, w, h: Integer);
711 //if not scallowed then exit;
716 y := vpxywh[3]-(y+h);
717 if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then
719 glScissor(0, 0, 0, 0);
723 //writeln(' (', x, ',', y, ')-(', w, ',', h, ')');
724 glScissor(x, y, w, h);
730 if e_NoGraphics
then exit
;
731 ambientBlendMode
:= false;
733 if (wdt
< 1) or (hgt
< 1) then exit
;
735 if (wdt
mod e_Textures
[ID
].tx
.width
= 0) and (hgt
mod e_Textures
[ID
].tx
.height
= 0) then
737 e_DrawFill(id
, x
, y
, wdt
div e_Textures
[ID
].tx
.width
, hgt
div e_Textures
[ID
].tx
.height
, alpha
, alphachannel
, blending
, ambientBlendMode
);
741 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
743 if (Alpha
> 0) or AlphaChannel
or Blending
then
749 if not ambientBlendMode
then glDisable(GL_BLEND
);
751 if AlphaChannel
or (Alpha
> 0) then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
752 if (Alpha
> 0) then glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
753 if Blending
then glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
755 glEnable(GL_TEXTURE_2D
);
756 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
761 //k8: this SHOULD work... i hope
762 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
765 glTexCoord2f(0, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x
, y
);
766 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x2
, y
);
767 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, 0); glVertex2i(x2
, y2
);
768 glTexCoord2f(0, 0); glVertex2i(x
, y2
);
773 // hard day's night; setup scissor
775 glGetIntegerv(GL_VIEWPORT, @vpxywh[0]);
776 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
777 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
778 //writeln('(', scxywh[0], ',', scxywh[1], ')-(', scxywh[2], ',', scxywh[3], ')');
779 //glEnable(GL_SCISSOR_TEST);
780 setScissorGLInternal(x, y, wdt, hgt);
783 u
:= e_Textures
[ID
].tx
.u
;
784 v
:= e_Textures
[ID
].tx
.v
;
785 w
:= e_Textures
[ID
].tx
.width
;
786 h
:= e_Textures
[ID
].tx
.height
;
788 if (hgt
> h
) then begin y
+= hgt
-h
; onlyOneY
:= false; end else onlyOneY
:= true;
792 if (hgt
>= h
) then begin ch
:= h
; cv
:= v
; yofs
:= 0; end else begin ch
:= hgt
; cv
:= v
/(h
/hgt
); yofs
:= h
-hgt
; end;
793 if onlyOneY
then yofs
:= 0;
799 if (dw
>= w
) then begin cw
:= w
; cu
:= u
; end else begin cw
:= dw
; cu
:= u
/(w
/dw
); end;
801 glTexCoord2f(0, cv
); glVertex2i(X
, Y
+yofs
);
802 glTexCoord2f(cu
, cv
); glVertex2i(X
+cw
, Y
+yofs
);
803 glTexCoord2f(cu
, 0); glVertex2i(X
+cw
, Y
+ch
+yofs
);
804 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ch
+yofs
);
810 //if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
817 procedure e_AmbientQuad (x
, y
, w
, h
: Integer; r
, g
, b
, a
: Byte);
819 if e_NoGraphics
then exit
;
820 if (w
< 1) or (h
< 1) then exit
;
821 if (a
<> 255) or ((r
or g
or b
) <> 0) then
824 glDisable(GL_TEXTURE_2D
);
825 glColor4ub(r
, g
, b
, a
);
826 if ((r
or g
or b
) <> 0) then
828 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
832 glVertex2i(x
+w
, y
+h
);
836 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
840 glVertex2i(x
+w
, y
+h
);
848 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
849 Blending
: Boolean; Angle
: Single; RC
: PDFPoint
; Mirror
: TMirrorType
= TMirrorType
.None
);
851 if e_NoGraphics
then Exit
;
853 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
855 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
860 if (AlphaChannel
) or (Alpha
> 0) then
861 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
864 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
867 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
869 if (Angle
<> 0) and (RC
<> nil) then
872 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
873 glRotatef(Angle
, 0, 0, 1);
874 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
877 glEnable(GL_TEXTURE_2D
);
878 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
879 glBegin(GL_QUADS
); //0-1 1-1
881 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
);
890 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
892 if e_NoGraphics
then Exit
;
893 glDisable(GL_TEXTURE_2D
);
894 glColor3ub(Red
, Green
, Blue
);
897 if (Size
= 2) or (Size
= 4) then
901 glVertex2f(X
+0.3, Y
+1.0);
904 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
907 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
909 // Make lines only top-left/bottom-right and top-right/bottom-left
921 // Pixel-perfect hack
929 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
931 nX1
, nY1
, nX2
, nY2
: Integer;
933 if e_NoGraphics
then Exit
;
934 // Only top-left/bottom-right quad
951 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
956 glDisable(GL_TEXTURE_2D
);
957 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
960 nX1
:= X1
; nY1
:= Y1
;
961 nX2
:= X2
; nY2
:= Y1
;
962 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
963 glVertex2i(nX1
, nY1
);
964 glVertex2i(nX2
, nY2
);
966 nX1
:= X2
; nY1
:= Y1
;
967 nX2
:= X2
; nY2
:= Y2
;
968 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
969 glVertex2i(nX1
, nY1
);
970 glVertex2i(nX2
, nY2
);
972 nX1
:= X2
; nY1
:= Y2
;
973 nX2
:= X1
; nY2
:= Y2
;
974 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
975 glVertex2i(nX1
, nY1
);
976 glVertex2i(nX2
, nY2
);
978 nX1
:= X1
; nY1
:= Y2
;
979 nX2
:= X1
; nY2
:= Y1
;
980 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
981 glVertex2i(nX1
, nY1
);
982 glVertex2i(nX2
, nY2
);
984 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
988 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
989 Blending
: TBlending
= TBlending
.None
);
991 if e_NoGraphics
then Exit
;
992 if (Alpha
> 0) or (Blending
<> TBlending
.None
) then
997 if Blending
= TBlending
.Blend
then
998 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
1000 if Blending
= TBlending
.Filter
then
1001 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
1003 if Blending
= TBlending
.Invert
then
1004 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
1007 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1009 glDisable(GL_TEXTURE_2D
);
1010 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
1022 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1024 glDisable(GL_BLEND
);
1028 // ////////////////////////////////////////////////////////////////////////// //
1029 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
1031 if (a
< 0) then a
:= 0;
1032 if (a
> 255) then a
:= 255;
1034 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
1035 glDisable(GL_TEXTURE_2D
);
1036 glColor4ub(0, 0, 0, Byte(255-a
));
1043 //glRect(x, y, x+w, y+h);
1044 glColor4ub(1, 1, 1, 1);
1045 glDisable(GL_BLEND
);
1046 //glBlendEquation(GL_FUNC_ADD);
1049 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
1051 if (w
> 0) and (h
> 0) then e_DarkenQuad(x
, y
, x
+w
, y
+h
, a
);
1055 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
1057 if e_NoGraphics
then Exit
;
1058 // Pixel-perfect lines
1060 e_LineCorrection(X1
, Y1
, X2
, Y2
);
1065 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1067 glDisable(GL_BLEND
);
1069 glDisable(GL_TEXTURE_2D
);
1070 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
1076 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1078 glDisable(GL_BLEND
);
1081 //------------------------------------------------------------------
1082 // Óäàëÿåò òåêñòóðó èç ìàññèâà
1083 //------------------------------------------------------------------
1084 procedure e_DeleteTexture(ID
: DWORD
);
1086 if not e_NoGraphics
then
1087 glDeleteTextures(1, @e_Textures
[ID
].tx
.id
);
1088 e_Textures
[ID
].tx
.id
:= 0;
1089 e_Textures
[ID
].tx
.Width
:= 0;
1090 e_Textures
[ID
].tx
.Height
:= 0;
1093 //------------------------------------------------------------------
1094 // Óäàëÿåò âñå òåêñòóðû
1095 //------------------------------------------------------------------
1096 procedure e_RemoveAllTextures();
1100 if e_Textures
= nil then Exit
;
1102 for i
:= 0 to High(e_Textures
) do
1103 if e_Textures
[i
].tx
.Width
<> 0 then e_DeleteTexture(i
);
1107 //------------------------------------------------------------------
1109 //------------------------------------------------------------------
1110 procedure e_ReleaseEngine();
1112 e_RemoveAllTextures
;
1113 e_RemoveAllTextureFont
;
1116 procedure e_BeginRender();
1118 if e_NoGraphics
then Exit
;
1119 glEnable(GL_ALPHA_TEST
);
1120 glAlphaFunc(GL_GREATER
, 0.0);
1123 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
1125 if e_NoGraphics
then Exit
;
1126 glClearColor(Red
, Green
, Blue
, 0);
1130 procedure e_Clear(); overload
;
1132 if e_NoGraphics
then Exit
;
1133 glClearColor(0, 0, 0, 0);
1134 glClear(GL_COLOR_BUFFER_BIT
);
1137 procedure e_EndRender();
1139 if e_NoGraphics
then Exit
;
1144 function e_GetGamma(win
: PSDL_Window
): Byte;
1146 ramp
: array [0..256*3-1] of Word;
1147 rgb
: array [0..2] of Double;
1156 if e_NoGraphics
then Exit
;
1161 SDL_GetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1170 for j
:= min
to max
- 1 do
1173 B
:= (j
mod 256)/256;
1175 sum
:= sum
+ ln(A
)/ln(B
);
1178 rgb
[i
] := sum
/ count
;
1181 Result
:= 100 - Trunc(((rgb
[0] + rgb
[1] + rgb
[2])/3 - 0.23) * 100/(2.7 - 0.23));
1184 procedure e_SetGamma(win
: PSDL_Window
; Gamma
: Byte);
1186 ramp
: array [0..256*3-1] of Word;
1191 if e_NoGraphics
then Exit
;
1192 g
:= (100 - Gamma
)*(2.7 - 0.23)/100 + 0.23;
1194 for i
:= 0 to 255 do
1196 r
:= Exp(g
* ln(i
/256))*65536;
1197 if r
< 0 then r
:= 0
1198 else if r
> 65535 then r
:= 65535;
1199 ramp
[i
] := trunc(r
);
1200 ramp
[i
+ 256] := trunc(r
);
1201 ramp
[i
+ 512] := trunc(r
);
1204 SDL_SetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1208 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1212 e_WriteLog('Creating CharFont...', TMsgType
.Notify
);
1216 if e_CharFonts
<> nil then
1217 for i
:= 0 to High(e_CharFonts
) do
1218 if not e_CharFonts
[i
].alive
then
1224 if id
= DWORD(-1) then
1226 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1227 id
:= High(e_CharFonts
);
1230 with e_CharFonts
[id
] do
1232 for i
:= 0 to High(Chars
) do
1246 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1248 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1250 TextureID
:= Texture
;
1255 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1259 if e_NoGraphics
then Exit
;
1260 if Text = '' then Exit
;
1261 if e_CharFonts
= nil then Exit
;
1262 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1264 with e_CharFonts
[FontID
] do
1266 for a
:= 1 to Length(Text) do
1267 with Chars
[Ord(Text[a
])] do
1268 if TextureID
<> -1 then
1270 e_Draw(TextureID
, X
, Y
, 0, True, False);
1271 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1276 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1277 Color
: TRGB
; Scale
: Single = 1.0);
1282 if e_NoGraphics
then Exit
;
1283 if Text = '' then Exit
;
1284 if e_CharFonts
= nil then Exit
;
1285 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1287 with e_CharFonts
[FontID
] do
1289 for a
:= 1 to Length(Text) do
1290 with Chars
[Ord(Text[a
])] do
1291 if TextureID
<> -1 then
1293 if Scale
<> 1.0 then
1296 glScalef(Scale
, Scale
, 0);
1301 e_Draw(TextureID
, X
, Y
, 0, True, False);
1304 if Scale
<> 1.0 then glPopMatrix
;
1306 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1311 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1313 a
, TX
, TY
, len
: Integer;
1317 if e_NoGraphics
then Exit
;
1318 if Text = '' then Exit
;
1319 if e_CharFonts
= nil then Exit
;
1320 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1328 len
:= Length(Text);
1330 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1332 with e_CharFonts
[FontID
] do
1334 for a
:= 1 to len
do
1345 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1350 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1355 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1360 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1365 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1370 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1375 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1380 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1385 with Chars
[Ord(Text[a
])] do
1386 if TextureID
<> -1 then
1390 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1393 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1399 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1407 if Text = '' then Exit
;
1408 if e_CharFonts
= nil then Exit
;
1409 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1411 with e_CharFonts
[FontID
] do
1413 for a
:= 1 to Length(Text) do
1414 with Chars
[Ord(Text[a
])] do
1415 if TextureID
<> -1 then
1417 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1418 e_GetTextureSize(TextureID
, nil, @h2
);
1419 if h2
> h
then h
:= h2
;
1424 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1426 a
, lines
, len
: Integer;
1427 h2
, w2
, tw
, th
: Word;
1434 if Text = '' then Exit
;
1435 if e_CharFonts
= nil then Exit
;
1436 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1439 len
:= Length(Text);
1441 with e_CharFonts
[FontID
] do
1443 for a
:= 1 to len
do
1445 if Text[a
] = #10 then
1448 if w2
> tw
then tw
:= w2
;
1453 with Chars
[Ord(Text[a
])] do
1454 if TextureID
<> -1 then
1456 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1457 e_GetTextureSize(TextureID
, nil, @h2
);
1458 if h2
> th
then th
:= h2
;
1470 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1476 if e_CharFonts
= nil then Exit
;
1477 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1479 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1480 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1483 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1490 if e_CharFonts
= nil then Exit
;
1491 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1493 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1495 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1496 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1498 if h2
> Result
then Result
:= h2
;
1502 procedure e_CharFont_Remove(FontID
: DWORD
);
1506 with e_CharFonts
[FontID
] do
1507 for a
:= 0 to High(Chars
) do
1508 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1510 e_CharFonts
[FontID
].alive
:= False;
1513 procedure e_CharFont_RemoveAll();
1517 if e_CharFonts
= nil then Exit
;
1519 for a
:= 0 to High(e_CharFonts
) do
1520 e_CharFont_Remove(a
);
1525 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1534 if e_NoGraphics
then Exit
;
1535 e_WriteLog('Creating texture font...', TMsgType
.Notify
);
1539 if e_TextureFonts
<> nil then
1540 for i
:= 0 to High(e_TextureFonts
) do
1541 if e_TextureFonts
[i
].Base
= 0 then
1547 if id
= DWORD(-1) then
1549 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1550 id
:= High(e_TextureFonts
);
1553 with e_TextureFonts
[id
] do
1556 Base
:= glGenLists(XCount
*YCount
);
1558 TextureID
:= e_Textures
[Tex
].tx
.id
;
1559 CharWidth
:= (e_Textures
[Tex
].tx
.Width
div XCount
)+Space
;
1560 CharHeight
:= e_Textures
[Tex
].tx
.Height
div YCount
;
1568 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1569 for loop1
:= 0 to XCount
*YCount
-1 do
1571 cx
:= (loop1
mod XCount
)/XCount
;
1572 cy
:= (loop1
div YCount
)/YCount
;
1574 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1576 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1577 glVertex2i(0, e_Textures
[Tex
].tx
.Height
div YCount
);
1579 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1580 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, e_Textures
[Tex
].tx
.Height
div YCount
);
1582 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1583 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, 0);
1585 glTexCoord2f(cx
, 1.0-cy
);
1588 glTranslated((e_Textures
[Tex
].tx
.Width
div XCount
)+Space
, 0, 0);
1596 procedure e_TextureFontKill(FontID
: DWORD
);
1598 if e_NoGraphics
then Exit
;
1600 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1602 e_TextureFonts
[FontID
].Base
:= 0;
1605 {$IFNDEF NOGL_LISTS}
1606 procedure e_TextureFontDrawChar(ch
: Char; FontID
: DWORD
);
1611 Width
, Height
: Integer;
1612 XCount
, YCount
: Integer;
1614 index
:= Ord(ch
) - 32;
1615 Tex
:= e_TextureFonts
[FontID
].Texture
;
1616 Width
:= e_Textures
[Tex
].tx
.Width
;
1617 Height
:= e_Textures
[Tex
].tx
.Height
;
1618 XCount
:= e_TextureFonts
[FontID
].XC
;
1619 YCount
:= e_TextureFonts
[FontID
].YC
;
1620 cx
:= (index
mod XCount
)/XCount
;
1621 cy
:= (index
div YCount
)/YCount
;
1623 glTexCoord2f(cx
, 1 - cy
- 1/YCount
);
1624 glVertex2i(0, Height
div YCount
);
1625 glTexCoord2f(cx
+ 1/XCount
, 1 - cy
- 1/YCount
);
1626 glVertex2i(Width
div XCount
, Height
div YCount
);
1627 glTexCoord2f(cx
+ 1/XCount
, 1 - cy
);
1628 glVertex2i(Width
div XCount
, 0);
1629 glTexCoord2f(cx
, 1 - cy
);
1632 glTranslatef((e_Textures
[Tex
].tx
.Width
div XCount
) + e_TextureFonts
[FontID
].SPC
, 0, 0);
1635 procedure e_TextureFontDrawString(Text: String; FontID
: DWORD
);
1639 for i
:= 1 to High(Text) do
1640 e_TextureFontDrawChar(Text[i
], FontID
);
1644 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1646 if e_NoGraphics
then Exit
;
1647 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1648 if Text = '' then Exit
;
1650 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1653 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1656 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1657 glEnable(GL_TEXTURE_2D
);
1658 glTranslatef(x
, y
, 0);
1660 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1661 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1663 e_TextureFontDrawString(Text, FontID
);
1665 glDisable(GL_TEXTURE_2D
);
1668 glDisable(GL_BLEND
);
1671 // god forgive me for this, but i cannot figure out how to do it without lists
1672 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1674 if e_NoGraphics
then Exit
;
1679 glColor4ub(0, 0, 0, 128);
1680 glTranslatef(X
+1, Y
+1, 0);
1682 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1684 e_TextureFontDrawChar(Ch
, FontID
);
1690 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1691 glTranslatef(X
, Y
, 0);
1693 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1695 e_TextureFontDrawChar(Ch
, FontID
);
1701 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1703 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1704 glEnable(GL_TEXTURE_2D
);
1705 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1707 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1709 e_TextureFontPrintChar(X
, Y
, Ch
, FontID
, Shadow
);
1710 glDisable(GL_TEXTURE_2D
);
1711 glDisable(GL_BLEND
);
1714 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
1716 result
:= e_TextureFonts
[FontID
].CharWidth
;
1719 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
;
1720 Shadow
: Boolean = False; Newlines
: Boolean = False);
1722 a
, TX
, TY
, len
: Integer;
1726 if e_NoGraphics
then Exit
;
1727 if Text = '' then Exit
;
1728 if e_TextureFonts
= nil then Exit
;
1729 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1737 len
:= Length(Text);
1739 w
:= e_TextureFonts
[FontID
].CharWidth
;
1740 h
:= e_TextureFonts
[FontID
].CharHeight
;
1742 with e_TextureFonts
[FontID
] do
1744 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1745 glEnable(GL_TEXTURE_2D
);
1748 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1751 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1754 for a
:= 1 to len
do
1768 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1773 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1778 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1783 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1788 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1793 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1798 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1803 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1810 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1815 glDisable(GL_TEXTURE_2D
);
1816 glDisable(GL_BLEND
);
1820 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1821 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1823 if e_NoGraphics
then Exit
;
1824 if Text = '' then Exit
;
1827 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1828 glEnable(GL_TEXTURE_2D
);
1831 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1834 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1839 glColor4ub(0, 0, 0, 128);
1840 glTranslatef(x
+1, y
+1, 0);
1841 glScalef(Scale
, Scale
, 0);
1843 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1845 e_TextureFontDrawString(Text, FontID
);
1851 glColor4ub(Red
, Green
, Blue
, 255);
1852 glTranslatef(x
, y
, 0);
1853 glScalef(Scale
, Scale
, 0);
1855 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1857 e_TextureFontDrawString(Text, FontID
);
1860 glDisable(GL_TEXTURE_2D
);
1862 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1863 glDisable(GL_BLEND
);
1866 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
1870 if e_NoGraphics
then Exit
;
1871 if Integer(ID
) > High(e_TextureFonts
) then
1873 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1874 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1877 procedure e_RemoveAllTextureFont();
1881 if e_NoGraphics
then Exit
;
1882 if e_TextureFonts
= nil then Exit
;
1884 for i
:= 0 to High(e_TextureFonts
) do
1885 if e_TextureFonts
[i
].Base
<> 0 then
1888 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1890 e_TextureFonts
[i
].Base
:= 0;
1893 e_TextureFonts
:= nil;
1896 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1903 function _Point(X
, Y
: Integer): TPoint2i
;
1909 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1913 Result
.Width
:= Width
;
1914 Result
.Height
:= Height
;
1917 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
1926 procedure e_MakeScreenshot (st
: TStream
; Width
, Height
: Word);
1928 pixels
, obuf
, scln
, ps
, pd
: PByte;
1931 i
, x
, y
, res
: Integer;
1932 sign
: array [0..7] of Byte;
1933 hbuf
: array [0..12] of Byte;
1938 if e_NoGraphics
then Exit
;
1941 // first, extract and pack graphics data
1942 if (Width
mod 4) > 0 then Width
:= Width
+4-(Width
mod 4);
1944 GetMem(pixels
, Width
*Height
*3);
1946 FillChar(pixels
^, Width
*Height
*3, 0);
1947 glReadPixels(0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pixels
);
1948 //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
1950 if e_FastScreenshots
then
1953 GetMem(scln
, (Width
*3+1)*Height
);
1957 Inc(ps
, (Width
*3)*(Height
-1));
1958 for i
:= 0 to Height
-1 do
1962 Move(ps
^, pd
^, Width
*3);
1974 obufsize
:= (Width
*3+1)*Height
*2;
1975 GetMem(obuf
, obufsize
);
1980 res
:= compress2(Pointer(obuf
), dlen
, Pointer(pixels
), (Width
*3+1)*Height
, 9);
1981 if res
= Z_OK
then break
;
1982 if res
<> Z_BUF_ERROR
then raise Exception
.Create('can''t pack data for PNG');
1983 obufsize
:= obufsize
*2;
1986 GetMem(obuf
, obufsize
);
1988 //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
2001 st
.writeBuffer(sign
, 8);
2002 //e_WriteLog('PNG: signature written', MSG_NOTIFY);
2005 writeIntBE(st
, LongWord(13));
2010 st
.writeBuffer(sign
, 4);
2011 crc
:= crc32(0, @sign
[0], 4);
2014 hbuf
[2] := (Width
shr 8) and $ff;
2015 hbuf
[3] := Width
and $ff;
2018 hbuf
[6] := (Height
shr 8) and $ff;
2019 hbuf
[7] := Height
and $ff;
2020 hbuf
[8] := 8; // bit depth
2021 hbuf
[9] := 2; // RGB
2022 hbuf
[10] := 0; // compression method
2023 hbuf
[11] := 0; // filter method
2024 hbuf
[12] := 0; // no interlace
2025 crc
:= crc32(crc
, @hbuf
[0], 13);
2026 st
.writeBuffer(hbuf
, 13);
2027 writeIntBE(st
, crc
);
2028 //e_WriteLog('PNG: header written', MSG_NOTIFY);
2031 writeIntBE(st
, LongWord(dlen
));
2036 st
.writeBuffer(sign
, 4);
2037 crc
:= crc32(0, @sign
[0], 4);
2038 crc
:= crc32(crc
, obuf
, dlen
);
2039 st
.writeBuffer(obuf
^, dlen
);
2040 writeIntBE(st
, crc
);
2041 //e_WriteLog('PNG: image data written', MSG_NOTIFY);
2044 writeIntBE(st
, LongWord(0));
2049 st
.writeBuffer(sign
, 4);
2050 crc
:= crc32(0, @sign
[0], 4);
2051 writeIntBE(st
, crc
);
2052 //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
2054 if obuf
<> nil then FreeMem(obuf
);
2059 Imaging
.SetOption(ImagingPNGCompressLevel
, 9);
2060 Imaging
.SetOption(ImagingPNGPreFilter
, 6);
2063 NewImage(Width
, Height
, TImageFormat
.ifR8G8B8
, img
);
2065 //writeln(stderr, 'moving pixels...');
2066 for y
:= Height
-1 downto 0 do
2068 for x
:= 0 to Width
-1 do
2070 clr
.r
:= ps
^; Inc(ps
);
2071 clr
.g
:= ps
^; Inc(ps
);
2072 clr
.b
:= ps
^; Inc(ps
);
2074 SetPixel32(img
, x
, y
, clr
);
2077 GlobalMetadata
.ClearMetaItems();
2078 GlobalMetadata
.ClearMetaItemsForSaving();
2079 //writeln(stderr, 'compressing image...');
2080 if not SaveImageToStream('png', st
, img
) then raise Exception
.Create('screenshot writing error');
2081 //writeln(stderr, 'done!');