ef4e6f0b9b69634c3442b2e0bc0bda20c3da377c
7 SysUtils
, Classes
, Math
, e_log
, e_textures
, SDL2
, GL
, GLExt
, MAPDEF
, ImagingTypes
, Imaging
, ImagingUtility
;
10 TMirrorType
=(M_NONE
, M_HORIZONTAL
, M_VERTICAL
);
11 TBlending
=(B_NONE
, B_BLEND
, B_FILTER
, B_INVERT
);
17 TPoint
= MAPDEF
.TPoint
; // TODO: create an utiltypes.pas or something
18 // for other types like rect as well
25 Left
, Top
, Right
, Bottom
: Integer;
43 //------------------------------------------------------------------
45 //------------------------------------------------------------------
47 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
48 procedure e_ResizeWindow(Width
, Height
: Integer);
50 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
51 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
52 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
53 Blending
: Boolean; Angle
: Single; RC
: PPoint
; Mirror
: TMirrorType
= M_NONE
);
54 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
55 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
56 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
57 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
58 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
59 AlphaChannel
: Boolean; Blending
: Boolean);
60 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
61 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
62 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
63 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
64 Blending
: TBlending
= B_NONE
);
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 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
73 procedure e_DeleteTexture(ID
: DWORD
);
74 procedure e_RemoveAllTextures();
77 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
78 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
79 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
80 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
81 Color
: TRGB
; Scale
: Single = 1.0);
82 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
83 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
84 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
85 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
86 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
87 procedure e_CharFont_Remove(FontID
: DWORD
);
88 procedure e_CharFont_RemoveAll();
91 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
93 procedure e_TextureFontKill(FontID
: DWORD
);
94 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
95 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
96 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
97 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
98 procedure e_TextureFontGetSize(ID
: DWORD
; var 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(); overload
;
108 procedure e_EndRender();
110 function e_GetGamma(win
: PSDL_Window
): Byte;
111 procedure e_SetGamma(win
: PSDL_Window
;Gamma
: Byte);
113 procedure e_MakeScreenshot(st
: TStream
; Width
, Height
: Word);
115 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
116 function _Point(X
, Y
: Integer): TPoint2i
;
117 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
118 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
123 e_NoGraphics
: Boolean = False;
124 e_FastScreenshots
: Boolean = true; // it's REALLY SLOW with `false`
142 TTextureFont
= record
152 Chars
: array[0..255] of
162 TSavedTexture
= record
169 e_Textures
: array of TTexture
= nil;
170 e_TextureFonts
: array of TTextureFont
= nil;
171 e_CharFonts
: array of TCharFont
;
172 //e_SavedTextures: array of TSavedTexture;
174 //------------------------------------------------------------------
175 // Èíèöèàëèçèðóåò OpenGL
176 //------------------------------------------------------------------
177 procedure e_InitGL();
181 e_DummyTextures
:= True;
187 glDisable(GL_DEPTH_TEST
);
188 glEnable(GL_SCISSOR_TEST
);
189 glClearColor(0, 0, 0, 0);
192 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
194 mat
: Array [0..15] of GLDouble
;
197 if e_NoGraphics
then Exit
;
199 glScissor(X
, Y
, Width
, Height
);
200 glViewport(X
, Y
, Width
, Height
);
201 //gluOrtho2D(0, Width, Height, 0);
203 glMatrixMode(GL_PROJECTION
);
205 mat
[ 0] := 2.0 / Width
;
211 mat
[ 5] := -2.0 / Height
;
225 glLoadMatrixd(@mat
[0]);
227 glMatrixMode(GL_MODELVIEW
);
231 //------------------------------------------------------------------
232 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
233 //------------------------------------------------------------------
234 function FindTexture(): DWORD
;
238 if e_Textures
<> nil then
239 for i
:= 0 to High(e_Textures
) do
240 if e_Textures
[i
].Width
= 0 then
246 if e_Textures
= nil then
248 SetLength(e_Textures
, 32);
253 Result
:= High(e_Textures
) + 1;
254 SetLength(e_Textures
, Length(e_Textures
) + 32);
258 //------------------------------------------------------------------
260 //------------------------------------------------------------------
261 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
268 e_WriteLog('Loading texture from '+FileName
, MSG_NOTIFY
);
270 find_id
:= FindTexture();
272 if not LoadTexture(FileName
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].Width
,
273 e_Textures
[find_id
].Height
, @fmt
) then Exit
;
276 e_Textures
[ID
].Fmt
:= fmt
;
281 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
288 find_id
:= FindTexture();
290 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
292 e_Textures
[find_id
].Width
:= fWidth
;
293 e_Textures
[find_id
].Height
:= fHeight
;
294 e_Textures
[find_id
].Fmt
:= fmt
;
301 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
308 find_id
:= FindTexture
;
310 if not LoadTextureMem(pData
, dataSize
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].Width
, e_Textures
[find_id
].Height
, @fmt
) then exit
;
313 e_Textures
[id
].Fmt
:= fmt
;
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
;
329 e_Textures
[find_id
].Width
:= fWidth
;
330 e_Textures
[find_id
].Height
:= fHeight
;
331 e_Textures
[find_id
].Fmt
:= fmt
;
338 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
344 find_id
:= FindTexture();
345 if not LoadTextureImg(img
, e_Textures
[find_id
].tx
, tw
, th
, @fmt
) then exit
;
346 //writeln(' tw=', tw, '; th=', th);
347 e_Textures
[find_id
].Width
:= tw
;
348 e_Textures
[find_id
].Height
:= th
;
349 e_Textures
[find_id
].Fmt
:= fmt
;
354 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
356 if Width
<> nil then Width
^ := e_Textures
[ID
].Width
;
357 if Height
<> nil then Height
^ := e_Textures
[ID
].Height
;
360 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
368 w
:= e_Textures
[ID
].Width
;
369 h
:= e_Textures
[ID
].Height
;
376 if e_NoGraphics
then Exit
;
378 data
:= GetMemory(w
*h
*4);
379 glEnable(GL_TEXTURE_2D
);
380 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
381 glGetTexImage(GL_TEXTURE_2D
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, data
);
383 for y
:= h
-1 downto 0 do
390 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
396 Result
.Y
:= h
-lastline
;
408 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
414 Result
.Height
:= h
-lastline
-Result
.Y
;
426 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
432 Result
.X
:= lastline
+1;
437 for x
:= w
-1 downto 0 do
444 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
450 Result
.Width
:= lastline
-Result
.X
+1;
458 procedure e_ResizeWindow(Width
, Height
: Integer);
462 e_SetViewPort(0, 0, Width
, Height
);
465 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
466 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
470 if e_NoGraphics
then Exit
;
471 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
473 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
478 if (AlphaChannel
) or (Alpha
> 0) then
479 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
482 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
485 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
487 glEnable(GL_TEXTURE_2D
);
488 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
491 u
:= e_Textures
[ID
].tx
.u
;
492 v
:= e_Textures
[ID
].tx
.v
;
494 if Mirror
= M_NONE
then
496 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
497 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
498 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
499 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
502 if Mirror
= M_HORIZONTAL
then
504 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
505 glTexCoord2f(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
506 glTexCoord2f(0, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
507 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
510 if Mirror
= M_VERTICAL
then
512 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
513 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
514 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
515 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
523 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
524 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
528 if e_NoGraphics
then Exit
;
529 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
531 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
536 if (AlphaChannel
) or (Alpha
> 0) then
537 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
540 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
543 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
545 glEnable(GL_TEXTURE_2D
);
546 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
548 u
:= e_Textures
[ID
].tx
.u
;
549 v
:= e_Textures
[ID
].tx
.v
;
552 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
553 glTexCoord2f(u
, v
); glVertex2i(X
+ Width
, Y
);
554 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
555 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
561 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
562 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
566 if e_NoGraphics
then Exit
;
567 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
569 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
574 if (AlphaChannel
) or (Alpha
> 0) then
575 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
578 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
581 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
583 glEnable(GL_TEXTURE_2D
);
584 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
587 u
:= e_Textures
[ID
].tx
.u
;
588 v
:= e_Textures
[ID
].tx
.v
;
590 if Mirror
= M_NONE
then
592 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
);
593 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
594 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ Height
);
595 glTexCoord2f(u
, -v
); glVertex2i(X
+ Width
, Y
+ Height
);
598 if Mirror
= M_HORIZONTAL
then
600 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
601 glTexCoord2f(0, 0); glVertex2i(X
+ Width
, Y
);
602 glTexCoord2f(0, -v
); glVertex2i(X
+ Width
, Y
+ Height
);
603 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ Height
);
606 if Mirror
= M_VERTICAL
then
608 glTexCoord2f(u
, -v
); glVertex2i(X
+ Width
, Y
);
609 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
610 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
611 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
619 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
620 AlphaChannel
: Boolean; Blending
: Boolean);
622 X2
, Y2
, dx
, w
, h
: Integer;
625 if e_NoGraphics
then Exit
;
626 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
628 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
633 if (AlphaChannel
) or (Alpha
> 0) then
634 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
637 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
640 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
648 glEnable(GL_TEXTURE_2D
);
649 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
651 X2
:= X
+ e_Textures
[ID
].Width
* XCount
;
652 Y2
:= Y
+ e_Textures
[ID
].Height
* YCount
;
654 //k8: this SHOULD work... i hope
655 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
658 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
659 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
660 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
661 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
668 u
:= e_Textures
[ID
].tx
.u
;
669 v
:= e_Textures
[ID
].tx
.v
;
670 w
:= e_Textures
[ID
].tx
.width
;
671 h
:= e_Textures
[ID
].tx
.height
;
678 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
679 glTexCoord2f(u
, v
); glVertex2i(X
+w
, Y
);
680 glTexCoord2f(u
, 0); glVertex2i(X
+w
, Y
+h
);
681 glTexCoord2f(0, 0); glVertex2i(X
, Y
+h
);
695 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
696 Blending
: Boolean; Angle
: Single; RC
: PPoint
; Mirror
: TMirrorType
= M_NONE
);
700 if e_NoGraphics
then Exit
;
701 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
703 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
708 if (AlphaChannel
) or (Alpha
> 0) then
709 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
712 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
715 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
717 if (Angle
<> 0) and (RC
<> nil) then
720 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
721 glRotatef(Angle
, 0, 0, 1);
722 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
725 glEnable(GL_TEXTURE_2D
);
726 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
727 glBegin(GL_QUADS
); //0-1 1-1
730 u
:= e_Textures
[ID
].tx
.u
;
731 v
:= e_Textures
[ID
].tx
.v
;
733 if Mirror
= M_NONE
then
735 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
736 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
737 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
738 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
741 if Mirror
= M_HORIZONTAL
then
743 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
744 glTexCoord2f(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
745 glTexCoord2f(0, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
746 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
749 if Mirror
= M_VERTICAL
then
751 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
752 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
753 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
754 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
765 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
767 if e_NoGraphics
then Exit
;
768 glDisable(GL_TEXTURE_2D
);
769 glColor3ub(Red
, Green
, Blue
);
772 if (Size
= 2) or (Size
= 4) then
776 glVertex2f(X
+0.3, Y
+1.0);
779 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
782 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
784 // Make lines only top-left/bottom-right and top-right/bottom-left
796 // Pixel-perfect hack
804 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
806 nX1
, nY1
, nX2
, nY2
: Integer;
808 if e_NoGraphics
then Exit
;
809 // Only top-left/bottom-right quad
826 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
830 glDisable(GL_TEXTURE_2D
);
831 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
835 nX1
:= X1
; nY1
:= Y1
;
836 nX2
:= X2
; nY2
:= Y1
;
837 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
838 glVertex2i(nX1
, nY1
);
839 glVertex2i(nX2
, nY2
);
841 nX1
:= X2
; nY1
:= Y1
;
842 nX2
:= X2
; nY2
:= Y2
;
843 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
844 glVertex2i(nX1
, nY1
);
845 glVertex2i(nX2
, nY2
);
847 nX1
:= X2
; nY1
:= Y2
;
848 nX2
:= X1
; nY2
:= Y2
;
849 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
850 glVertex2i(nX1
, nY1
);
851 glVertex2i(nX2
, nY2
);
853 nX1
:= X1
; nY1
:= Y2
;
854 nX2
:= X1
; nY2
:= Y1
;
855 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
856 glVertex2i(nX1
, nY1
);
857 glVertex2i(nX2
, nY2
);
860 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
865 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
866 Blending
: TBlending
= B_NONE
);
868 if e_NoGraphics
then Exit
;
869 if (Alpha
> 0) or (Blending
<> B_NONE
) then
874 if Blending
= B_BLEND
then
875 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
877 if Blending
= B_FILTER
then
878 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
880 if Blending
= B_INVERT
then
881 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
884 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
886 glDisable(GL_TEXTURE_2D
);
887 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
899 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
904 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
906 if e_NoGraphics
then Exit
;
907 // Pixel-perfect lines
909 e_LineCorrection(X1
, Y1
, X2
, Y2
);
914 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
918 glDisable(GL_TEXTURE_2D
);
919 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
927 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
932 //------------------------------------------------------------------
933 // Óäàëÿåò òåêñòóðó èç ìàññèâà
934 //------------------------------------------------------------------
935 procedure e_DeleteTexture(ID
: DWORD
);
937 if not e_NoGraphics
then
938 glDeleteTextures(1, @e_Textures
[ID
].tx
.id
);
939 e_Textures
[ID
].tx
.id
:= 0;
940 e_Textures
[ID
].Width
:= 0;
941 e_Textures
[ID
].Height
:= 0;
944 //------------------------------------------------------------------
945 // Óäàëÿåò âñå òåêñòóðû
946 //------------------------------------------------------------------
947 procedure e_RemoveAllTextures();
951 if e_Textures
= nil then Exit
;
953 for i
:= 0 to High(e_Textures
) do
954 if e_Textures
[i
].Width
<> 0 then e_DeleteTexture(i
);
958 //------------------------------------------------------------------
960 //------------------------------------------------------------------
961 procedure e_ReleaseEngine();
964 e_RemoveAllTextureFont
;
967 procedure e_BeginRender();
969 if e_NoGraphics
then Exit
;
970 glEnable(GL_ALPHA_TEST
);
971 glAlphaFunc(GL_GREATER
, 0.0);
974 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
976 if e_NoGraphics
then Exit
;
977 glClearColor(Red
, Green
, Blue
, 0);
981 procedure e_Clear(); overload
;
983 if e_NoGraphics
then Exit
;
984 glClearColor(0, 0, 0, 0);
985 glClear(GL_COLOR_BUFFER_BIT
);
988 procedure e_EndRender();
990 if e_NoGraphics
then Exit
;
994 function e_GetGamma(win
: PSDL_Window
): Byte;
996 ramp
: array [0..256*3-1] of Word;
997 rgb
: array [0..2] of Double;
1006 if e_NoGraphics
then Exit
;
1011 SDL_GetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1020 for j
:= min
to max
- 1 do
1023 B
:= (j
mod 256)/256;
1025 sum
:= sum
+ ln(A
)/ln(B
);
1028 rgb
[i
] := sum
/ count
;
1031 Result
:= 100 - Trunc(((rgb
[0] + rgb
[1] + rgb
[2])/3 - 0.23) * 100/(2.7 - 0.23));
1034 procedure e_SetGamma(win
: PSDL_Window
; Gamma
: Byte);
1036 ramp
: array [0..256*3-1] of Word;
1041 if e_NoGraphics
then Exit
;
1042 g
:= (100 - Gamma
)*(2.7 - 0.23)/100 + 0.23;
1044 for i
:= 0 to 255 do
1046 r
:= Exp(g
* ln(i
/256))*65536;
1047 if r
< 0 then r
:= 0
1048 else if r
> 65535 then r
:= 65535;
1049 ramp
[i
] := trunc(r
);
1050 ramp
[i
+ 256] := trunc(r
);
1051 ramp
[i
+ 512] := trunc(r
);
1054 SDL_SetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1057 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1061 e_WriteLog('Creating CharFont...', MSG_NOTIFY
);
1065 if e_CharFonts
<> nil then
1066 for i
:= 0 to High(e_CharFonts
) do
1067 if not e_CharFonts
[i
].Live
then
1073 if id
= DWORD(-1) then
1075 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1076 id
:= High(e_CharFonts
);
1079 with e_CharFonts
[id
] do
1081 for i
:= 0 to High(Chars
) do
1095 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1097 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1099 TextureID
:= Texture
;
1104 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1108 if e_NoGraphics
then Exit
;
1109 if Text = '' then Exit
;
1110 if e_CharFonts
= nil then Exit
;
1111 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1113 with e_CharFonts
[FontID
] do
1115 for a
:= 1 to Length(Text) do
1116 with Chars
[Ord(Text[a
])] do
1117 if TextureID
<> -1 then
1119 e_Draw(TextureID
, X
, Y
, 0, True, False);
1120 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1125 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1126 Color
: TRGB
; Scale
: Single = 1.0);
1131 if e_NoGraphics
then Exit
;
1132 if Text = '' then Exit
;
1133 if e_CharFonts
= nil then Exit
;
1134 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1136 with e_CharFonts
[FontID
] do
1138 for a
:= 1 to Length(Text) do
1139 with Chars
[Ord(Text[a
])] do
1140 if TextureID
<> -1 then
1142 if Scale
<> 1.0 then
1145 glScalef(Scale
, Scale
, 0);
1150 e_Draw(TextureID
, X
, Y
, 0, True, False);
1153 if Scale
<> 1.0 then glPopMatrix
;
1155 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1160 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1162 a
, TX
, TY
, len
: Integer;
1166 if e_NoGraphics
then Exit
;
1167 if Text = '' then Exit
;
1168 if e_CharFonts
= nil then Exit
;
1169 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1177 len
:= Length(Text);
1179 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1181 with e_CharFonts
[FontID
] do
1183 for a
:= 1 to len
do
1194 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1199 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1204 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1209 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1214 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1219 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1224 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1229 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1234 with Chars
[Ord(Text[a
])] do
1235 if TextureID
<> -1 then
1239 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1242 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1248 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1256 if Text = '' then Exit
;
1257 if e_CharFonts
= nil then Exit
;
1258 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1260 with e_CharFonts
[FontID
] do
1262 for a
:= 1 to Length(Text) do
1263 with Chars
[Ord(Text[a
])] do
1264 if TextureID
<> -1 then
1266 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1267 e_GetTextureSize(TextureID
, nil, @h2
);
1268 if h2
> h
then h
:= h2
;
1273 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1275 a
, lines
, len
: Integer;
1282 if Text = '' then Exit
;
1283 if e_CharFonts
= nil then Exit
;
1284 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1287 len
:= Length(Text);
1289 with e_CharFonts
[FontID
] do
1291 for a
:= 1 to len
do
1293 if Text[a
] = #10 then
1303 else if Text[a
] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1306 with Chars
[Ord(Text[a
])] do
1307 if TextureID
<> -1 then
1309 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1310 e_GetTextureSize(TextureID
, nil, @h2
);
1311 if h2
> h
then h
:= h2
;
1321 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1327 if e_CharFonts
= nil then Exit
;
1328 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1330 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1331 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1334 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1341 if e_CharFonts
= nil then Exit
;
1342 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1344 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1346 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1347 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1349 if h2
> Result
then Result
:= h2
;
1353 procedure e_CharFont_Remove(FontID
: DWORD
);
1357 with e_CharFonts
[FontID
] do
1358 for a
:= 0 to High(Chars
) do
1359 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1361 e_CharFonts
[FontID
].Live
:= False;
1364 procedure e_CharFont_RemoveAll();
1368 if e_CharFonts
= nil then Exit
;
1370 for a
:= 0 to High(e_CharFonts
) do
1371 e_CharFont_Remove(a
);
1376 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1383 if e_NoGraphics
then Exit
;
1384 e_WriteLog('Creating texture font...', MSG_NOTIFY
);
1388 if e_TextureFonts
<> nil then
1389 for i
:= 0 to High(e_TextureFonts
) do
1390 if e_TextureFonts
[i
].Base
= 0 then
1396 if id
= DWORD(-1) then
1398 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1399 id
:= High(e_TextureFonts
);
1402 with e_TextureFonts
[id
] do
1404 Base
:= glGenLists(XCount
*YCount
);
1405 TextureID
:= e_Textures
[Tex
].tx
.id
;
1406 CharWidth
:= (e_Textures
[Tex
].Width
div XCount
)+Space
;
1407 CharHeight
:= e_Textures
[Tex
].Height
div YCount
;
1414 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1415 for loop1
:= 0 to XCount
*YCount
-1 do
1417 cx
:= (loop1
mod XCount
)/XCount
;
1418 cy
:= (loop1
div YCount
)/YCount
;
1420 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1422 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1423 glVertex2d(0, e_Textures
[Tex
].Height
div YCount
);
1425 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1426 glVertex2i(e_Textures
[Tex
].Width
div XCount
, e_Textures
[Tex
].Height
div YCount
);
1428 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1429 glVertex2i(e_Textures
[Tex
].Width
div XCount
, 0);
1431 glTexCoord2f(cx
, 1.0-cy
);
1434 glTranslated((e_Textures
[Tex
].Width
div XCount
)+Space
, 0, 0);
1441 procedure e_TextureFontKill(FontID
: DWORD
);
1443 if e_NoGraphics
then Exit
;
1444 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1445 e_TextureFonts
[FontID
].Base
:= 0;
1448 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1450 if e_NoGraphics
then Exit
;
1451 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1452 if Text = '' then Exit
;
1454 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1457 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1460 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1461 glEnable(GL_TEXTURE_2D
);
1462 glTranslated(x
, y
, 0);
1463 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1464 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1465 glDisable(GL_TEXTURE_2D
);
1468 glDisable(GL_BLEND
);
1471 // god forgive me for this, but i cannot figure out how to do it without lists
1472 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1474 if e_NoGraphics
then Exit
;
1479 glColor4ub(0, 0, 0, 128);
1480 glTranslated(X
+1, Y
+1, 0);
1481 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1486 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1487 glTranslated(X
, Y
, 0);
1488 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1493 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1495 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1496 glEnable(GL_TEXTURE_2D
);
1497 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1499 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1501 e_TextureFontPrintChar(X
, Y
, Ch
, FontID
, Shadow
);
1502 glDisable(GL_TEXTURE_2D
);
1503 glDisable(GL_BLEND
);
1506 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
1508 result
:= e_TextureFonts
[FontID
].CharWidth
;
1511 procedure e_TextureFontPrintFmt(X
, Y
: Integer; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
1513 a
, TX
, TY
, len
: Integer;
1517 if e_NoGraphics
then Exit
;
1518 if Text = '' then Exit
;
1519 if e_TextureFonts
= nil then Exit
;
1520 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1528 len
:= Length(Text);
1530 w
:= e_TextureFonts
[FontID
].CharWidth
;
1532 with e_TextureFonts
[FontID
] do
1534 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1535 glEnable(GL_TEXTURE_2D
);
1536 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1538 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1541 for a
:= 1 to len
do
1552 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1557 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1562 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1567 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1572 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1577 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1582 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1587 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1594 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1599 glDisable(GL_TEXTURE_2D
);
1600 glDisable(GL_BLEND
);
1604 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1605 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1607 if e_NoGraphics
then Exit
;
1608 if Text = '' then Exit
;
1611 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1612 glEnable(GL_TEXTURE_2D
);
1613 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1615 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1620 glColor4ub(0, 0, 0, 128);
1621 glTranslated(x
+1, y
+1, 0);
1622 glScalef(Scale
, Scale
, 0);
1623 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1628 glColor4ub(Red
, Green
, Blue
, 255);
1629 glTranslated(x
, y
, 0);
1630 glScalef(Scale
, Scale
, 0);
1631 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1633 glDisable(GL_TEXTURE_2D
);
1635 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1636 glDisable(GL_BLEND
);
1639 procedure e_TextureFontGetSize(ID
: DWORD
; var CharWidth
, CharHeight
: Byte);
1643 if e_NoGraphics
then Exit
;
1644 if Integer(ID
) > High(e_TextureFonts
) then
1646 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1647 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1650 procedure e_RemoveAllTextureFont();
1654 if e_NoGraphics
then Exit
;
1655 if e_TextureFonts
= nil then Exit
;
1657 for i
:= 0 to High(e_TextureFonts
) do
1658 if e_TextureFonts
[i
].Base
<> 0 then
1660 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1661 e_TextureFonts
[i
].Base
:= 0;
1664 e_TextureFonts
:= nil;
1667 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1674 function _Point(X
, Y
: Integer): TPoint2i
;
1680 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1684 Result
.Width
:= Width
;
1685 Result
.Height
:= Height
;
1688 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
1697 procedure e_MakeScreenshot (st
: TStream
; Width
, Height
: Word);
1699 pixels
, obuf
, scln
, ps
, pd
: PByte;
1702 i
, x
, y
, res
: Integer;
1703 sign
: array [0..7] of Byte;
1704 hbuf
: array [0..12] of Byte;
1709 if e_NoGraphics
then Exit
;
1712 // first, extract and pack graphics data
1713 if (Width
mod 4) > 0 then Width
:= Width
+4-(Width
mod 4);
1715 GetMem(pixels
, Width
*Height
*3);
1717 FillChar(pixels
^, Width
*Height
*3, 0);
1718 glReadPixels(0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pixels
);
1719 //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
1721 if e_FastScreenshots
then
1724 GetMem(scln
, (Width
*3+1)*Height
);
1728 Inc(ps
, (Width
*3)*(Height
-1));
1729 for i
:= 0 to Height
-1 do
1733 Move(ps
^, pd
^, Width
*3);
1745 obufsize
:= (Width
*3+1)*Height
*2;
1746 GetMem(obuf
, obufsize
);
1751 res
:= compress2(Pointer(obuf
), dlen
, Pointer(pixels
), (Width
*3+1)*Height
, 9);
1752 if res
= Z_OK
then break
;
1753 if res
<> Z_BUF_ERROR
then raise Exception
.Create('can''t pack data for PNG');
1754 obufsize
:= obufsize
*2;
1757 GetMem(obuf
, obufsize
);
1759 //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
1772 st
.writeBuffer(sign
, 8);
1773 //e_WriteLog('PNG: signature written', MSG_NOTIFY);
1776 writeIntBE(st
, LongWord(13));
1781 st
.writeBuffer(sign
, 4);
1782 crc
:= crc32(0, @sign
, 4);
1785 hbuf
[2] := (Width
shr 8) and $ff;
1786 hbuf
[3] := Width
and $ff;
1789 hbuf
[6] := (Height
shr 8) and $ff;
1790 hbuf
[7] := Height
and $ff;
1791 hbuf
[8] := 8; // bit depth
1792 hbuf
[9] := 2; // RGB
1793 hbuf
[10] := 0; // compression method
1794 hbuf
[11] := 0; // filter method
1795 hbuf
[12] := 0; // no interlace
1796 crc
:= crc32(crc
, @hbuf
, 13);
1797 st
.writeBuffer(hbuf
, 13);
1798 writeIntBE(st
, crc
);
1799 //e_WriteLog('PNG: header written', MSG_NOTIFY);
1802 writeIntBE(st
, LongWord(dlen
));
1807 st
.writeBuffer(sign
, 4);
1808 crc
:= crc32(0, @sign
, 4);
1809 crc
:= crc32(crc
, obuf
, dlen
);
1810 st
.writeBuffer(obuf
^, dlen
);
1811 writeIntBE(st
, crc
);
1812 //e_WriteLog('PNG: image data written', MSG_NOTIFY);
1815 writeIntBE(st
, LongWord(0));
1820 st
.writeBuffer(sign
, 4);
1821 crc
:= crc32(0, @sign
, 4);
1822 writeIntBE(st
, crc
);
1823 //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
1825 if obuf
<> nil then FreeMem(obuf
);
1830 Imaging
.SetOption(ImagingPNGCompressLevel
, 9);
1831 Imaging
.SetOption(ImagingPNGPreFilter
, 6);
1834 NewImage(Width
, Height
, TImageFormat
.ifR8G8B8
, img
);
1836 //writeln(stderr, 'moving pixels...');
1837 for y
:= Height
-1 downto 0 do
1839 for x
:= 0 to Width
-1 do
1841 clr
.r
:= ps
^; Inc(ps
);
1842 clr
.g
:= ps
^; Inc(ps
);
1843 clr
.b
:= ps
^; Inc(ps
);
1845 SetPixel32(img
, x
, y
, clr
);
1848 GlobalMetadata
.ClearMetaItems();
1849 GlobalMetadata
.ClearMetaItemsForSaving();
1850 //writeln(stderr, 'compressing image...');
1851 if not SaveImageToStream('png', st
, img
) then raise Exception
.Create('screenshot writing error');
1852 //writeln(stderr, 'done!');