1 (* Copyright (C) Doom 2D: Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE ../shared/a_modes.inc}
22 {$INCLUDE ../nogl/noGLuses.inc}
23 SysUtils
, Classes
, Math
, e_log
, e_texture
, SDL2
, MAPDEF
, ImagingTypes
, Imaging
, ImagingUtility
;
26 TMirrorType
=(None
, Horizontal
, Vertical
);
27 TBlending
=(None
, Blend
, Filter
, Invert
);
38 Left
, Top
, Right
, Bottom
: Integer;
56 //------------------------------------------------------------------
58 //------------------------------------------------------------------
60 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
61 procedure e_ResizeWindow(Width
, Height
: Integer);
63 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
64 Blending
: Boolean; Mirror
: TMirrorType
= TMirrorType
.None
);
65 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
66 Blending
: Boolean; Angle
: Single; RC
: PDFPoint
; Mirror
: TMirrorType
= TMirrorType
.None
);
67 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
68 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
69 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
70 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
72 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
73 AlphaChannel
: Boolean; Blending
: Boolean; ambientBlendMode
: Boolean=false);
75 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; alphachannel
: Boolean;
76 blending
: Boolean; scale
: Single; ambientBlendMode
: Boolean=false);
78 procedure e_AmbientQuad (x
, y
, w
, h
: Integer; r
, g
, b
, a
: Byte);
80 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
81 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
82 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
83 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
84 Blending
: TBlending
= TBlending
.None
);
85 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
86 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
88 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
89 function e_CreateTexture(FileName
: string; var ID
: DWORD
): Boolean;
90 function e_CreateTextureEx(FileName
: string; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
91 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
92 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
93 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
94 procedure e_DeleteTexture(ID
: DWORD
);
95 procedure e_RemoveAllTextures();
98 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
99 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
100 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
101 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
102 Color
: TRGB
; Scale
: Single = 1.0);
103 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
104 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
105 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
106 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
107 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
108 procedure e_CharFont_Remove(FontID
: DWORD
);
109 procedure e_CharFont_RemoveAll();
112 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
114 procedure e_TextureFontKill(FontID
: DWORD
);
115 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
116 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
117 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
118 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
;
119 Shadow
: Boolean = False; Newlines
: Boolean = False);
120 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
121 procedure e_RemoveAllTextureFont();
123 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
124 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
126 procedure e_ReleaseEngine();
127 procedure e_BeginRender();
128 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
129 procedure e_Clear(); overload
;
130 procedure e_EndRender();
132 function e_GetGamma(win
: PSDL_Window
): Byte;
133 procedure e_SetGamma(win
: PSDL_Window
;Gamma
: Byte);
135 procedure e_MakeScreenshot(st
: TStream
; Width
, Height
: Word);
137 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
138 function _Point(X
, Y
: Integer): TPoint2i
;
139 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
140 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
142 //function e_getTextGLId (ID: DWORD): GLuint;
146 e_NoGraphics
: Boolean = False;
147 e_FastScreenshots
: Boolean = true; // it's REALLY SLOW with `false`
148 g_dbg_scale
: Single = 1.0;
162 TTextureFont
= record
173 Chars
: array[0..255] of
183 TSavedTexture
= record
190 e_Textures
: array of TTexture
= nil;
191 e_TextureFonts
: array of TTextureFont
= nil;
192 e_CharFonts
: array of TCharFont
;
193 //e_SavedTextures: array of TSavedTexture;
195 //function e_getTextGLId (ID: DWORD): GLuint; begin result := e_Textures[ID].tx.id; end;
197 //------------------------------------------------------------------
198 // Èíèöèàëèçèðóåò OpenGL
199 //------------------------------------------------------------------
200 procedure e_InitGL();
204 e_DummyTextures
:= True;
210 glDisable(GL_DEPTH_TEST
);
211 glEnable(GL_SCISSOR_TEST
);
212 glClearColor(0, 0, 0, 0);
215 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
217 mat
: Array [0..15] of GLDouble
;
220 if e_NoGraphics
then Exit
;
222 glScissor(X
, Y
, Width
, Height
);
223 glViewport(X
, Y
, Width
, Height
);
224 //gluOrtho2D(0, Width, Height, 0);
226 glMatrixMode(GL_PROJECTION
);
228 mat
[ 0] := 2.0 / Width
;
234 mat
[ 5] := -2.0 / Height
;
248 glLoadMatrixd(@mat
[0]);
250 glMatrixMode(GL_MODELVIEW
);
254 //------------------------------------------------------------------
255 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
256 //------------------------------------------------------------------
257 function FindTexture(): DWORD
;
261 if e_Textures
<> nil then
262 for i
:= 0 to High(e_Textures
) do
263 if e_Textures
[i
].tx
.Width
= 0 then
269 if e_Textures
= nil then
271 SetLength(e_Textures
, 32);
276 Result
:= High(e_Textures
) + 1;
277 SetLength(e_Textures
, Length(e_Textures
) + 32);
281 //------------------------------------------------------------------
283 //------------------------------------------------------------------
284 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
291 e_WriteLog('Loading texture from '+FileName
, TMsgType
.Notify
);
293 find_id
:= FindTexture();
295 if not LoadTexture(FileName
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].tx
.Width
,
296 e_Textures
[find_id
].tx
.Height
, @fmt
) then Exit
;
303 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
310 find_id
:= FindTexture();
312 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
319 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
326 find_id
:= FindTexture
;
328 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
;
335 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
342 find_id
:= FindTexture();
344 if not LoadTextureMemEx(pData
, dataSize
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
351 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
357 find_id
:= FindTexture();
358 if not LoadTextureImg(img
, e_Textures
[find_id
].tx
, tw
, th
, @fmt
) then exit
;
363 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
365 if Width
<> nil then Width
^ := e_Textures
[ID
].tx
.Width
;
366 if Height
<> nil then Height
^ := e_Textures
[ID
].tx
.Height
;
369 procedure e_ResizeWindow(Width
, Height
: Integer);
373 e_SetViewPort(0, 0, Width
, Height
);
376 procedure drawTxQuad (x0
, y0
, w
, h
, tw
, th
: Integer; u
, v
: single; Mirror
: TMirrorType
);
378 x1
, y1
, tmp
: Integer;
380 if (w
< 1) or (h
< 1) then exit
;
383 if Mirror
= TMirrorType
.Horizontal
then begin tmp
:= x1
; x1
:= x0
; x0
:= tmp
; end
384 else if Mirror
= TMirrorType
.Vertical
then begin tmp
:= y1
; y1
:= y0
; y0
:= tmp
; end;
385 //HACK: make texture one pixel shorter, so it won't wrap
386 if (g_dbg_scale
<> 1.0) then
391 glTexCoord2f(0, v
); glVertex2i(x0
, y0
);
392 glTexCoord2f(0, 0); glVertex2i(x0
, y1
);
393 glTexCoord2f(u
, 0); glVertex2i(x1
, y1
);
394 glTexCoord2f(u
, v
); glVertex2i(x1
, y0
);
397 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
398 Blending
: Boolean; Mirror
: TMirrorType
= TMirrorType
.None
);
400 if e_NoGraphics
then Exit
;
401 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
403 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
408 if (AlphaChannel
) or (Alpha
> 0) then
409 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
412 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
415 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
417 glEnable(GL_TEXTURE_2D
);
418 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
421 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
);
423 //u := e_Textures[ID].tx.u;
424 //v := e_Textures[ID].tx.v;
427 if Mirror = M_NONE then
429 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
430 glTexCoord2f(0, 0); glVertex2i(X, Y);
431 glTexCoord2f(0, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
432 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
435 if Mirror = M_HORIZONTAL then
437 glTexCoord2f(u, 0); glVertex2i(X, Y);
438 glTexCoord2f(0, 0); glVertex2i(X + e_Textures[id].tx.Width, Y);
439 glTexCoord2f(0, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
440 glTexCoord2f(u, -v); glVertex2i(X, Y + e_Textures[id].tx.Height);
443 if Mirror = M_VERTICAL then
445 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y);
446 glTexCoord2f(0, -v); glVertex2i(X, Y);
447 glTexCoord2f(0, 0); glVertex2i(X, Y + e_Textures[id].tx.Height);
448 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
457 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
458 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
462 if e_NoGraphics
then Exit
;
463 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
465 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
470 if (AlphaChannel
) or (Alpha
> 0) then
471 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
474 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
477 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
479 glEnable(GL_TEXTURE_2D
);
480 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
482 u
:= e_Textures
[ID
].tx
.u
;
483 v
:= e_Textures
[ID
].tx
.v
;
486 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
487 glTexCoord2f(u
, v
); glVertex2i(X
+ Width
, Y
);
488 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
489 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
495 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
496 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= TMirrorType
.None
);
498 if e_NoGraphics
then Exit
;
499 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
501 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
506 if (AlphaChannel
) or (Alpha
> 0) then
507 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
510 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
513 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
515 glEnable(GL_TEXTURE_2D
);
516 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
518 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
);
524 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
525 AlphaChannel
: Boolean; Blending
: Boolean; ambientBlendMode
: Boolean=false);
527 X2
, Y2
, dx
, w
, h
: Integer;
530 if e_NoGraphics
then Exit
;
531 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
532 ambientBlendMode
:= false;
534 if (Alpha
> 0) or AlphaChannel
or Blending
then
540 if not ambientBlendMode
then glDisable(GL_BLEND
);
542 if AlphaChannel
or (Alpha
> 0) then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
543 if (Alpha
> 0) then glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
544 if Blending
then glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
546 if (XCount
= 0) then XCount
:= 1;
547 if (YCount
= 0) then YCount
:= 1;
549 glEnable(GL_TEXTURE_2D
);
550 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
552 X2
:= X
+e_Textures
[ID
].tx
.width
*XCount
;
553 Y2
:= Y
+e_Textures
[ID
].tx
.height
*YCount
;
555 //k8: this SHOULD work... i hope
556 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
559 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
560 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
561 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
562 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
569 u
:= e_Textures
[ID
].tx
.u
;
570 v
:= e_Textures
[ID
].tx
.v
;
571 w
:= e_Textures
[ID
].tx
.width
;
572 h
:= e_Textures
[ID
].tx
.height
;
579 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
580 glTexCoord2f(u
, v
); glVertex2i(X
+w
, Y
);
581 glTexCoord2f(u
, 0); glVertex2i(X
+w
, Y
+h
);
582 glTexCoord2f(0, 0); glVertex2i(X
, Y
+h
);
597 //TODO: overflow checks
598 function intersectRect (var x0
, y0
, w0
, h0
: Integer; const x1
, y1
, w1
, h1
: Integer): Boolean;
603 if (w0
< 1) or (h0
< 1) or (w1
< 1) or (h1
< 1) then exit
;
604 // check for intersection
605 if (x0
+w0
<= x1
) or (y0
+h0
<= y1
) or (x1
+w1
<= x0
) or (y1
+h1
<= y0
) then exit
;
606 if (x0
>= x1
+w1
) or (y0
>= y1
+h1
) or (x1
>= x0
+h0
) or (y1
>= y0
+h0
) then exit
;
610 if (x0
< x1
) then x0
:= x1
;
611 if (y0
< y1
) then y0
:= y1
;
612 if (ex0
> x1
+w1
) then ex0
:= x1
+w1
;
613 if (ey0
> y1
+h1
) then ey0
:= y1
+h1
;
616 result
:= (w0
> 0) and (h0
> 0);
620 procedure e_DrawFillX (id
: DWORD
; x
, y
, wdt
, hgt
: Integer; alpha
: Integer; alphachannel
: Boolean;
621 blending
: Boolean; scale
: Single; ambientBlendMode
: Boolean=false);
626 scxywh: array[0..3] of GLint;
627 vpxywh: array[0..3] of GLint;
629 w
, h
, dw
, cw
, ch
, yofs
: Integer;
630 u
, v
, cu
, cv
: Single;
634 procedure setScissorGLInternal (x, y, w, h: Integer);
636 //if not scallowed then exit;
641 y := vpxywh[3]-(y+h);
642 if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then
644 glScissor(0, 0, 0, 0);
648 //writeln(' (', x, ',', y, ')-(', w, ',', h, ')');
649 glScissor(x, y, w, h);
655 if e_NoGraphics
then exit
;
656 ambientBlendMode
:= false;
658 if (wdt
< 1) or (hgt
< 1) then exit
;
660 if (wdt
mod e_Textures
[ID
].tx
.width
= 0) and (hgt
mod e_Textures
[ID
].tx
.height
= 0) then
662 e_DrawFill(id
, x
, y
, wdt
div e_Textures
[ID
].tx
.width
, hgt
div e_Textures
[ID
].tx
.height
, alpha
, alphachannel
, blending
, ambientBlendMode
);
666 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
668 if (Alpha
> 0) or AlphaChannel
or Blending
then
674 if not ambientBlendMode
then glDisable(GL_BLEND
);
676 if AlphaChannel
or (Alpha
> 0) then glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
677 if (Alpha
> 0) then glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
678 if Blending
then glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
680 glEnable(GL_TEXTURE_2D
);
681 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
686 //k8: this SHOULD work... i hope
687 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
690 glTexCoord2f(0, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x
, y
);
691 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, hgt
/e_Textures
[ID
].tx
.height
); glVertex2i(x2
, y
);
692 glTexCoord2f(wdt
/e_Textures
[ID
].tx
.width
, 0); glVertex2i(x2
, y2
);
693 glTexCoord2f(0, 0); glVertex2i(x
, y2
);
698 // hard day's night; setup scissor
700 glGetIntegerv(GL_VIEWPORT, @vpxywh[0]);
701 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
702 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
703 //writeln('(', scxywh[0], ',', scxywh[1], ')-(', scxywh[2], ',', scxywh[3], ')');
704 //glEnable(GL_SCISSOR_TEST);
705 setScissorGLInternal(x, y, wdt, hgt);
708 u
:= e_Textures
[ID
].tx
.u
;
709 v
:= e_Textures
[ID
].tx
.v
;
710 w
:= e_Textures
[ID
].tx
.width
;
711 h
:= e_Textures
[ID
].tx
.height
;
713 if (hgt
> h
) then begin y
+= hgt
-h
; onlyOneY
:= false; end else onlyOneY
:= true;
717 if (hgt
>= h
) then begin ch
:= h
; cv
:= v
; yofs
:= 0; end else begin ch
:= hgt
; cv
:= v
/(h
/hgt
); yofs
:= h
-hgt
; end;
718 if onlyOneY
then yofs
:= 0;
724 if (dw
>= w
) then begin cw
:= w
; cu
:= u
; end else begin cw
:= dw
; cu
:= u
/(w
/dw
); end;
726 glTexCoord2f(0, cv
); glVertex2i(X
, Y
+yofs
);
727 glTexCoord2f(cu
, cv
); glVertex2i(X
+cw
, Y
+yofs
);
728 glTexCoord2f(cu
, 0); glVertex2i(X
+cw
, Y
+ch
+yofs
);
729 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ch
+yofs
);
735 //if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
742 procedure e_AmbientQuad (x
, y
, w
, h
: Integer; r
, g
, b
, a
: Byte);
744 if e_NoGraphics
then exit
;
745 if (w
< 1) or (h
< 1) then exit
;
746 if (a
<> 255) or ((r
or g
or b
) <> 0) then
749 glDisable(GL_TEXTURE_2D
);
750 glColor4ub(r
, g
, b
, a
);
751 if ((r
or g
or b
) <> 0) then
753 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
757 glVertex2i(x
+w
, y
+h
);
761 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
765 glVertex2i(x
+w
, y
+h
);
773 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
774 Blending
: Boolean; Angle
: Single; RC
: PDFPoint
; Mirror
: TMirrorType
= TMirrorType
.None
);
776 if e_NoGraphics
then Exit
;
778 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
780 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
785 if (AlphaChannel
) or (Alpha
> 0) then
786 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
789 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
792 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
794 if (Angle
<> 0) and (RC
<> nil) then
797 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
798 glRotatef(Angle
, 0, 0, 1);
799 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
802 glEnable(GL_TEXTURE_2D
);
803 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
804 glBegin(GL_QUADS
); //0-1 1-1
806 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
);
815 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
817 if e_NoGraphics
then Exit
;
818 glDisable(GL_TEXTURE_2D
);
819 glColor3ub(Red
, Green
, Blue
);
822 if (Size
= 2) or (Size
= 4) then
826 glVertex2f(X
+0.3, Y
+1.0);
829 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
832 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
834 // Make lines only top-left/bottom-right and top-right/bottom-left
846 // Pixel-perfect hack
854 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
856 nX1
, nY1
, nX2
, nY2
: Integer;
858 v
: array [0..15] of GLfloat
;
861 if e_NoGraphics
then Exit
;
862 // Only top-left/bottom-right quad
879 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
883 glDisable(GL_TEXTURE_2D
);
884 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
887 nX1
:= X1
; nY1
:= Y1
;
888 nX2
:= X2
; nY2
:= Y1
;
889 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
890 v
[0] := nX1
; v
[1] := nY1
; v
[2] := nX2
; v
[3] := nY2
;
892 nX1
:= X2
; nY1
:= Y1
;
893 nX2
:= X2
; nY2
:= Y2
;
894 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
895 v
[4] := nX1
; v
[5] := nY1
; v
[6] := nX2
; v
[7] := nY2
;
897 nX1
:= X2
; nY1
:= Y2
;
898 nX2
:= X1
; nY2
:= Y2
;
899 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
900 v
[8] := nX1
; v
[9] := nY1
; v
[10] := nX2
; v
[11] := nY2
;
902 nX1
:= X1
; nY1
:= Y2
;
903 nX2
:= X1
; nY2
:= Y1
;
904 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
905 v
[12] := nX1
; v
[13] := nY1
; v
[14] := nX2
; v
[15] := nY2
;
907 glVertexPointer(2, GL_FLOAT
, 0, @v
[0]);
908 glEnableClientState(GL_VERTEX_ARRAY
);
909 glDisableClientState(GL_COLOR_ARRAY
);
910 glDisableClientState(GL_NORMAL_ARRAY
);
911 glDisableClientState(GL_TEXTURE_COORD_ARRAY
);
912 glDrawArrays(GL_LINES
, 0, 16);
915 nX1
:= X1
; nY1
:= Y1
;
916 nX2
:= X2
; nY2
:= Y1
;
917 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
918 glVertex2i(nX1
, nY1
);
919 glVertex2i(nX2
, nY2
);
921 nX1
:= X2
; nY1
:= Y1
;
922 nX2
:= X2
; nY2
:= Y2
;
923 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
924 glVertex2i(nX1
, nY1
);
925 glVertex2i(nX2
, nY2
);
927 nX1
:= X2
; nY1
:= Y2
;
928 nX2
:= X1
; nY2
:= Y2
;
929 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
930 glVertex2i(nX1
, nY1
);
931 glVertex2i(nX2
, nY2
);
933 nX1
:= X1
; nY1
:= Y2
;
934 nX2
:= X1
; nY2
:= Y1
;
935 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
936 glVertex2i(nX1
, nY1
);
937 glVertex2i(nX2
, nY2
);
941 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
946 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
947 Blending
: TBlending
= TBlending
.None
);
949 if e_NoGraphics
then Exit
;
950 if (Alpha
> 0) or (Blending
<> TBlending
.None
) then
955 if Blending
= TBlending
.Blend
then
956 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
958 if Blending
= TBlending
.Filter
then
959 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
961 if Blending
= TBlending
.Invert
then
962 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
965 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
967 glDisable(GL_TEXTURE_2D
);
968 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
980 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
986 // ////////////////////////////////////////////////////////////////////////// //
987 procedure e_DarkenQuad (x0
, y0
, x1
, y1
: Integer; a
: Integer);
989 if (a
< 0) then a
:= 0;
990 if (a
> 255) then a
:= 255;
992 glBlendFunc(GL_ZERO
, GL_SRC_ALPHA
);
993 glDisable(GL_TEXTURE_2D
);
994 glColor4ub(0, 0, 0, Byte(255-a
));
1001 //glRect(x, y, x+w, y+h);
1002 glColor4ub(1, 1, 1, 1);
1003 glDisable(GL_BLEND
);
1004 //glBlendEquation(GL_FUNC_ADD);
1007 procedure e_DarkenQuadWH (x
, y
, w
, h
: Integer; a
: Integer);
1009 if (w
> 0) and (h
> 0) then e_DarkenQuad(x
, y
, x
+w
, y
+h
, a
);
1013 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
1016 v
: array [0..3] of GLfloat
;
1019 if e_NoGraphics
then Exit
;
1020 // Pixel-perfect lines
1022 e_LineCorrection(X1
, Y1
, X2
, Y2
);
1027 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1029 glDisable(GL_BLEND
);
1031 glDisable(GL_TEXTURE_2D
);
1032 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
1036 v
[0] := X1
; v
[1] := Y1
; v
[2] := X2
; v
[3] := Y2
;
1037 glVertexPointer(2, GL_FLOAT
, 0, @v
[0]);
1038 glEnableClientState(GL_VERTEX_ARRAY
);
1039 glDisableClientState(GL_COLOR_ARRAY
);
1040 glDisableClientState(GL_NORMAL_ARRAY
);
1041 glDisableClientState(GL_TEXTURE_COORD_ARRAY
);
1042 glDrawArrays(GL_LINES
, 0, 4);
1050 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1052 glDisable(GL_BLEND
);
1055 //------------------------------------------------------------------
1056 // Óäàëÿåò òåêñòóðó èç ìàññèâà
1057 //------------------------------------------------------------------
1058 procedure e_DeleteTexture(ID
: DWORD
);
1060 if not e_NoGraphics
then
1061 glDeleteTextures(1, @e_Textures
[ID
].tx
.id
);
1062 e_Textures
[ID
].tx
.id
:= 0;
1063 e_Textures
[ID
].tx
.Width
:= 0;
1064 e_Textures
[ID
].tx
.Height
:= 0;
1067 //------------------------------------------------------------------
1068 // Óäàëÿåò âñå òåêñòóðû
1069 //------------------------------------------------------------------
1070 procedure e_RemoveAllTextures();
1074 if e_Textures
= nil then Exit
;
1076 for i
:= 0 to High(e_Textures
) do
1077 if e_Textures
[i
].tx
.Width
<> 0 then e_DeleteTexture(i
);
1081 //------------------------------------------------------------------
1083 //------------------------------------------------------------------
1084 procedure e_ReleaseEngine();
1086 e_RemoveAllTextures
;
1087 e_RemoveAllTextureFont
;
1090 procedure e_BeginRender();
1092 if e_NoGraphics
then Exit
;
1093 glEnable(GL_ALPHA_TEST
);
1094 glAlphaFunc(GL_GREATER
, 0.0);
1097 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
1099 if e_NoGraphics
then Exit
;
1100 glClearColor(Red
, Green
, Blue
, 0);
1104 procedure e_Clear(); overload
;
1106 if e_NoGraphics
then Exit
;
1107 glClearColor(0, 0, 0, 0);
1108 glClear(GL_COLOR_BUFFER_BIT
);
1111 procedure e_EndRender();
1113 if e_NoGraphics
then Exit
;
1117 function e_GetGamma(win
: PSDL_Window
): Byte;
1119 ramp
: array [0..256*3-1] of Word;
1120 rgb
: array [0..2] of Double;
1129 if e_NoGraphics
then Exit
;
1134 SDL_GetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1143 for j
:= min
to max
- 1 do
1146 B
:= (j
mod 256)/256;
1148 sum
:= sum
+ ln(A
)/ln(B
);
1151 rgb
[i
] := sum
/ count
;
1154 Result
:= 100 - Trunc(((rgb
[0] + rgb
[1] + rgb
[2])/3 - 0.23) * 100/(2.7 - 0.23));
1157 procedure e_SetGamma(win
: PSDL_Window
; Gamma
: Byte);
1159 ramp
: array [0..256*3-1] of Word;
1164 if e_NoGraphics
then Exit
;
1165 g
:= (100 - Gamma
)*(2.7 - 0.23)/100 + 0.23;
1167 for i
:= 0 to 255 do
1169 r
:= Exp(g
* ln(i
/256))*65536;
1170 if r
< 0 then r
:= 0
1171 else if r
> 65535 then r
:= 65535;
1172 ramp
[i
] := trunc(r
);
1173 ramp
[i
+ 256] := trunc(r
);
1174 ramp
[i
+ 512] := trunc(r
);
1177 SDL_SetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1180 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1184 e_WriteLog('Creating CharFont...', TMsgType
.Notify
);
1188 if e_CharFonts
<> nil then
1189 for i
:= 0 to High(e_CharFonts
) do
1190 if not e_CharFonts
[i
].alive
then
1196 if id
= DWORD(-1) then
1198 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1199 id
:= High(e_CharFonts
);
1202 with e_CharFonts
[id
] do
1204 for i
:= 0 to High(Chars
) do
1218 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1220 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1222 TextureID
:= Texture
;
1227 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1231 if e_NoGraphics
then Exit
;
1232 if Text = '' then Exit
;
1233 if e_CharFonts
= nil then Exit
;
1234 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1236 with e_CharFonts
[FontID
] do
1238 for a
:= 1 to Length(Text) do
1239 with Chars
[Ord(Text[a
])] do
1240 if TextureID
<> -1 then
1242 e_Draw(TextureID
, X
, Y
, 0, True, False);
1243 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1248 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1249 Color
: TRGB
; Scale
: Single = 1.0);
1254 if e_NoGraphics
then Exit
;
1255 if Text = '' then Exit
;
1256 if e_CharFonts
= nil then Exit
;
1257 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1259 with e_CharFonts
[FontID
] do
1261 for a
:= 1 to Length(Text) do
1262 with Chars
[Ord(Text[a
])] do
1263 if TextureID
<> -1 then
1265 if Scale
<> 1.0 then
1268 glScalef(Scale
, Scale
, 0);
1273 e_Draw(TextureID
, X
, Y
, 0, True, False);
1276 if Scale
<> 1.0 then glPopMatrix
;
1278 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1283 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1285 a
, TX
, TY
, len
: Integer;
1289 if e_NoGraphics
then Exit
;
1290 if Text = '' then Exit
;
1291 if e_CharFonts
= nil then Exit
;
1292 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1300 len
:= Length(Text);
1302 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1304 with e_CharFonts
[FontID
] do
1306 for a
:= 1 to len
do
1317 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1322 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1327 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1332 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1337 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1342 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1347 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1352 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1357 with Chars
[Ord(Text[a
])] do
1358 if TextureID
<> -1 then
1362 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1365 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1371 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1379 if Text = '' then Exit
;
1380 if e_CharFonts
= nil then Exit
;
1381 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1383 with e_CharFonts
[FontID
] do
1385 for a
:= 1 to Length(Text) do
1386 with Chars
[Ord(Text[a
])] do
1387 if TextureID
<> -1 then
1389 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1390 e_GetTextureSize(TextureID
, nil, @h2
);
1391 if h2
> h
then h
:= h2
;
1396 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1398 a
, lines
, len
: Integer;
1399 h2
, w2
, tw
, th
: Word;
1406 if Text = '' then Exit
;
1407 if e_CharFonts
= nil then Exit
;
1408 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1411 len
:= Length(Text);
1413 with e_CharFonts
[FontID
] do
1415 for a
:= 1 to len
do
1417 if Text[a
] = #10 then
1420 if w2
> tw
then tw
:= w2
;
1425 with Chars
[Ord(Text[a
])] do
1426 if TextureID
<> -1 then
1428 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1429 e_GetTextureSize(TextureID
, nil, @h2
);
1430 if h2
> th
then th
:= h2
;
1442 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1448 if e_CharFonts
= nil then Exit
;
1449 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1451 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1452 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1455 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1462 if e_CharFonts
= nil then Exit
;
1463 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1465 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1467 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1468 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1470 if h2
> Result
then Result
:= h2
;
1474 procedure e_CharFont_Remove(FontID
: DWORD
);
1478 with e_CharFonts
[FontID
] do
1479 for a
:= 0 to High(Chars
) do
1480 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1482 e_CharFonts
[FontID
].alive
:= False;
1485 procedure e_CharFont_RemoveAll();
1489 if e_CharFonts
= nil then Exit
;
1491 for a
:= 0 to High(e_CharFonts
) do
1492 e_CharFont_Remove(a
);
1497 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1504 if e_NoGraphics
then Exit
;
1505 e_WriteLog('Creating texture font...', TMsgType
.Notify
);
1509 if e_TextureFonts
<> nil then
1510 for i
:= 0 to High(e_TextureFonts
) do
1511 if e_TextureFonts
[i
].Base
= 0 then
1517 if id
= DWORD(-1) then
1519 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1520 id
:= High(e_TextureFonts
);
1523 with e_TextureFonts
[id
] do
1525 {$IF not DEFINED(USE_NANOGL) and not DEFINED(USE_NOGL)}
1526 Base
:= glGenLists(XCount
*YCount
);
1528 TextureID
:= e_Textures
[Tex
].tx
.id
;
1529 CharWidth
:= (e_Textures
[Tex
].tx
.Width
div XCount
)+Space
;
1530 CharHeight
:= e_Textures
[Tex
].tx
.Height
div YCount
;
1537 {$IF not DEFINED(USE_NANOGL) and not DEFINED(USE_NOGL)}
1538 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1539 for loop1
:= 0 to XCount
*YCount
-1 do
1541 cx
:= (loop1
mod XCount
)/XCount
;
1542 cy
:= (loop1
div YCount
)/YCount
;
1544 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1546 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1547 glVertex2i(0, e_Textures
[Tex
].tx
.Height
div YCount
);
1549 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1550 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, e_Textures
[Tex
].tx
.Height
div YCount
);
1552 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1553 glVertex2i(e_Textures
[Tex
].tx
.Width
div XCount
, 0);
1555 glTexCoord2f(cx
, 1.0-cy
);
1558 glTranslated((e_Textures
[Tex
].tx
.Width
div XCount
)+Space
, 0, 0);
1566 procedure e_TextureFontKill(FontID
: DWORD
);
1568 if e_NoGraphics
then Exit
;
1569 {$IF not DEFINED(USE_NANOGL) and not DEFINED(USE_NOGL)}
1570 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1572 e_TextureFonts
[FontID
].Base
:= 0;
1575 {$IF DEFINED(USE_NANOGL) or DEFINED(USE_NOGL)}
1576 procedure e_TextureFontDrawChar(ch
: Char; FontID
: DWORD
);
1581 Width
, Height
: Integer;
1582 XCount
, YCount
: Integer;
1584 index
:= Ord(ch
) - 32;
1585 Tex
:= e_TextureFonts
[FontID
].Texture
;
1586 Width
:= e_Textures
[Tex
].tx
.Width
;
1587 Height
:= e_Textures
[Tex
].tx
.Height
;
1588 XCount
:= e_TextureFonts
[FontID
].XC
;
1589 YCount
:= e_TextureFonts
[FontID
].YC
;
1590 cx
:= (index
mod XCount
)/XCount
;
1591 cy
:= (index
div YCount
)/YCount
;
1593 glTexCoord2f(cx
, 1 - cy
- 1/YCount
);
1594 glVertex2i(0, Height
div YCount
);
1595 glTexCoord2f(cx
+ 1/XCount
, 1 - cy
- 1/YCount
);
1596 glVertex2i(Width
div XCount
, Height
div YCount
);
1597 glTexCoord2f(cx
+ 1/XCount
, 1 - cy
);
1598 glVertex2i(Width
div XCount
, 0);
1599 glTexCoord2f(cx
, 1 - cy
);
1602 glTranslatef((e_Textures
[Tex
].tx
.Width
div XCount
) + e_TextureFonts
[FontID
].SPC
, 0, 0);
1605 procedure e_TextureFontDrawString(Text: String; FontID
: DWORD
);
1609 for i
:= 1 to High(Text) do
1610 e_TextureFontDrawChar(Text[i
], FontID
);
1614 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1616 if e_NoGraphics
then Exit
;
1617 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1618 if Text = '' then Exit
;
1620 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1623 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1626 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1627 glEnable(GL_TEXTURE_2D
);
1628 glTranslatef(x
, y
, 0);
1629 {$IF DEFINED(USE_NANOGL) or DEFINED(USE_NOGL)}
1630 e_TextureFontDrawString(Text, FontID
);
1632 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1633 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1635 glDisable(GL_TEXTURE_2D
);
1638 glDisable(GL_BLEND
);
1641 // god forgive me for this, but i cannot figure out how to do it without lists
1642 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1644 if e_NoGraphics
then Exit
;
1649 glColor4ub(0, 0, 0, 128);
1650 glTranslatef(X
+1, Y
+1, 0);
1651 {$IF DEFINED(USE_NANOGL) or DEFINED(USE_NOGL)}
1652 e_TextureFontDrawChar(Ch
, FontID
);
1654 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1660 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1661 glTranslatef(X
, Y
, 0);
1662 {$IF DEFINED(USE_NANOGL) or DEFINED(USE_NOGL)}
1663 e_TextureFontDrawChar(Ch
, FontID
);
1665 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1671 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1673 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1674 glEnable(GL_TEXTURE_2D
);
1675 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1677 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1679 e_TextureFontPrintChar(X
, Y
, Ch
, FontID
, Shadow
);
1680 glDisable(GL_TEXTURE_2D
);
1681 glDisable(GL_BLEND
);
1684 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
1686 result
:= e_TextureFonts
[FontID
].CharWidth
;
1689 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
;
1690 Shadow
: Boolean = False; Newlines
: Boolean = False);
1692 a
, TX
, TY
, len
: Integer;
1696 if e_NoGraphics
then Exit
;
1697 if Text = '' then Exit
;
1698 if e_TextureFonts
= nil then Exit
;
1699 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1707 len
:= Length(Text);
1709 w
:= e_TextureFonts
[FontID
].CharWidth
;
1710 h
:= e_TextureFonts
[FontID
].CharHeight
;
1712 with e_TextureFonts
[FontID
] do
1714 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1715 glEnable(GL_TEXTURE_2D
);
1717 {$IF not DEFINED(USE_NANOGL) and not DEFINED(USE_NOGL)}
1718 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1721 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1724 for a
:= 1 to len
do
1738 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1743 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1748 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1753 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1758 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1763 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1768 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1773 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1780 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1785 glDisable(GL_TEXTURE_2D
);
1786 glDisable(GL_BLEND
);
1790 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1791 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1793 if e_NoGraphics
then Exit
;
1794 if Text = '' then Exit
;
1797 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1798 glEnable(GL_TEXTURE_2D
);
1800 {$IF not DEFINED(USE_NANOGL) and not DEFINED(USE_NOGL)}
1801 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1804 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1809 glColor4ub(0, 0, 0, 128);
1810 glTranslatef(x
+1, y
+1, 0);
1811 glScalef(Scale
, Scale
, 0);
1812 {$IF DEFINED(USE_NANOGL) or DEFINED(USE_NOGL)}
1813 e_TextureFontDrawString(Text, FontID
);
1815 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1821 glColor4ub(Red
, Green
, Blue
, 255);
1822 glTranslatef(x
, y
, 0);
1823 glScalef(Scale
, Scale
, 0);
1824 {$IF DEFINED(USE_NANOGL) or DEFINED(USE_NOGL)}
1825 e_TextureFontDrawString(Text, FontID
);
1827 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1830 glDisable(GL_TEXTURE_2D
);
1832 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1833 glDisable(GL_BLEND
);
1836 procedure e_TextureFontGetSize(ID
: DWORD
; out CharWidth
, CharHeight
: Byte);
1840 if e_NoGraphics
then Exit
;
1841 if Integer(ID
) > High(e_TextureFonts
) then
1843 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1844 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1847 procedure e_RemoveAllTextureFont();
1851 if e_NoGraphics
then Exit
;
1852 if e_TextureFonts
= nil then Exit
;
1854 for i
:= 0 to High(e_TextureFonts
) do
1855 if e_TextureFonts
[i
].Base
<> 0 then
1857 {$IF not DEFINED(USE_NANOGL) and not DEFINED(USE_NOGL)}
1858 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1860 e_TextureFonts
[i
].Base
:= 0;
1863 e_TextureFonts
:= nil;
1866 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1873 function _Point(X
, Y
: Integer): TPoint2i
;
1879 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1883 Result
.Width
:= Width
;
1884 Result
.Height
:= Height
;
1887 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
1896 procedure e_MakeScreenshot (st
: TStream
; Width
, Height
: Word);
1898 pixels
, obuf
, scln
, ps
, pd
: PByte;
1901 i
, x
, y
, res
: Integer;
1902 sign
: array [0..7] of Byte;
1903 hbuf
: array [0..12] of Byte;
1908 if e_NoGraphics
then Exit
;
1911 // first, extract and pack graphics data
1912 if (Width
mod 4) > 0 then Width
:= Width
+4-(Width
mod 4);
1914 GetMem(pixels
, Width
*Height
*3);
1916 FillChar(pixels
^, Width
*Height
*3, 0);
1917 glReadPixels(0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pixels
);
1918 //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
1920 if e_FastScreenshots
then
1923 GetMem(scln
, (Width
*3+1)*Height
);
1927 Inc(ps
, (Width
*3)*(Height
-1));
1928 for i
:= 0 to Height
-1 do
1932 Move(ps
^, pd
^, Width
*3);
1944 obufsize
:= (Width
*3+1)*Height
*2;
1945 GetMem(obuf
, obufsize
);
1950 res
:= compress2(Pointer(obuf
), dlen
, Pointer(pixels
), (Width
*3+1)*Height
, 9);
1951 if res
= Z_OK
then break
;
1952 if res
<> Z_BUF_ERROR
then raise Exception
.Create('can''t pack data for PNG');
1953 obufsize
:= obufsize
*2;
1956 GetMem(obuf
, obufsize
);
1958 //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
1971 st
.writeBuffer(sign
, 8);
1972 //e_WriteLog('PNG: signature written', MSG_NOTIFY);
1975 writeIntBE(st
, LongWord(13));
1980 st
.writeBuffer(sign
, 4);
1981 crc
:= crc32(0, @sign
[0], 4);
1984 hbuf
[2] := (Width
shr 8) and $ff;
1985 hbuf
[3] := Width
and $ff;
1988 hbuf
[6] := (Height
shr 8) and $ff;
1989 hbuf
[7] := Height
and $ff;
1990 hbuf
[8] := 8; // bit depth
1991 hbuf
[9] := 2; // RGB
1992 hbuf
[10] := 0; // compression method
1993 hbuf
[11] := 0; // filter method
1994 hbuf
[12] := 0; // no interlace
1995 crc
:= crc32(crc
, @hbuf
[0], 13);
1996 st
.writeBuffer(hbuf
, 13);
1997 writeIntBE(st
, crc
);
1998 //e_WriteLog('PNG: header written', MSG_NOTIFY);
2001 writeIntBE(st
, LongWord(dlen
));
2006 st
.writeBuffer(sign
, 4);
2007 crc
:= crc32(0, @sign
[0], 4);
2008 crc
:= crc32(crc
, obuf
, dlen
);
2009 st
.writeBuffer(obuf
^, dlen
);
2010 writeIntBE(st
, crc
);
2011 //e_WriteLog('PNG: image data written', MSG_NOTIFY);
2014 writeIntBE(st
, LongWord(0));
2019 st
.writeBuffer(sign
, 4);
2020 crc
:= crc32(0, @sign
[0], 4);
2021 writeIntBE(st
, crc
);
2022 //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
2024 if obuf
<> nil then FreeMem(obuf
);
2029 Imaging
.SetOption(ImagingPNGCompressLevel
, 9);
2030 Imaging
.SetOption(ImagingPNGPreFilter
, 6);
2033 NewImage(Width
, Height
, TImageFormat
.ifR8G8B8
, img
);
2035 //writeln(stderr, 'moving pixels...');
2036 for y
:= Height
-1 downto 0 do
2038 for x
:= 0 to Width
-1 do
2040 clr
.r
:= ps
^; Inc(ps
);
2041 clr
.g
:= ps
^; Inc(ps
);
2042 clr
.b
:= ps
^; Inc(ps
);
2044 SetPixel32(img
, x
, y
, clr
);
2047 GlobalMetadata
.ClearMetaItems();
2048 GlobalMetadata
.ClearMetaItemsForSaving();
2049 //writeln(stderr, 'compressing image...');
2050 if not SaveImageToStream('png', st
, img
) then raise Exception
.Create('screenshot writing error');
2051 //writeln(stderr, 'done!');