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 function e_ResizeFramebuffer(Width
, Height
: Integer): Boolean;
66 procedure e_BlitFramebuffer(WinWidth
, WinHeight
: Integer);
67 procedure e_SetRenderTarget(Framebuffer
: Boolean);
69 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
70 Blending
: Boolean; Mirror
: TMirrorType
= TMirrorType
.None
);
71 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
72 Blending
: Boolean; Angle
: Single; RC
: PDFPoint
; Mirror
: TMirrorType
= TMirrorType
.None
);
73 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
74 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
75 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
76 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
78 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
79 AlphaChannel
: Boolean; Blending
: Boolean; ambientBlendMode
: Boolean=false);
81 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; alphachannel
: Boolean;
82 blending
: Boolean; scale
: Single; ambientBlendMode
: Boolean=false);
84 procedure e_AmbientQuad (x
, y
, w
, h
: Integer; r
, g
, b
, a
: Byte);
86 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
87 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
88 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
89 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
90 Blending
: TBlending
= TBlending
.None
);
91 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
92 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
94 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
95 function e_CreateTexture(FileName
: string; var ID
: DWORD
): Boolean;
96 function e_CreateTextureEx(FileName
: string; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
97 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
98 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
99 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
100 procedure e_DeleteTexture(ID
: DWORD
);
101 procedure e_RemoveAllTextures();
104 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
105 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
106 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
107 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
108 Color
: TRGB
; Scale
: Single = 1.0);
109 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
110 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
111 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
112 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
113 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
114 procedure e_CharFont_Remove(FontID
: DWORD
);
115 procedure e_CharFont_RemoveAll();
118 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
120 procedure e_TextureFontKill(FontID
: DWORD
);
121 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
122 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
123 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
124 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
;
125 Shadow
: Boolean = False; Newlines
: Boolean = False);
126 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
127 procedure e_RemoveAllTextureFont();
129 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
130 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
132 procedure e_ReleaseEngine();
133 procedure e_BeginRender();
134 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
135 procedure e_Clear(Red
, Green
, Blue
: Single); overload
;
136 procedure e_Clear(); overload
;
137 procedure e_EndRender();
140 function e_GetGamma(win
: PSDL_Window
): Byte;
141 procedure e_SetGamma(win
: PSDL_Window
;Gamma
: Byte);
144 procedure e_MakeScreenshot(st
: TStream
; Width
, Height
: Word);
146 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
147 function _Point(X
, Y
: Integer): TPoint2i
;
148 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
149 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
151 //function e_getTextGLId (ID: DWORD): GLuint;
155 e_NoGraphics
: Boolean = False;
156 e_FastScreenshots
: Boolean = true; // it's REALLY SLOW with `false`
157 g_dbg_scale
: Single = 1.0;
158 r_pixel_scale
: Single = 1.0;
172 TTextureFont
= record
183 Chars
: array[0..255] of
193 TSavedTexture
= record
200 e_Textures
: array of TTexture
= nil;
201 e_TextureFonts
: array of TTextureFont
= nil;
202 e_CharFonts
: array of TCharFont
;
203 //e_SavedTextures: array of TSavedTexture;
206 e_RBOSupported
: Boolean = True;
208 e_FrameW
: Integer = -1;
209 e_FrameH
: Integer = -1;
211 //function e_getTextGLId (ID: DWORD): GLuint; begin result := e_Textures[ID].tx.id; end;
213 //------------------------------------------------------------------
214 // Инициализирует OpenGL
215 //------------------------------------------------------------------
216 procedure e_InitGL();
220 e_DummyTextures
:= True;
226 glDisable(GL_DEPTH_TEST
);
227 glEnable(GL_SCISSOR_TEST
);
228 glClearColor(0, 0, 0, 0);
231 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
233 mat
: Array [0..15] of GLDouble
;
236 if e_NoGraphics
then Exit
;
238 glScissor(X
, Y
, Width
, Height
);
239 glViewport(X
, Y
, Width
, Height
);
240 //gluOrtho2D(0, Width, Height, 0);
242 glMatrixMode(GL_PROJECTION
);
244 mat
[ 0] := 2.0 / Width
;
250 mat
[ 5] := -2.0 / Height
;
264 glLoadMatrixd(@mat
[0]);
266 glMatrixMode(GL_MODELVIEW
);
270 //------------------------------------------------------------------
271 // Ищет свободный элемент в массиве текстур
272 //------------------------------------------------------------------
273 function FindTexture(): DWORD
;
277 if e_Textures
<> nil then
278 for i
:= 0 to High(e_Textures
) do
279 if e_Textures
[i
].tx
.Width
= 0 then
285 if e_Textures
= nil then
287 SetLength(e_Textures
, 32);
292 Result
:= High(e_Textures
) + 1;
293 SetLength(e_Textures
, Length(e_Textures
) + 32);
297 //------------------------------------------------------------------
299 //------------------------------------------------------------------
300 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
307 e_WriteLog('Loading texture from '+FileName
, TMsgType
.Notify
);
309 find_id
:= FindTexture();
311 if not LoadTexture(FileName
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].tx
.Width
,
312 e_Textures
[find_id
].tx
.Height
, @fmt
) then Exit
;
319 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
326 find_id
:= FindTexture();
328 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
335 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
342 find_id
:= FindTexture
;
344 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
;
351 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
358 find_id
:= FindTexture();
360 if not LoadTextureMemEx(pData
, dataSize
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
367 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
373 find_id
:= FindTexture();
374 if not LoadTextureImg(img
, e_Textures
[find_id
].tx
, tw
, th
, @fmt
) then exit
;
379 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
381 if Width
<> nil then Width
^ := e_Textures
[ID
].tx
.Width
;
382 if Height
<> nil then Height
^ := e_Textures
[ID
].tx
.Height
;
385 procedure DestroyFramebuffer
;
387 glBindTexture(GL_TEXTURE_2D
, 0);
388 glBindRenderbuffer(GL_RENDERBUFFER
, 0);
389 glBindFramebuffer(GL_FRAMEBUFFER
, 0);
393 glDeleteTextures(1, @e_Frame
);
399 glDeleteRenderbuffers(1, @e_RBO
);
405 glDeleteFramebuffers(1, @e_FBO
);
410 function e_ResizeFramebuffer(Width
, Height
: Integer): Boolean;
414 if e_NoGraphics
then Exit
;
423 glGenFramebuffers(1, @e_FBO
);
425 if glGetError() <> GL_NO_ERROR
then
427 e_LogWriteln('GL: glGenFramebuffers failed');
431 glGenTextures(1, @e_Frame
);
432 glBindTexture(GL_TEXTURE_2D
, e_Frame
);
433 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGB
, Width
, Height
, 0, GL_RGB
, GL_UNSIGNED_BYTE
, nil);
434 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, GL_NEAREST
);
435 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, GL_NEAREST
);
437 if glGetError() <> GL_NO_ERROR
then
439 e_LogWriteln('GL: can''t create FBO color buffer');
444 glBindFramebuffer(GL_FRAMEBUFFER
, e_FBO
);
445 glFramebufferTexture2D(GL_FRAMEBUFFER
, GL_COLOR_ATTACHMENT0
, GL_TEXTURE_2D
, e_Frame
, 0);
446 if glCheckFramebufferStatus(GL_FRAMEBUFFER
) <> GL_FRAMEBUFFER_COMPLETE
then
448 e_LogWriteln('GL: can''t construct framebuffer with color attachment');
454 if e_RBOSupported
then
456 glGenRenderbuffers(1, @e_RBO
);
457 glBindRenderbuffer(GL_RENDERBUFFER
, e_RBO
);
458 glRenderbufferStorage(GL_RENDERBUFFER
, GL_DEPTH24_STENCIL8
, Width
, Height
);
459 glFramebufferRenderbuffer(GL_FRAMEBUFFER
, GL_DEPTH_STENCIL_ATTACHMENT
, GL_RENDERBUFFER
, e_RBO
);
460 if glCheckFramebufferStatus(GL_FRAMEBUFFER
) <> GL_FRAMEBUFFER_COMPLETE
then
462 e_LogWriteln('GL: can''t construct framebuffer with depth+stencil attachment, trying without');
463 e_RBOSupported
:= False;
464 Result
:= e_ResizeFramebuffer(Width
, Height
);
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 glTexCoord2f(0, v
); glVertex2i(x0
, y0
);
490 glTexCoord2f(0, 0); glVertex2i(x0
, y1
);
491 glTexCoord2f(u
, 0); glVertex2i(x1
, y1
);
492 glTexCoord2f(u
, v
); glVertex2i(x1
, y0
);
495 procedure e_SetRenderTarget(Framebuffer
: Boolean);
497 if (e_FBO
= 0) or e_NoGraphics
then exit
;
499 glBindFramebuffer(GL_FRAMEBUFFER
, e_FBO
)
501 glBindFramebuffer(GL_FRAMEBUFFER
, 0);
504 procedure e_BlitFramebuffer(WinWidth
, WinHeight
: Integer);
506 if (e_FBO
= 0) or (e_Frame
= 0) or e_NoGraphics
then exit
;
509 glEnable(GL_TEXTURE_2D
);
510 glBindTexture(GL_TEXTURE_2D
, e_Frame
);
511 glColor4ub(255, 255, 255, 255);
514 glTexCoord2f(0, 1); glVertex2i( 0, 0);
515 glTexCoord2f(0, 0); glVertex2i( 0, WinHeight
);
516 glTexCoord2f(1, 0); glVertex2i(WinWidth
, WinHeight
);
517 glTexCoord2f(1, 1); glVertex2i(WinWidth
, 0);
521 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
522 Blending
: Boolean; Mirror
: TMirrorType
= TMirrorType
.None
);
524 if e_NoGraphics
then Exit
;
525 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
527 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
532 if (AlphaChannel
) or (Alpha
> 0) then
533 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
536 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
539 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
541 glEnable(GL_TEXTURE_2D
);
542 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
545 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
);
547 //u := e_Textures[ID].tx.u;
548 //v := e_Textures[ID].tx.v;
551 if Mirror = M_NONE then
553 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
554 glTexCoord2f(0, 0); glVertex2i(X, Y);
555 glTexCoord2f(0, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
556 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
559 if Mirror = M_HORIZONTAL then
561 glTexCoord2f(u, 0); glVertex2i(X, Y);
562 glTexCoord2f(0, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
563 glTexCoord2f(0, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
564 glTexCoord2f(u, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
567 if Mirror = M_VERTICAL then
569 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y);
570 glTexCoord2f(0, -v); glVertex2i(X, Y);
571 glTexCoord2f(0, 0); glVertex2i(X, Y + e_Textures[id].tx.Height);
572 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
581 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
582 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
586 if e_NoGraphics
then Exit
;
587 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
589 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
594 if (AlphaChannel
) or (Alpha
> 0) then
595 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
598 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
601 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
603 glEnable(GL_TEXTURE_2D
);
604 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
606 u
:= e_Textures
[ID
].tx
.u
;
607 v
:= e_Textures
[ID
].tx
.v
;
610 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
611 glTexCoord2f(u
, v
); glVertex2i(X
+ Width
, Y
);
612 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
613 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
619 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
620 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
622 if e_NoGraphics
then Exit
;
623 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
625 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
630 if (AlphaChannel
) or (Alpha
> 0) then
631 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
634 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
637 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
639 glEnable(GL_TEXTURE_2D
);
640 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
642 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
);
648 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
649 AlphaChannel
: Boolean; Blending
: Boolean; ambientBlendMode
: Boolean=false);
651 X2
, Y2
, dx
, w
, h
: Integer;
654 if e_NoGraphics
then Exit
;
655 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
656 ambientBlendMode
:= false;
658 if (Alpha
> 0) or AlphaChannel
or Blending
then
664 if not ambientBlendMode
then glDisable(GL_BLEND
);
666 if AlphaChannel
or (Alpha
> 0) then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
667 if (Alpha
> 0) then glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
668 if Blending
then glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
670 if (XCount
= 0) then XCount
:= 1;
671 if (YCount
= 0) then YCount
:= 1;
673 glEnable(GL_TEXTURE_2D
);
674 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
676 X2
:= X
+e_Textures
[ID
].tx
.width
*XCount
;
677 Y2
:= Y
+e_Textures
[ID
].tx
.height
*YCount
;
679 //k8: this SHOULD work... i hope
680 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
683 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
684 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
685 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
686 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
693 u
:= e_Textures
[ID
].tx
.u
;
694 v
:= e_Textures
[ID
].tx
.v
;
695 w
:= e_Textures
[ID
].tx
.width
;
696 h
:= e_Textures
[ID
].tx
.height
;
703 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
704 glTexCoord2f(u
, v
); glVertex2i(X
+w
, Y
);
705 glTexCoord2f(u
, 0); glVertex2i(X
+w
, Y
+h
);
706 glTexCoord2f(0, 0); glVertex2i(X
, Y
+h
);
721 //TODO: overflow checks
722 function intersectRect (var x0
, y0
, w0
, h0
: Integer; const x1
, y1
, w1
, h1
: Integer): Boolean;
727 if (w0
< 1) or (h0
< 1) or (w1
< 1) or (h1
< 1) then exit
;
728 // check for intersection
729 if (x0
+w0
<= x1
) or (y0
+h0
<= y1
) or (x1
+w1
<= x0
) or (y1
+h1
<= y0
) then exit
;
730 if (x0
>= x1
+w1
) or (y0
>= y1
+h1
) or (x1
>= x0
+h0
) or (y1
>= y0
+h0
) then exit
;
734 if (x0
< x1
) then x0
:= x1
;
735 if (y0
< y1
) then y0
:= y1
;
736 if (ex0
> x1
+w1
) then ex0
:= x1
+w1
;
737 if (ey0
> y1
+h1
) then ey0
:= y1
+h1
;
740 result
:= (w0
> 0) and (h0
> 0);
744 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; alphachannel
: Boolean;
745 blending
: Boolean; scale
: Single; ambientBlendMode
: Boolean=false);
750 scxywh: array[0..3] of GLint;
751 vpxywh: array[0..3] of GLint;
753 w
, h
, dw
, cw
, ch
, yofs
: Integer;
754 u
, v
, cu
, cv
: Single;
758 procedure setScissorGLInternal (x, y, w, h: Integer);
760 //if not scallowed then exit;
765 y := vpxywh[3]-(y+h);
766 if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then
768 glScissor(0, 0, 0, 0);
772 //writeln(' (', x, ',', y, ')-(', w, ',', h, ')');
773 glScissor(x, y, w, h);
779 if e_NoGraphics
then exit
;
780 ambientBlendMode
:= false;
782 if (wdt
< 1) or (hgt
< 1) then exit
;
784 if (wdt
mod e_Textures
[ID
].tx
.width
= 0) and (hgt
mod e_Textures
[ID
].tx
.height
= 0) then
786 e_DrawFill(id
, x
, y
, wdt
div e_Textures
[ID
].tx
.width
, hgt
div e_Textures
[ID
].tx
.height
, alpha
, alphachannel
, blending
, ambientBlendMode
);
790 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
792 if (Alpha
> 0) or AlphaChannel
or Blending
then
798 if not ambientBlendMode
then glDisable(GL_BLEND
);
800 if AlphaChannel
or (Alpha
> 0) then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
801 if (Alpha
> 0) then glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
802 if Blending
then glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
804 glEnable(GL_TEXTURE_2D
);
805 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
810 //k8: this SHOULD work... i hope
811 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
814 glTexCoord2f(0, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x
, y
);
815 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x2
, y
);
816 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, 0); glVertex2i(x2
, y2
);
817 glTexCoord2f(0, 0); glVertex2i(x
, y2
);
822 // hard day's night; setup scissor
824 glGetIntegerv(GL_VIEWPORT, @vpxywh[0]);
825 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
826 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
827 //writeln('(', scxywh[0], ',', scxywh[1], ')-(', scxywh[2], ',', scxywh[3], ')');
828 //glEnable(GL_SCISSOR_TEST);
829 setScissorGLInternal(x, y, wdt, hgt);
832 u
:= e_Textures
[ID
].tx
.u
;
833 v
:= e_Textures
[ID
].tx
.v
;
834 w
:= e_Textures
[ID
].tx
.width
;
835 h
:= e_Textures
[ID
].tx
.height
;
837 if (hgt
> h
) then begin y
+= hgt
-h
; onlyOneY
:= false; end else onlyOneY
:= true;
841 if (hgt
>= h
) then begin ch
:= h
; cv
:= v
; yofs
:= 0; end else begin ch
:= hgt
; cv
:= v
/(h
/hgt
); yofs
:= h
-hgt
; end;
842 if onlyOneY
then yofs
:= 0;
848 if (dw
>= w
) then begin cw
:= w
; cu
:= u
; end else begin cw
:= dw
; cu
:= u
/(w
/dw
); end;
850 glTexCoord2f(0, cv
); glVertex2i(X
, Y
+yofs
);
851 glTexCoord2f(cu
, cv
); glVertex2i(X
+cw
, Y
+yofs
);
852 glTexCoord2f(cu
, 0); glVertex2i(X
+cw
, Y
+ch
+yofs
);
853 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ch
+yofs
);
859 //if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
866 procedure e_AmbientQuad (x
, y
, w
, h
: Integer; r
, g
, b
, a
: Byte);
868 if e_NoGraphics
then exit
;
869 if (w
< 1) or (h
< 1) then exit
;
870 if (a
<> 255) or ((r
or g
or b
) <> 0) then
873 glDisable(GL_TEXTURE_2D
);
874 glColor4ub(r
, g
, b
, a
);
875 if ((r
or g
or b
) <> 0) then
877 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
881 glVertex2i(x
+w
, y
+h
);
885 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
889 glVertex2i(x
+w
, y
+h
);
897 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
898 Blending
: Boolean; Angle
: Single; RC
: PDFPoint
; Mirror
: TMirrorType
= TMirrorType
.None
);
900 if e_NoGraphics
then Exit
;
902 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
904 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
909 if (AlphaChannel
) or (Alpha
> 0) then
910 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
913 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
916 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
918 if (Angle
<> 0) and (RC
<> nil) then
921 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
922 glRotatef(Angle
, 0, 0, 1);
923 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
926 glEnable(GL_TEXTURE_2D
);
927 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
928 glBegin(GL_QUADS
); //0-1 1-1
930 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
);
939 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
941 if e_NoGraphics
then Exit
;
942 glDisable(GL_TEXTURE_2D
);
943 glColor3ub(Red
, Green
, Blue
);
946 if (Size
= 2) or (Size
= 4) then
950 glVertex2f(X
+0.3, Y
+1.0);
953 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
956 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
958 // Make lines only top-left/bottom-right and top-right/bottom-left
970 // Pixel-perfect hack
978 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
980 nX1
, nY1
, nX2
, nY2
: Integer;
982 if e_NoGraphics
then Exit
;
983 // Only top-left/bottom-right quad
1000 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1003 glDisable(GL_BLEND
);
1005 glDisable(GL_TEXTURE_2D
);
1006 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
1009 nX1
:= X1
; nY1
:= Y1
;
1010 nX2
:= X2
; nY2
:= Y1
;
1011 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
1012 glVertex2i(nX1
, nY1
);
1013 glVertex2i(nX2
, nY2
);
1015 nX1
:= X2
; nY1
:= Y1
;
1016 nX2
:= X2
; nY2
:= Y2
;
1017 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
1018 glVertex2i(nX1
, nY1
);
1019 glVertex2i(nX2
, nY2
);
1021 nX1
:= X2
; nY1
:= Y2
;
1022 nX2
:= X1
; nY2
:= Y2
;
1023 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
1024 glVertex2i(nX1
, nY1
);
1025 glVertex2i(nX2
, nY2
);
1027 nX1
:= X1
; nY1
:= Y2
;
1028 nX2
:= X1
; nY2
:= Y1
;
1029 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
1030 glVertex2i(nX1
, nY1
);
1031 glVertex2i(nX2
, nY2
);
1033 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1034 glDisable(GL_BLEND
);
1037 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
1038 Blending
: TBlending
= TBlending
.None
);
1040 if e_NoGraphics
then Exit
;
1041 if (Alpha
> 0) or (Blending
<> TBlending
.None
) then
1044 glDisable(GL_BLEND
);
1047 TBlending
.None
: if Alpha
> 0 then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1048 TBlending
.Blend
: glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
1049 TBlending
.Invert
: glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
);
1050 TBlending
.Filter
: glBlendFunc(GL_ZERO
, GL_SRC_COLOR
);
1053 glDisable(GL_TEXTURE_2D
);
1054 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
1066 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1067 glDisable(GL_BLEND
);
1071 // ////////////////////////////////////////////////////////////////////////// //
1072 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
1074 if (a
< 0) then a
:= 0;
1075 if (a
> 255) then a
:= 255;
1077 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
1078 glDisable(GL_TEXTURE_2D
);
1079 glColor4ub(0, 0, 0, Byte(255-a
));
1086 //glRect(x, y, x+w, y+h);
1087 glColor4ub(1, 1, 1, 1);
1088 glDisable(GL_BLEND
);
1089 //glBlendEquation(GL_FUNC_ADD);
1092 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
1094 if (w
> 0) and (h
> 0) then e_DarkenQuad(x
, y
, x
+w
, y
+h
, a
);
1098 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
1100 if e_NoGraphics
then Exit
;
1101 // Pixel-perfect lines
1103 e_LineCorrection(X1
, Y1
, X2
, Y2
);
1108 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1110 glDisable(GL_BLEND
);
1112 glDisable(GL_TEXTURE_2D
);
1113 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
1119 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1121 glDisable(GL_BLEND
);
1124 //------------------------------------------------------------------
1125 // Удаляет текстуру из массива
1126 //------------------------------------------------------------------
1127 procedure e_DeleteTexture(ID
: DWORD
);
1129 if not e_NoGraphics
then
1130 glDeleteTextures(1, @e_Textures
[ID
].tx
.id
);
1131 e_Textures
[ID
].tx
.id
:= 0;
1132 e_Textures
[ID
].tx
.Width
:= 0;
1133 e_Textures
[ID
].tx
.Height
:= 0;
1136 //------------------------------------------------------------------
1137 // Удаляет все текстуры
1138 //------------------------------------------------------------------
1139 procedure e_RemoveAllTextures();
1143 if e_Textures
= nil then Exit
;
1145 for i
:= 0 to High(e_Textures
) do
1146 if e_Textures
[i
].tx
.Width
<> 0 then e_DeleteTexture(i
);
1150 //------------------------------------------------------------------
1152 //------------------------------------------------------------------
1153 procedure e_ReleaseEngine();
1155 e_RemoveAllTextures
;
1156 e_RemoveAllTextureFont
;
1159 procedure e_BeginRender();
1161 if e_NoGraphics
then Exit
;
1162 glEnable(GL_ALPHA_TEST
);
1163 glAlphaFunc(GL_GREATER
, 0.0);
1166 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
1168 if e_NoGraphics
then Exit
;
1169 glClearColor(Red
, Green
, Blue
, 0);
1173 procedure e_Clear(Red
, Green
, Blue
: Single); overload
;
1175 if e_NoGraphics
then Exit
;
1176 glClearColor(Red
, Green
, Blue
, 0);
1177 glClear(GL_COLOR_BUFFER_BIT
);
1180 procedure e_Clear(); overload
;
1182 if e_NoGraphics
then Exit
;
1183 glClearColor(0, 0, 0, 0);
1184 glClear(GL_COLOR_BUFFER_BIT
);
1187 procedure e_EndRender();
1189 if e_NoGraphics
then Exit
;
1194 function e_GetGamma(win
: PSDL_Window
): Byte;
1196 ramp
: array [0..256*3-1] of Word;
1197 rgb
: array [0..2] of Double;
1206 if e_NoGraphics
then Exit
;
1211 SDL_GetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1220 for j
:= min
to max
- 1 do
1223 B
:= (j
mod 256)/256;
1225 sum
:= sum
+ ln(A
)/ln(B
);
1228 rgb
[i
] := sum
/ count
;
1231 Result
:= 100 - Trunc(((rgb
[0] + rgb
[1] + rgb
[2])/3 - 0.23) * 100/(2.7 - 0.23));
1234 procedure e_SetGamma(win
: PSDL_Window
; Gamma
: Byte);
1236 ramp
: array [0..256*3-1] of Word;
1241 if e_NoGraphics
then Exit
;
1242 g
:= (100 - Gamma
)*(2.7 - 0.23)/100 + 0.23;
1244 for i
:= 0 to 255 do
1246 r
:= Exp(g
* ln(i
/256))*65536;
1247 if r
< 0 then r
:= 0
1248 else if r
> 65535 then r
:= 65535;
1249 ramp
[i
] := trunc(r
);
1250 ramp
[i
+ 256] := trunc(r
);
1251 ramp
[i
+ 512] := trunc(r
);
1254 SDL_SetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1258 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1262 e_WriteLog('Creating CharFont...', TMsgType
.Notify
);
1266 if e_CharFonts
<> nil then
1267 for i
:= 0 to High(e_CharFonts
) do
1268 if not e_CharFonts
[i
].alive
then
1274 if id
= DWORD(-1) then
1276 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1277 id
:= High(e_CharFonts
);
1280 with e_CharFonts
[id
] do
1282 for i
:= 0 to High(Chars
) do
1296 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1298 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1300 TextureID
:= Texture
;
1305 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1309 if e_NoGraphics
then Exit
;
1310 if Text = '' then Exit
;
1311 if e_CharFonts
= nil then Exit
;
1312 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1314 with e_CharFonts
[FontID
] do
1316 for a
:= 1 to Length(Text) do
1317 with Chars
[Ord(Text[a
])] do
1318 if TextureID
<> -1 then
1320 e_Draw(TextureID
, X
, Y
, 0, True, False);
1321 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1326 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1327 Color
: TRGB
; Scale
: Single = 1.0);
1332 if e_NoGraphics
then Exit
;
1333 if Text = '' then Exit
;
1334 if e_CharFonts
= nil then Exit
;
1335 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1337 with e_CharFonts
[FontID
] do
1339 for a
:= 1 to Length(Text) do
1340 with Chars
[Ord(Text[a
])] do
1341 if TextureID
<> -1 then
1343 if Scale
<> 1.0 then
1346 glScalef(Scale
, Scale
, 0);
1351 e_Draw(TextureID
, X
, Y
, 0, True, False);
1354 if Scale
<> 1.0 then glPopMatrix
;
1356 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1361 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1363 a
, TX
, TY
, len
: Integer;
1367 if e_NoGraphics
then Exit
;
1368 if Text = '' then Exit
;
1369 if e_CharFonts
= nil then Exit
;
1370 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1378 len
:= Length(Text);
1380 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1382 with e_CharFonts
[FontID
] do
1384 for a
:= 1 to len
do
1395 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1400 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1405 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1410 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1415 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1420 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1425 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1430 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1435 with Chars
[Ord(Text[a
])] do
1436 if TextureID
<> -1 then
1440 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1443 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1449 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1457 if Text = '' then Exit
;
1458 if e_CharFonts
= nil then Exit
;
1459 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1461 with e_CharFonts
[FontID
] do
1463 for a
:= 1 to Length(Text) do
1464 with Chars
[Ord(Text[a
])] do
1465 if TextureID
<> -1 then
1467 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1468 e_GetTextureSize(TextureID
, nil, @h2
);
1469 if h2
> h
then h
:= h2
;
1474 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1476 a
, lines
, len
: Integer;
1477 h2
, w2
, tw
, th
: Word;
1484 if Text = '' then Exit
;
1485 if e_CharFonts
= nil then Exit
;
1486 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1489 len
:= Length(Text);
1491 with e_CharFonts
[FontID
] do
1493 for a
:= 1 to len
do
1495 if Text[a
] = #10 then
1498 if w2
> tw
then tw
:= w2
;
1503 with Chars
[Ord(Text[a
])] do
1504 if TextureID
<> -1 then
1506 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1507 e_GetTextureSize(TextureID
, nil, @h2
);
1508 if h2
> th
then th
:= h2
;
1520 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1526 if e_CharFonts
= nil then Exit
;
1527 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1529 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1530 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1533 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1540 if e_CharFonts
= nil then Exit
;
1541 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1543 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1545 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1546 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1548 if h2
> Result
then Result
:= h2
;
1552 procedure e_CharFont_Remove(FontID
: DWORD
);
1556 with e_CharFonts
[FontID
] do
1557 for a
:= 0 to High(Chars
) do
1558 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1560 e_CharFonts
[FontID
].alive
:= False;
1563 procedure e_CharFont_RemoveAll();
1567 if e_CharFonts
= nil then Exit
;
1569 for a
:= 0 to High(e_CharFonts
) do
1570 e_CharFont_Remove(a
);
1575 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1584 if e_NoGraphics
then Exit
;
1585 e_WriteLog('Creating texture font...', TMsgType
.Notify
);
1589 if e_TextureFonts
<> nil then
1590 for i
:= 0 to High(e_TextureFonts
) do
1591 if e_TextureFonts
[i
].Base
= 0 then
1597 if id
= DWORD(-1) then
1599 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1600 id
:= High(e_TextureFonts
);
1603 with e_TextureFonts
[id
] do
1606 Base
:= glGenLists(XCount
*YCount
);
1608 TextureID
:= e_Textures
[Tex
].tx
.id
;
1609 CharWidth
:= (e_Textures
[Tex
].tx
.Width
div XCount
)+Space
;
1610 CharHeight
:= e_Textures
[Tex
].tx
.Height
div YCount
;
1618 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1619 for loop1
:= 0 to XCount
*YCount
-1 do
1621 cx
:= (loop1
mod XCount
)/XCount
;
1622 cy
:= (loop1
div YCount
)/YCount
;
1624 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1626 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1627 glVertex2i(0, e_Textures
[Tex
].tx
.Height
div YCount
);
1629 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1630 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, e_Textures
[Tex
].tx
.Height
div YCount
);
1632 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1633 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, 0);
1635 glTexCoord2f(cx
, 1.0-cy
);
1638 glTranslated((e_Textures
[Tex
].tx
.Width
div XCount
)+Space
, 0, 0);
1646 procedure e_TextureFontKill(FontID
: DWORD
);
1648 if e_NoGraphics
then Exit
;
1650 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1652 e_TextureFonts
[FontID
].Base
:= 0;
1655 {$IFNDEF NOGL_LISTS}
1656 procedure e_TextureFontDrawChar(ch
: Char; FontID
: DWORD
);
1661 Width
, Height
: Integer;
1662 XCount
, YCount
: Integer;
1664 index
:= Ord(ch
) - 32;
1665 Tex
:= e_TextureFonts
[FontID
].Texture
;
1666 Width
:= e_Textures
[Tex
].tx
.Width
;
1667 Height
:= e_Textures
[Tex
].tx
.Height
;
1668 XCount
:= e_TextureFonts
[FontID
].XC
;
1669 YCount
:= e_TextureFonts
[FontID
].YC
;
1670 cx
:= (index
mod XCount
)/XCount
;
1671 cy
:= (index
div YCount
)/YCount
;
1673 glTexCoord2f(cx
, 1 - cy
- 1/YCount
);
1674 glVertex2i(0, Height
div YCount
);
1675 glTexCoord2f(cx
+ 1/XCount
, 1 - cy
- 1/YCount
);
1676 glVertex2i(Width
div XCount
, Height
div YCount
);
1677 glTexCoord2f(cx
+ 1/XCount
, 1 - cy
);
1678 glVertex2i(Width
div XCount
, 0);
1679 glTexCoord2f(cx
, 1 - cy
);
1682 glTranslatef((e_Textures
[Tex
].tx
.Width
div XCount
) + e_TextureFonts
[FontID
].SPC
, 0, 0);
1685 procedure e_TextureFontDrawString(Text: String; FontID
: DWORD
);
1689 for i
:= 1 to High(Text) do
1690 e_TextureFontDrawChar(Text[i
], FontID
);
1694 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1696 if e_NoGraphics
then Exit
;
1697 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1698 if Text = '' then Exit
;
1700 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1703 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1706 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1707 glEnable(GL_TEXTURE_2D
);
1708 glTranslatef(x
, y
, 0);
1710 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1711 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1713 e_TextureFontDrawString(Text, FontID
);
1715 glDisable(GL_TEXTURE_2D
);
1718 glDisable(GL_BLEND
);
1721 // god forgive me for this, but i cannot figure out how to do it without lists
1722 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1724 if e_NoGraphics
then Exit
;
1729 glColor4ub(0, 0, 0, 128);
1730 glTranslatef(X
+1, Y
+1, 0);
1732 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1734 e_TextureFontDrawChar(Ch
, FontID
);
1740 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1741 glTranslatef(X
, Y
, 0);
1743 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1745 e_TextureFontDrawChar(Ch
, FontID
);
1751 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1753 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1754 glEnable(GL_TEXTURE_2D
);
1755 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1757 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1759 e_TextureFontPrintChar(X
, Y
, Ch
, FontID
, Shadow
);
1760 glDisable(GL_TEXTURE_2D
);
1761 glDisable(GL_BLEND
);
1764 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
1766 result
:= e_TextureFonts
[FontID
].CharWidth
;
1769 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
;
1770 Shadow
: Boolean = False; Newlines
: Boolean = False);
1772 a
, TX
, TY
, len
: Integer;
1776 if e_NoGraphics
then Exit
;
1777 if Text = '' then Exit
;
1778 if e_TextureFonts
= nil then Exit
;
1779 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1787 len
:= Length(Text);
1789 w
:= e_TextureFonts
[FontID
].CharWidth
;
1790 h
:= e_TextureFonts
[FontID
].CharHeight
;
1792 with e_TextureFonts
[FontID
] do
1794 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1795 glEnable(GL_TEXTURE_2D
);
1798 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1801 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1804 for a
:= 1 to len
do
1818 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1823 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1828 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1833 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1838 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1843 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1848 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1853 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1860 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1865 glDisable(GL_TEXTURE_2D
);
1866 glDisable(GL_BLEND
);
1870 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1871 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1873 if e_NoGraphics
then Exit
;
1874 if Text = '' then Exit
;
1877 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1878 glEnable(GL_TEXTURE_2D
);
1881 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1884 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1889 glColor4ub(0, 0, 0, 128);
1890 glTranslatef(x
+1, y
+1, 0);
1891 glScalef(Scale
, Scale
, 0);
1893 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1895 e_TextureFontDrawString(Text, FontID
);
1901 glColor4ub(Red
, Green
, Blue
, 255);
1902 glTranslatef(x
, y
, 0);
1903 glScalef(Scale
, Scale
, 0);
1905 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1907 e_TextureFontDrawString(Text, FontID
);
1910 glDisable(GL_TEXTURE_2D
);
1912 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1913 glDisable(GL_BLEND
);
1916 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
1920 if e_NoGraphics
then Exit
;
1921 if Integer(ID
) > High(e_TextureFonts
) then
1923 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1924 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1927 procedure e_RemoveAllTextureFont();
1931 if e_NoGraphics
then Exit
;
1932 if e_TextureFonts
= nil then Exit
;
1934 for i
:= 0 to High(e_TextureFonts
) do
1935 if e_TextureFonts
[i
].Base
<> 0 then
1938 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1940 e_TextureFonts
[i
].Base
:= 0;
1943 e_TextureFonts
:= nil;
1946 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1953 function _Point(X
, Y
: Integer): TPoint2i
;
1959 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1963 Result
.Width
:= Width
;
1964 Result
.Height
:= Height
;
1967 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
1976 procedure e_MakeScreenshot (st
: TStream
; Width
, Height
: Word);
1978 pixels
, obuf
, scln
, ps
, pd
: PByte;
1981 i
, x
, y
, res
: Integer;
1982 sign
: array [0..7] of Byte;
1983 hbuf
: array [0..12] of Byte;
1988 if e_NoGraphics
then Exit
;
1991 // first, extract and pack graphics data
1992 if (Width
mod 4) > 0 then Width
:= Width
+4-(Width
mod 4);
1994 GetMem(pixels
, Width
*Height
*3);
1996 FillChar(pixels
^, Width
*Height
*3, 0);
1997 glReadPixels(0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pixels
);
1998 //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
2000 if e_FastScreenshots
then
2003 GetMem(scln
, (Width
*3+1)*Height
);
2007 Inc(ps
, (Width
*3)*(Height
-1));
2008 for i
:= 0 to Height
-1 do
2012 Move(ps
^, pd
^, Width
*3);
2024 obufsize
:= (Width
*3+1)*Height
*2;
2025 GetMem(obuf
, obufsize
);
2030 res
:= compress2(Pointer(obuf
), dlen
, Pointer(pixels
), (Width
*3+1)*Height
, 9);
2031 if res
= Z_OK
then break
;
2032 if res
<> Z_BUF_ERROR
then raise Exception
.Create('can''t pack data for PNG');
2033 obufsize
:= obufsize
*2;
2036 GetMem(obuf
, obufsize
);
2038 //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
2051 st
.writeBuffer(sign
, 8);
2052 //e_WriteLog('PNG: signature written', MSG_NOTIFY);
2055 writeIntBE(st
, LongWord(13));
2060 st
.writeBuffer(sign
, 4);
2061 crc
:= crc32(0, @sign
[0], 4);
2064 hbuf
[2] := (Width
shr 8) and $ff;
2065 hbuf
[3] := Width
and $ff;
2068 hbuf
[6] := (Height
shr 8) and $ff;
2069 hbuf
[7] := Height
and $ff;
2070 hbuf
[8] := 8; // bit depth
2071 hbuf
[9] := 2; // RGB
2072 hbuf
[10] := 0; // compression method
2073 hbuf
[11] := 0; // filter method
2074 hbuf
[12] := 0; // no interlace
2075 crc
:= crc32(crc
, @hbuf
[0], 13);
2076 st
.writeBuffer(hbuf
, 13);
2077 writeIntBE(st
, crc
);
2078 //e_WriteLog('PNG: header written', MSG_NOTIFY);
2081 writeIntBE(st
, LongWord(dlen
));
2086 st
.writeBuffer(sign
, 4);
2087 crc
:= crc32(0, @sign
[0], 4);
2088 crc
:= crc32(crc
, obuf
, dlen
);
2089 st
.writeBuffer(obuf
^, dlen
);
2090 writeIntBE(st
, crc
);
2091 //e_WriteLog('PNG: image data written', MSG_NOTIFY);
2094 writeIntBE(st
, LongWord(0));
2099 st
.writeBuffer(sign
, 4);
2100 crc
:= crc32(0, @sign
[0], 4);
2101 writeIntBE(st
, crc
);
2102 //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
2104 if obuf
<> nil then FreeMem(obuf
);
2109 Imaging
.SetOption(ImagingPNGCompressLevel
, 9);
2110 Imaging
.SetOption(ImagingPNGPreFilter
, 6);
2113 NewImage(Width
, Height
, TImageFormat
.ifR8G8B8
, img
);
2115 //writeln(stderr, 'moving pixels...');
2116 for y
:= Height
-1 downto 0 do
2118 for x
:= 0 to Width
-1 do
2120 clr
.r
:= ps
^; Inc(ps
);
2121 clr
.g
:= ps
^; Inc(ps
);
2122 clr
.b
:= ps
^; Inc(ps
);
2124 SetPixel32(img
, x
, y
, clr
);
2127 GlobalMetadata
.ClearMetaItems();
2128 GlobalMetadata
.ClearMetaItemsForSaving();
2129 //writeln(stderr, 'compressing image...');
2130 if not SaveImageToStream('png', st
, img
) then raise Exception
.Create('screenshot writing error');
2131 //writeln(stderr, 'done!');