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
, g_base
,
26 MAPDEF
, ImagingTypes
, Imaging
, ImagingUtility
;
31 //------------------------------------------------------------------
33 //------------------------------------------------------------------
35 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
36 procedure e_ResizeWindow(Width
, Height
: Integer);
37 function e_ResizeFramebuffer(Width
, Height
: Integer): Boolean;
38 procedure e_BlitFramebuffer(WinWidth
, WinHeight
: Integer);
39 procedure e_SetRenderTarget(Framebuffer
: Boolean);
41 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
42 Blending
: Boolean; Mirror
: TMirrorType
= TMirrorType
.None
);
43 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
44 Blending
: Boolean; Angle
: Single; RC
: PDFPoint
; Mirror
: TMirrorType
= TMirrorType
.None
);
45 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
46 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
47 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
48 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
50 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
51 AlphaChannel
: Boolean; Blending
: Boolean; ambientBlendMode
: Boolean=false);
53 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; alphachannel
: Boolean;
54 blending
: Boolean; scale
: Single; ambientBlendMode
: Boolean=false);
56 procedure e_AmbientQuad (x
, y
, w
, h
: Integer; r
, g
, b
, a
: Byte);
58 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
59 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
60 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
61 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
62 Blending
: TBlending
= TBlending
.None
);
63 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
64 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
66 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
67 function e_CreateTexture(FileName
: string; var ID
: DWORD
): Boolean;
68 function e_CreateTextureEx(FileName
: string; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
69 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
70 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
71 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
72 procedure e_DeleteTexture(ID
: DWORD
);
73 procedure e_RemoveAllTextures();
76 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
77 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
78 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
79 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
80 Color
: TRGB
; Scale
: Single = 1.0);
81 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
82 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
83 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
84 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
85 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
86 procedure e_CharFont_Remove(FontID
: DWORD
);
87 procedure e_CharFont_RemoveAll();
90 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
92 procedure e_TextureFontKill(FontID
: DWORD
);
93 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
94 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
95 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
96 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
;
97 Shadow
: Boolean = False; Newlines
: Boolean = False);
98 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
99 procedure e_RemoveAllTextureFont();
101 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
102 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
104 procedure e_ReleaseEngine();
105 procedure e_BeginRender();
106 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
107 procedure e_Clear(Red
, Green
, Blue
: Single); overload
;
108 procedure e_Clear(); overload
;
109 procedure e_EndRender();
112 function e_GetGamma(win
: PSDL_Window
): Byte;
113 procedure e_SetGamma(win
: PSDL_Window
;Gamma
: Byte);
116 procedure e_MakeScreenshot(st
: TStream
; Width
, Height
: Word);
118 //function e_getTextGLId (ID: DWORD): GLuint;
122 e_NoGraphics
: Boolean = False;
123 e_FastScreenshots
: Boolean = true; // it's REALLY SLOW with `false`
124 g_dbg_scale
: Single = 1.0;
125 r_pixel_scale
: Single = 1.0;
139 TTextureFont
= record
150 Chars
: array[0..255] of
160 TSavedTexture
= record
167 e_Textures
: array of TTexture
= nil;
168 e_TextureFonts
: array of TTextureFont
= nil;
169 e_CharFonts
: array of TCharFont
;
170 //e_SavedTextures: array of TSavedTexture;
173 e_RBOSupported
: Boolean = True;
175 e_FrameW
: Integer = -1;
176 e_FrameH
: Integer = -1;
178 //function e_getTextGLId (ID: DWORD): GLuint; begin result := e_Textures[ID].tx.id; end;
180 //------------------------------------------------------------------
181 // Инициализирует OpenGL
182 //------------------------------------------------------------------
183 procedure e_InitGL();
187 e_DummyTextures
:= True;
193 glDisable(GL_DEPTH_TEST
);
194 glEnable(GL_SCISSOR_TEST
);
195 glClearColor(0, 0, 0, 0);
198 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
200 mat
: Array [0..15] of GLDouble
;
203 if e_NoGraphics
then Exit
;
205 glScissor(X
, Y
, Width
, Height
);
206 glViewport(X
, Y
, Width
, Height
);
207 //gluOrtho2D(0, Width, Height, 0);
209 glMatrixMode(GL_PROJECTION
);
211 mat
[ 0] := 2.0 / Width
;
217 mat
[ 5] := -2.0 / Height
;
231 glLoadMatrixd(@mat
[0]);
233 glMatrixMode(GL_MODELVIEW
);
237 //------------------------------------------------------------------
238 // Ищет свободный элемент в массиве текстур
239 //------------------------------------------------------------------
240 function FindTexture(): DWORD
;
244 if e_Textures
<> nil then
245 for i
:= 0 to High(e_Textures
) do
246 if e_Textures
[i
].tx
.Width
= 0 then
252 if e_Textures
= nil then
254 SetLength(e_Textures
, 32);
259 Result
:= High(e_Textures
) + 1;
260 SetLength(e_Textures
, Length(e_Textures
) + 32);
264 //------------------------------------------------------------------
266 //------------------------------------------------------------------
267 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
274 e_WriteLog('Loading texture from '+FileName
, TMsgType
.Notify
);
276 find_id
:= FindTexture();
278 if not LoadTexture(FileName
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].tx
.Width
,
279 e_Textures
[find_id
].tx
.Height
, @fmt
) then Exit
;
286 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
293 find_id
:= FindTexture();
295 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
302 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
309 find_id
:= FindTexture
;
311 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
;
318 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
325 find_id
:= FindTexture();
327 if not LoadTextureMemEx(pData
, dataSize
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
334 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
340 find_id
:= FindTexture();
341 if not LoadTextureImg(img
, e_Textures
[find_id
].tx
, tw
, th
, @fmt
) then exit
;
346 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
348 if Width
<> nil then Width
^ := e_Textures
[ID
].tx
.Width
;
349 if Height
<> nil then Height
^ := e_Textures
[ID
].tx
.Height
;
352 procedure DestroyFramebuffer
;
354 glBindTexture(GL_TEXTURE_2D
, 0);
355 glBindRenderbuffer(GL_RENDERBUFFER
, 0);
356 glBindFramebuffer(GL_FRAMEBUFFER
, 0);
360 glDeleteTextures(1, @e_Frame
);
366 glDeleteRenderbuffers(1, @e_RBO
);
372 glDeleteFramebuffers(1, @e_FBO
);
377 function e_ResizeFramebuffer(Width
, Height
: Integer): Boolean;
381 if e_NoGraphics
then Exit
;
390 glGenFramebuffers(1, @e_FBO
);
392 if glGetError() <> GL_NO_ERROR
then
394 e_LogWriteln('GL: glGenFramebuffers failed');
398 glGenTextures(1, @e_Frame
);
399 glBindTexture(GL_TEXTURE_2D
, e_Frame
);
400 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGB
, Width
, Height
, 0, GL_RGB
, GL_UNSIGNED_BYTE
, nil);
401 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, GL_NEAREST
);
402 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, GL_NEAREST
);
404 if glGetError() <> GL_NO_ERROR
then
406 e_LogWriteln('GL: can''t create FBO color buffer');
411 glBindFramebuffer(GL_FRAMEBUFFER
, e_FBO
);
412 glFramebufferTexture2D(GL_FRAMEBUFFER
, GL_COLOR_ATTACHMENT0
, GL_TEXTURE_2D
, e_Frame
, 0);
413 if glCheckFramebufferStatus(GL_FRAMEBUFFER
) <> GL_FRAMEBUFFER_COMPLETE
then
415 e_LogWriteln('GL: can''t construct framebuffer with color attachment');
421 if e_RBOSupported
then
423 glGenRenderbuffers(1, @e_RBO
);
424 glBindRenderbuffer(GL_RENDERBUFFER
, e_RBO
);
425 glRenderbufferStorage(GL_RENDERBUFFER
, GL_DEPTH24_STENCIL8
, Width
, Height
);
426 glFramebufferRenderbuffer(GL_FRAMEBUFFER
, GL_DEPTH_STENCIL_ATTACHMENT
, GL_RENDERBUFFER
, e_RBO
);
427 if glCheckFramebufferStatus(GL_FRAMEBUFFER
) <> GL_FRAMEBUFFER_COMPLETE
then
429 e_LogWriteln('GL: can''t construct framebuffer with depth+stencil attachment, trying without');
430 e_RBOSupported
:= False;
431 Result
:= e_ResizeFramebuffer(Width
, Height
);
440 procedure e_ResizeWindow(Width
, Height
: Integer);
444 e_SetViewPort(0, 0, Width
, Height
);
447 procedure drawTxQuad (x0
, y0
, w
, h
, tw
, th
: Integer; u
, v
: single; Mirror
: TMirrorType
);
449 x1
, y1
, tmp
: Integer;
451 if (w
< 1) or (h
< 1) then exit
;
454 if Mirror
= TMirrorType
.Horizontal
then begin tmp
:= x1
; x1
:= x0
; x0
:= tmp
; end
455 else if Mirror
= TMirrorType
.Vertical
then begin tmp
:= y1
; y1
:= y0
; y0
:= tmp
; end;
456 glTexCoord2f(0, v
); glVertex2i(x0
, y0
);
457 glTexCoord2f(0, 0); glVertex2i(x0
, y1
);
458 glTexCoord2f(u
, 0); glVertex2i(x1
, y1
);
459 glTexCoord2f(u
, v
); glVertex2i(x1
, y0
);
462 procedure e_SetRenderTarget(Framebuffer
: Boolean);
464 if (e_FBO
= 0) or e_NoGraphics
then exit
;
466 glBindFramebuffer(GL_FRAMEBUFFER
, e_FBO
)
468 glBindFramebuffer(GL_FRAMEBUFFER
, 0);
471 procedure e_BlitFramebuffer(WinWidth
, WinHeight
: Integer);
473 if (e_FBO
= 0) or (e_Frame
= 0) or e_NoGraphics
then exit
;
476 glEnable(GL_TEXTURE_2D
);
477 glBindTexture(GL_TEXTURE_2D
, e_Frame
);
478 glColor4ub(255, 255, 255, 255);
481 glTexCoord2f(0, 1); glVertex2i( 0, 0);
482 glTexCoord2f(0, 0); glVertex2i( 0, WinHeight
);
483 glTexCoord2f(1, 0); glVertex2i(WinWidth
, WinHeight
);
484 glTexCoord2f(1, 1); glVertex2i(WinWidth
, 0);
488 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
489 Blending
: Boolean; Mirror
: TMirrorType
= TMirrorType
.None
);
491 if e_NoGraphics
then Exit
;
492 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
494 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
499 if (AlphaChannel
) or (Alpha
> 0) then
500 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
503 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
506 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
508 glEnable(GL_TEXTURE_2D
);
509 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
512 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
);
514 //u := e_Textures[ID].tx.u;
515 //v := e_Textures[ID].tx.v;
518 if Mirror = M_NONE then
520 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
521 glTexCoord2f(0, 0); glVertex2i(X, Y);
522 glTexCoord2f(0, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
523 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
526 if Mirror = M_HORIZONTAL then
528 glTexCoord2f(u, 0); glVertex2i(X, Y);
529 glTexCoord2f(0, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
530 glTexCoord2f(0, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
531 glTexCoord2f(u, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
534 if Mirror = M_VERTICAL then
536 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y);
537 glTexCoord2f(0, -v); glVertex2i(X, Y);
538 glTexCoord2f(0, 0); glVertex2i(X, Y + e_Textures[id].tx.Height);
539 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
548 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
549 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
553 if e_NoGraphics
then Exit
;
554 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
556 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
561 if (AlphaChannel
) or (Alpha
> 0) then
562 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
565 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
568 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
570 glEnable(GL_TEXTURE_2D
);
571 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
573 u
:= e_Textures
[ID
].tx
.u
;
574 v
:= e_Textures
[ID
].tx
.v
;
577 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
578 glTexCoord2f(u
, v
); glVertex2i(X
+ Width
, Y
);
579 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
580 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
586 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
587 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
589 if e_NoGraphics
then Exit
;
590 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
592 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
597 if (AlphaChannel
) or (Alpha
> 0) then
598 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
601 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
604 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
606 glEnable(GL_TEXTURE_2D
);
607 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
609 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
);
615 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
616 AlphaChannel
: Boolean; Blending
: Boolean; ambientBlendMode
: Boolean=false);
618 X2
, Y2
, dx
, w
, h
: Integer;
621 if e_NoGraphics
then Exit
;
622 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
623 ambientBlendMode
:= false;
625 if (Alpha
> 0) or AlphaChannel
or Blending
then
631 if not ambientBlendMode
then glDisable(GL_BLEND
);
633 if AlphaChannel
or (Alpha
> 0) then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
634 if (Alpha
> 0) then glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
635 if Blending
then glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
637 if (XCount
= 0) then XCount
:= 1;
638 if (YCount
= 0) then YCount
:= 1;
640 glEnable(GL_TEXTURE_2D
);
641 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
643 X2
:= X
+e_Textures
[ID
].tx
.width
*XCount
;
644 Y2
:= Y
+e_Textures
[ID
].tx
.height
*YCount
;
646 //k8: this SHOULD work... i hope
647 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
650 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
651 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
652 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
653 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
660 u
:= e_Textures
[ID
].tx
.u
;
661 v
:= e_Textures
[ID
].tx
.v
;
662 w
:= e_Textures
[ID
].tx
.width
;
663 h
:= e_Textures
[ID
].tx
.height
;
670 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
671 glTexCoord2f(u
, v
); glVertex2i(X
+w
, Y
);
672 glTexCoord2f(u
, 0); glVertex2i(X
+w
, Y
+h
);
673 glTexCoord2f(0, 0); glVertex2i(X
, Y
+h
);
688 //TODO: overflow checks
689 function intersectRect (var x0
, y0
, w0
, h0
: Integer; const x1
, y1
, w1
, h1
: Integer): Boolean;
694 if (w0
< 1) or (h0
< 1) or (w1
< 1) or (h1
< 1) then exit
;
695 // check for intersection
696 if (x0
+w0
<= x1
) or (y0
+h0
<= y1
) or (x1
+w1
<= x0
) or (y1
+h1
<= y0
) then exit
;
697 if (x0
>= x1
+w1
) or (y0
>= y1
+h1
) or (x1
>= x0
+h0
) or (y1
>= y0
+h0
) then exit
;
701 if (x0
< x1
) then x0
:= x1
;
702 if (y0
< y1
) then y0
:= y1
;
703 if (ex0
> x1
+w1
) then ex0
:= x1
+w1
;
704 if (ey0
> y1
+h1
) then ey0
:= y1
+h1
;
707 result
:= (w0
> 0) and (h0
> 0);
711 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; alphachannel
: Boolean;
712 blending
: Boolean; scale
: Single; ambientBlendMode
: Boolean=false);
717 scxywh: array[0..3] of GLint;
718 vpxywh: array[0..3] of GLint;
720 w
, h
, dw
, cw
, ch
, yofs
: Integer;
721 u
, v
, cu
, cv
: Single;
725 procedure setScissorGLInternal (x, y, w, h: Integer);
727 //if not scallowed then exit;
732 y := vpxywh[3]-(y+h);
733 if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then
735 glScissor(0, 0, 0, 0);
739 //writeln(' (', x, ',', y, ')-(', w, ',', h, ')');
740 glScissor(x, y, w, h);
746 if e_NoGraphics
then exit
;
747 ambientBlendMode
:= false;
749 if (wdt
< 1) or (hgt
< 1) then exit
;
751 if (wdt
mod e_Textures
[ID
].tx
.width
= 0) and (hgt
mod e_Textures
[ID
].tx
.height
= 0) then
753 e_DrawFill(id
, x
, y
, wdt
div e_Textures
[ID
].tx
.width
, hgt
div e_Textures
[ID
].tx
.height
, alpha
, alphachannel
, blending
, ambientBlendMode
);
757 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
759 if (Alpha
> 0) or AlphaChannel
or Blending
then
765 if not ambientBlendMode
then glDisable(GL_BLEND
);
767 if AlphaChannel
or (Alpha
> 0) then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
768 if (Alpha
> 0) then glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
769 if Blending
then glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
771 glEnable(GL_TEXTURE_2D
);
772 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
777 //k8: this SHOULD work... i hope
778 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
781 glTexCoord2f(0, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x
, y
);
782 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x2
, y
);
783 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, 0); glVertex2i(x2
, y2
);
784 glTexCoord2f(0, 0); glVertex2i(x
, y2
);
789 // hard day's night; setup scissor
791 glGetIntegerv(GL_VIEWPORT, @vpxywh[0]);
792 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
793 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
794 //writeln('(', scxywh[0], ',', scxywh[1], ')-(', scxywh[2], ',', scxywh[3], ')');
795 //glEnable(GL_SCISSOR_TEST);
796 setScissorGLInternal(x, y, wdt, hgt);
799 u
:= e_Textures
[ID
].tx
.u
;
800 v
:= e_Textures
[ID
].tx
.v
;
801 w
:= e_Textures
[ID
].tx
.width
;
802 h
:= e_Textures
[ID
].tx
.height
;
804 if (hgt
> h
) then begin y
+= hgt
-h
; onlyOneY
:= false; end else onlyOneY
:= true;
808 if (hgt
>= h
) then begin ch
:= h
; cv
:= v
; yofs
:= 0; end else begin ch
:= hgt
; cv
:= v
/(h
/hgt
); yofs
:= h
-hgt
; end;
809 if onlyOneY
then yofs
:= 0;
815 if (dw
>= w
) then begin cw
:= w
; cu
:= u
; end else begin cw
:= dw
; cu
:= u
/(w
/dw
); end;
817 glTexCoord2f(0, cv
); glVertex2i(X
, Y
+yofs
);
818 glTexCoord2f(cu
, cv
); glVertex2i(X
+cw
, Y
+yofs
);
819 glTexCoord2f(cu
, 0); glVertex2i(X
+cw
, Y
+ch
+yofs
);
820 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ch
+yofs
);
826 //if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
833 procedure e_AmbientQuad (x
, y
, w
, h
: Integer; r
, g
, b
, a
: Byte);
835 if e_NoGraphics
then exit
;
836 if (w
< 1) or (h
< 1) then exit
;
837 if (a
<> 255) or ((r
or g
or b
) <> 0) then
840 glDisable(GL_TEXTURE_2D
);
841 glColor4ub(r
, g
, b
, a
);
842 if ((r
or g
or b
) <> 0) then
844 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
848 glVertex2i(x
+w
, y
+h
);
852 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
856 glVertex2i(x
+w
, y
+h
);
864 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
865 Blending
: Boolean; Angle
: Single; RC
: PDFPoint
; Mirror
: TMirrorType
= TMirrorType
.None
);
867 if e_NoGraphics
then Exit
;
869 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
871 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
876 if (AlphaChannel
) or (Alpha
> 0) then
877 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
880 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
883 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
885 if (Angle
<> 0) and (RC
<> nil) then
888 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
889 glRotatef(Angle
, 0, 0, 1);
890 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
893 glEnable(GL_TEXTURE_2D
);
894 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
895 glBegin(GL_QUADS
); //0-1 1-1
897 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
);
906 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
908 if e_NoGraphics
then Exit
;
909 glDisable(GL_TEXTURE_2D
);
910 glColor3ub(Red
, Green
, Blue
);
913 if (Size
= 2) or (Size
= 4) then
917 glVertex2f(X
+0.3, Y
+1.0);
920 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
923 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
925 // Make lines only top-left/bottom-right and top-right/bottom-left
937 // Pixel-perfect hack
945 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
947 nX1
, nY1
, nX2
, nY2
: Integer;
949 if e_NoGraphics
then Exit
;
950 // Only top-left/bottom-right quad
967 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
972 glDisable(GL_TEXTURE_2D
);
973 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
976 nX1
:= X1
; nY1
:= Y1
;
977 nX2
:= X2
; nY2
:= Y1
;
978 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
979 glVertex2i(nX1
, nY1
);
980 glVertex2i(nX2
, nY2
);
982 nX1
:= X2
; nY1
:= Y1
;
983 nX2
:= X2
; nY2
:= Y2
;
984 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
985 glVertex2i(nX1
, nY1
);
986 glVertex2i(nX2
, nY2
);
988 nX1
:= X2
; nY1
:= Y2
;
989 nX2
:= X1
; nY2
:= Y2
;
990 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
991 glVertex2i(nX1
, nY1
);
992 glVertex2i(nX2
, nY2
);
994 nX1
:= X1
; nY1
:= Y2
;
995 nX2
:= X1
; nY2
:= Y1
;
996 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
997 glVertex2i(nX1
, nY1
);
998 glVertex2i(nX2
, nY2
);
1000 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
= TBlending
.None
);
1007 if e_NoGraphics
then Exit
;
1008 if (Alpha
> 0) or (Blending
<> TBlending
.None
) then
1011 glDisable(GL_BLEND
);
1014 TBlending
.None
: if Alpha
> 0 then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1015 TBlending
.Blend
: glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
1016 TBlending
.Invert
: glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
);
1017 TBlending
.Filter
: glBlendFunc(GL_ZERO
, GL_SRC_COLOR
);
1020 glDisable(GL_TEXTURE_2D
);
1021 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
1033 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1034 glDisable(GL_BLEND
);
1038 // ////////////////////////////////////////////////////////////////////////// //
1039 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
1041 if (a
< 0) then a
:= 0;
1042 if (a
> 255) then a
:= 255;
1044 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
1045 glDisable(GL_TEXTURE_2D
);
1046 glColor4ub(0, 0, 0, Byte(255-a
));
1053 //glRect(x, y, x+w, y+h);
1054 glColor4ub(1, 1, 1, 1);
1055 glDisable(GL_BLEND
);
1056 //glBlendEquation(GL_FUNC_ADD);
1059 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
1061 if (w
> 0) and (h
> 0) then e_DarkenQuad(x
, y
, x
+w
, y
+h
, a
);
1065 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
1067 if e_NoGraphics
then Exit
;
1068 // Pixel-perfect lines
1070 e_LineCorrection(X1
, Y1
, X2
, Y2
);
1075 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1077 glDisable(GL_BLEND
);
1079 glDisable(GL_TEXTURE_2D
);
1080 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
1086 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1088 glDisable(GL_BLEND
);
1091 //------------------------------------------------------------------
1092 // Удаляет текстуру из массива
1093 //------------------------------------------------------------------
1094 procedure e_DeleteTexture(ID
: DWORD
);
1096 if not e_NoGraphics
then
1097 glDeleteTextures(1, @e_Textures
[ID
].tx
.id
);
1098 e_Textures
[ID
].tx
.id
:= 0;
1099 e_Textures
[ID
].tx
.Width
:= 0;
1100 e_Textures
[ID
].tx
.Height
:= 0;
1103 //------------------------------------------------------------------
1104 // Удаляет все текстуры
1105 //------------------------------------------------------------------
1106 procedure e_RemoveAllTextures();
1110 if e_Textures
= nil then Exit
;
1112 for i
:= 0 to High(e_Textures
) do
1113 if e_Textures
[i
].tx
.Width
<> 0 then e_DeleteTexture(i
);
1117 //------------------------------------------------------------------
1119 //------------------------------------------------------------------
1120 procedure e_ReleaseEngine();
1122 e_RemoveAllTextures
;
1123 e_RemoveAllTextureFont
;
1126 procedure e_BeginRender();
1128 if e_NoGraphics
then Exit
;
1129 glEnable(GL_ALPHA_TEST
);
1130 glAlphaFunc(GL_GREATER
, 0.0);
1133 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
1135 if e_NoGraphics
then Exit
;
1136 glClearColor(Red
, Green
, Blue
, 0);
1140 procedure e_Clear(Red
, Green
, Blue
: Single); overload
;
1142 if e_NoGraphics
then Exit
;
1143 glClearColor(Red
, Green
, Blue
, 0);
1144 glClear(GL_COLOR_BUFFER_BIT
);
1147 procedure e_Clear(); overload
;
1149 if e_NoGraphics
then Exit
;
1150 glClearColor(0, 0, 0, 0);
1151 glClear(GL_COLOR_BUFFER_BIT
);
1154 procedure e_EndRender();
1156 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]);
1225 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1229 e_WriteLog('Creating CharFont...', TMsgType
.Notify
);
1233 if e_CharFonts
<> nil then
1234 for i
:= 0 to High(e_CharFonts
) do
1235 if not e_CharFonts
[i
].alive
then
1241 if id
= DWORD(-1) then
1243 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1244 id
:= High(e_CharFonts
);
1247 with e_CharFonts
[id
] do
1249 for i
:= 0 to High(Chars
) do
1263 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1265 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1267 TextureID
:= Texture
;
1272 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1276 if e_NoGraphics
then Exit
;
1277 if Text = '' then Exit
;
1278 if e_CharFonts
= nil then Exit
;
1279 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1281 with e_CharFonts
[FontID
] do
1283 for a
:= 1 to Length(Text) do
1284 with Chars
[Ord(Text[a
])] do
1285 if TextureID
<> -1 then
1287 e_Draw(TextureID
, X
, Y
, 0, True, False);
1288 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1293 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1294 Color
: TRGB
; Scale
: Single = 1.0);
1299 if e_NoGraphics
then Exit
;
1300 if Text = '' then Exit
;
1301 if e_CharFonts
= nil then Exit
;
1302 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1304 with e_CharFonts
[FontID
] do
1306 for a
:= 1 to Length(Text) do
1307 with Chars
[Ord(Text[a
])] do
1308 if TextureID
<> -1 then
1310 if Scale
<> 1.0 then
1313 glScalef(Scale
, Scale
, 0);
1318 e_Draw(TextureID
, X
, Y
, 0, True, False);
1321 if Scale
<> 1.0 then glPopMatrix
;
1323 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1328 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1330 a
, TX
, TY
, len
: Integer;
1334 if e_NoGraphics
then Exit
;
1335 if Text = '' then Exit
;
1336 if e_CharFonts
= nil then Exit
;
1337 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1345 len
:= Length(Text);
1347 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1349 with e_CharFonts
[FontID
] do
1351 for a
:= 1 to len
do
1362 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1367 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1372 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1377 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1382 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1387 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1392 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1397 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1402 with Chars
[Ord(Text[a
])] do
1403 if TextureID
<> -1 then
1407 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1410 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1416 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1424 if Text = '' then Exit
;
1425 if e_CharFonts
= nil then Exit
;
1426 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1428 with e_CharFonts
[FontID
] do
1430 for a
:= 1 to Length(Text) do
1431 with Chars
[Ord(Text[a
])] do
1432 if TextureID
<> -1 then
1434 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1435 e_GetTextureSize(TextureID
, nil, @h2
);
1436 if h2
> h
then h
:= h2
;
1441 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1443 a
, lines
, len
: Integer;
1444 h2
, w2
, tw
, th
: Word;
1451 if Text = '' then Exit
;
1452 if e_CharFonts
= nil then Exit
;
1453 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1456 len
:= Length(Text);
1458 with e_CharFonts
[FontID
] do
1460 for a
:= 1 to len
do
1462 if Text[a
] = #10 then
1465 if w2
> tw
then tw
:= w2
;
1470 with Chars
[Ord(Text[a
])] do
1471 if TextureID
<> -1 then
1473 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1474 e_GetTextureSize(TextureID
, nil, @h2
);
1475 if h2
> th
then th
:= h2
;
1487 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1493 if e_CharFonts
= nil then Exit
;
1494 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1496 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1497 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1500 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1507 if e_CharFonts
= nil then Exit
;
1508 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1510 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1512 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1513 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1515 if h2
> Result
then Result
:= h2
;
1519 procedure e_CharFont_Remove(FontID
: DWORD
);
1523 with e_CharFonts
[FontID
] do
1524 for a
:= 0 to High(Chars
) do
1525 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1527 e_CharFonts
[FontID
].alive
:= False;
1530 procedure e_CharFont_RemoveAll();
1534 if e_CharFonts
= nil then Exit
;
1536 for a
:= 0 to High(e_CharFonts
) do
1537 e_CharFont_Remove(a
);
1542 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1551 if e_NoGraphics
then Exit
;
1552 e_WriteLog('Creating texture font...', TMsgType
.Notify
);
1556 if e_TextureFonts
<> nil then
1557 for i
:= 0 to High(e_TextureFonts
) do
1558 if e_TextureFonts
[i
].Base
= 0 then
1564 if id
= DWORD(-1) then
1566 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1567 id
:= High(e_TextureFonts
);
1570 with e_TextureFonts
[id
] do
1573 Base
:= glGenLists(XCount
*YCount
);
1575 TextureID
:= e_Textures
[Tex
].tx
.id
;
1576 CharWidth
:= (e_Textures
[Tex
].tx
.Width
div XCount
)+Space
;
1577 CharHeight
:= e_Textures
[Tex
].tx
.Height
div YCount
;
1585 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1586 for loop1
:= 0 to XCount
*YCount
-1 do
1588 cx
:= (loop1
mod XCount
)/XCount
;
1589 cy
:= (loop1
div YCount
)/YCount
;
1591 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1593 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1594 glVertex2i(0, e_Textures
[Tex
].tx
.Height
div YCount
);
1596 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1597 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, e_Textures
[Tex
].tx
.Height
div YCount
);
1599 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1600 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, 0);
1602 glTexCoord2f(cx
, 1.0-cy
);
1605 glTranslated((e_Textures
[Tex
].tx
.Width
div XCount
)+Space
, 0, 0);
1613 procedure e_TextureFontKill(FontID
: DWORD
);
1615 if e_NoGraphics
then Exit
;
1617 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1619 e_TextureFonts
[FontID
].Base
:= 0;
1622 {$IFNDEF NOGL_LISTS}
1623 procedure e_TextureFontDrawChar(ch
: Char; FontID
: DWORD
);
1628 Width
, Height
: Integer;
1629 XCount
, YCount
: Integer;
1631 index
:= Ord(ch
) - 32;
1632 Tex
:= e_TextureFonts
[FontID
].Texture
;
1633 Width
:= e_Textures
[Tex
].tx
.Width
;
1634 Height
:= e_Textures
[Tex
].tx
.Height
;
1635 XCount
:= e_TextureFonts
[FontID
].XC
;
1636 YCount
:= e_TextureFonts
[FontID
].YC
;
1637 cx
:= (index
mod XCount
)/XCount
;
1638 cy
:= (index
div YCount
)/YCount
;
1640 glTexCoord2f(cx
, 1 - cy
- 1/YCount
);
1641 glVertex2i(0, Height
div YCount
);
1642 glTexCoord2f(cx
+ 1/XCount
, 1 - cy
- 1/YCount
);
1643 glVertex2i(Width
div XCount
, Height
div YCount
);
1644 glTexCoord2f(cx
+ 1/XCount
, 1 - cy
);
1645 glVertex2i(Width
div XCount
, 0);
1646 glTexCoord2f(cx
, 1 - cy
);
1649 glTranslatef((e_Textures
[Tex
].tx
.Width
div XCount
) + e_TextureFonts
[FontID
].SPC
, 0, 0);
1652 procedure e_TextureFontDrawString(Text: String; FontID
: DWORD
);
1656 for i
:= 1 to High(Text) do
1657 e_TextureFontDrawChar(Text[i
], FontID
);
1661 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1663 if e_NoGraphics
then Exit
;
1664 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1665 if Text = '' then Exit
;
1667 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1670 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1673 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1674 glEnable(GL_TEXTURE_2D
);
1675 glTranslatef(x
, y
, 0);
1677 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1678 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1680 e_TextureFontDrawString(Text, FontID
);
1682 glDisable(GL_TEXTURE_2D
);
1685 glDisable(GL_BLEND
);
1688 // god forgive me for this, but i cannot figure out how to do it without lists
1689 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1691 if e_NoGraphics
then Exit
;
1696 glColor4ub(0, 0, 0, 128);
1697 glTranslatef(X
+1, Y
+1, 0);
1699 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1701 e_TextureFontDrawChar(Ch
, FontID
);
1707 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1708 glTranslatef(X
, Y
, 0);
1710 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1712 e_TextureFontDrawChar(Ch
, FontID
);
1718 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1720 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1721 glEnable(GL_TEXTURE_2D
);
1722 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1724 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1726 e_TextureFontPrintChar(X
, Y
, Ch
, FontID
, Shadow
);
1727 glDisable(GL_TEXTURE_2D
);
1728 glDisable(GL_BLEND
);
1731 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
1733 result
:= e_TextureFonts
[FontID
].CharWidth
;
1736 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
;
1737 Shadow
: Boolean = False; Newlines
: Boolean = False);
1739 a
, TX
, TY
, len
: Integer;
1743 if e_NoGraphics
then Exit
;
1744 if Text = '' then Exit
;
1745 if e_TextureFonts
= nil then Exit
;
1746 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1754 len
:= Length(Text);
1756 w
:= e_TextureFonts
[FontID
].CharWidth
;
1757 h
:= e_TextureFonts
[FontID
].CharHeight
;
1759 with e_TextureFonts
[FontID
] do
1761 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1762 glEnable(GL_TEXTURE_2D
);
1765 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1768 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1771 for a
:= 1 to len
do
1785 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1790 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1795 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1800 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1805 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1810 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1815 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1820 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1827 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1832 glDisable(GL_TEXTURE_2D
);
1833 glDisable(GL_BLEND
);
1837 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1838 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1840 if e_NoGraphics
then Exit
;
1841 if Text = '' then Exit
;
1844 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1845 glEnable(GL_TEXTURE_2D
);
1848 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1851 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1856 glColor4ub(0, 0, 0, 128);
1857 glTranslatef(x
+1, y
+1, 0);
1858 glScalef(Scale
, Scale
, 0);
1860 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1862 e_TextureFontDrawString(Text, FontID
);
1868 glColor4ub(Red
, Green
, Blue
, 255);
1869 glTranslatef(x
, y
, 0);
1870 glScalef(Scale
, Scale
, 0);
1872 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1874 e_TextureFontDrawString(Text, FontID
);
1877 glDisable(GL_TEXTURE_2D
);
1879 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1880 glDisable(GL_BLEND
);
1883 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
1887 if e_NoGraphics
then Exit
;
1888 if Integer(ID
) > High(e_TextureFonts
) then
1890 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1891 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1894 procedure e_RemoveAllTextureFont();
1898 if e_NoGraphics
then Exit
;
1899 if e_TextureFonts
= nil then Exit
;
1901 for i
:= 0 to High(e_TextureFonts
) do
1902 if e_TextureFonts
[i
].Base
<> 0 then
1905 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1907 e_TextureFonts
[i
].Base
:= 0;
1910 e_TextureFonts
:= nil;
1913 procedure e_MakeScreenshot (st
: TStream
; Width
, Height
: Word);
1915 pixels
, obuf
, scln
, ps
, pd
: PByte;
1918 i
, x
, y
, res
: Integer;
1919 sign
: array [0..7] of Byte;
1920 hbuf
: array [0..12] of Byte;
1925 if e_NoGraphics
then Exit
;
1928 // first, extract and pack graphics data
1929 if (Width
mod 4) > 0 then Width
:= Width
+4-(Width
mod 4);
1931 GetMem(pixels
, Width
*Height
*3);
1933 FillChar(pixels
^, Width
*Height
*3, 0);
1934 glReadPixels(0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pixels
);
1935 //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
1937 if e_FastScreenshots
then
1940 GetMem(scln
, (Width
*3+1)*Height
);
1944 Inc(ps
, (Width
*3)*(Height
-1));
1945 for i
:= 0 to Height
-1 do
1949 Move(ps
^, pd
^, Width
*3);
1961 obufsize
:= (Width
*3+1)*Height
*2;
1962 GetMem(obuf
, obufsize
);
1967 res
:= compress2(Pointer(obuf
), dlen
, Pointer(pixels
), (Width
*3+1)*Height
, 9);
1968 if res
= Z_OK
then break
;
1969 if res
<> Z_BUF_ERROR
then raise Exception
.Create('can''t pack data for PNG');
1970 obufsize
:= obufsize
*2;
1973 GetMem(obuf
, obufsize
);
1975 //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
1988 st
.writeBuffer(sign
, 8);
1989 //e_WriteLog('PNG: signature written', MSG_NOTIFY);
1992 writeIntBE(st
, LongWord(13));
1997 st
.writeBuffer(sign
, 4);
1998 crc
:= crc32(0, @sign
[0], 4);
2001 hbuf
[2] := (Width
shr 8) and $ff;
2002 hbuf
[3] := Width
and $ff;
2005 hbuf
[6] := (Height
shr 8) and $ff;
2006 hbuf
[7] := Height
and $ff;
2007 hbuf
[8] := 8; // bit depth
2008 hbuf
[9] := 2; // RGB
2009 hbuf
[10] := 0; // compression method
2010 hbuf
[11] := 0; // filter method
2011 hbuf
[12] := 0; // no interlace
2012 crc
:= crc32(crc
, @hbuf
[0], 13);
2013 st
.writeBuffer(hbuf
, 13);
2014 writeIntBE(st
, crc
);
2015 //e_WriteLog('PNG: header written', MSG_NOTIFY);
2018 writeIntBE(st
, LongWord(dlen
));
2023 st
.writeBuffer(sign
, 4);
2024 crc
:= crc32(0, @sign
[0], 4);
2025 crc
:= crc32(crc
, obuf
, dlen
);
2026 st
.writeBuffer(obuf
^, dlen
);
2027 writeIntBE(st
, crc
);
2028 //e_WriteLog('PNG: image data written', MSG_NOTIFY);
2031 writeIntBE(st
, LongWord(0));
2036 st
.writeBuffer(sign
, 4);
2037 crc
:= crc32(0, @sign
[0], 4);
2038 writeIntBE(st
, crc
);
2039 //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
2041 if obuf
<> nil then FreeMem(obuf
);
2046 Imaging
.SetOption(ImagingPNGCompressLevel
, 9);
2047 Imaging
.SetOption(ImagingPNGPreFilter
, 6);
2050 NewImage(Width
, Height
, TImageFormat
.ifR8G8B8
, img
);
2052 //writeln(stderr, 'moving pixels...');
2053 for y
:= Height
-1 downto 0 do
2055 for x
:= 0 to Width
-1 do
2057 clr
.r
:= ps
^; Inc(ps
);
2058 clr
.g
:= ps
^; Inc(ps
);
2059 clr
.b
:= ps
^; Inc(ps
);
2061 SetPixel32(img
, x
, y
, clr
);
2064 GlobalMetadata
.ClearMetaItems();
2065 GlobalMetadata
.ClearMetaItemsForSaving();
2066 //writeln(stderr, 'compressing image...');
2067 if not SaveImageToStream('png', st
, img
) then raise Exception
.Create('screenshot writing error');
2068 //writeln(stderr, 'done!');