7 SysUtils
, Classes
, Math
, e_log
, e_textures
, SDL2
, GL
, GLExt
, MAPDEF
;
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_CreateTexture(FileName
: string; var ID
: DWORD
): Boolean;
67 function e_CreateTextureEx(FileName
: string; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
68 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
69 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
70 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
71 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
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
; Shadow
: Boolean = False);
97 procedure e_TextureFontGetSize(ID
: DWORD
; var CharWidth
, CharHeight
: Byte);
98 procedure e_RemoveAllTextureFont();
100 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
101 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
103 procedure e_ReleaseEngine();
104 procedure e_BeginRender();
105 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
106 procedure e_Clear(); overload
;
107 procedure e_EndRender();
109 function e_GetGamma(win
: PSDL_Window
): Byte;
110 procedure e_SetGamma(win
: PSDL_Window
;Gamma
: Byte);
112 procedure e_MakeScreenshot(st
: TStream
; Width
, Height
: Word);
114 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
115 function _Point(X
, Y
: Integer): TPoint2i
;
116 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
117 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
122 e_NoGraphics
: Boolean = False;
139 TTextureFont
= record
149 Chars
: array[0..255] of
159 TSavedTexture
= record
166 e_Textures
: array of TTexture
= nil;
167 e_TextureFonts
: array of TTextureFont
= nil;
168 e_CharFonts
: array of TCharFont
;
169 //e_SavedTextures: array of TSavedTexture;
171 //------------------------------------------------------------------
172 // Èíèöèàëèçèðóåò OpenGL
173 //------------------------------------------------------------------
174 procedure e_InitGL();
178 e_DummyTextures
:= True;
184 glDisable(GL_DEPTH_TEST
);
185 glEnable(GL_SCISSOR_TEST
);
186 glClearColor(0, 0, 0, 0);
189 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
191 mat
: Array [0..15] of GLDouble
;
194 if e_NoGraphics
then Exit
;
196 glScissor(X
, Y
, Width
, Height
);
197 glViewport(X
, Y
, Width
, Height
);
198 //gluOrtho2D(0, Width, Height, 0);
200 glMatrixMode(GL_PROJECTION
);
202 mat
[ 0] := 2.0 / Width
;
208 mat
[ 5] := -2.0 / Height
;
222 glLoadMatrixd(@mat
[0]);
224 glMatrixMode(GL_MODELVIEW
);
228 //------------------------------------------------------------------
229 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
230 //------------------------------------------------------------------
231 function FindTexture(): DWORD
;
235 if e_Textures
<> nil then
236 for i
:= 0 to High(e_Textures
) do
237 if e_Textures
[i
].Width
= 0 then
243 if e_Textures
= nil then
245 SetLength(e_Textures
, 32);
250 Result
:= High(e_Textures
) + 1;
251 SetLength(e_Textures
, Length(e_Textures
) + 32);
255 //------------------------------------------------------------------
257 //------------------------------------------------------------------
258 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
265 e_WriteLog('Loading texture from '+FileName
, MSG_NOTIFY
);
267 find_id
:= FindTexture();
269 if not LoadTexture(FileName
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].Width
,
270 e_Textures
[find_id
].Height
, @fmt
) then Exit
;
273 e_Textures
[ID
].Fmt
:= fmt
;
278 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
285 find_id
:= FindTexture();
287 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
289 e_Textures
[find_id
].Width
:= fWidth
;
290 e_Textures
[find_id
].Height
:= fHeight
;
291 e_Textures
[find_id
].Fmt
:= fmt
;
298 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
305 find_id
:= FindTexture
;
307 if not LoadTextureMem(pData
, dataSize
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].Width
, e_Textures
[find_id
].Height
, @fmt
) then exit
;
310 e_Textures
[id
].Fmt
:= fmt
;
315 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
322 find_id
:= FindTexture();
324 if not LoadTextureMemEx(pData
, dataSize
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
326 e_Textures
[find_id
].Width
:= fWidth
;
327 e_Textures
[find_id
].Height
:= fHeight
;
328 e_Textures
[find_id
].Fmt
:= fmt
;
335 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
337 if Width
<> nil then Width
^ := e_Textures
[ID
].Width
;
338 if Height
<> nil then Height
^ := e_Textures
[ID
].Height
;
341 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
349 w
:= e_Textures
[ID
].Width
;
350 h
:= e_Textures
[ID
].Height
;
357 if e_NoGraphics
then Exit
;
359 data
:= GetMemory(w
*h
*4);
360 glEnable(GL_TEXTURE_2D
);
361 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
362 glGetTexImage(GL_TEXTURE_2D
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, data
);
364 for y
:= h
-1 downto 0 do
371 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
377 Result
.Y
:= h
-lastline
;
389 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
395 Result
.Height
:= h
-lastline
-Result
.Y
;
407 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
413 Result
.X
:= lastline
+1;
418 for x
:= w
-1 downto 0 do
425 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
431 Result
.Width
:= lastline
-Result
.X
+1;
439 procedure e_ResizeWindow(Width
, Height
: Integer);
443 e_SetViewPort(0, 0, Width
, Height
);
446 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
447 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
451 if e_NoGraphics
then Exit
;
452 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
454 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
459 if (AlphaChannel
) or (Alpha
> 0) then
460 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
463 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
466 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
468 glEnable(GL_TEXTURE_2D
);
469 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
472 u
:= e_Textures
[ID
].tx
.u
;
473 v
:= e_Textures
[ID
].tx
.v
;
475 if Mirror
= M_NONE
then
477 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
478 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
479 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
480 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
483 if Mirror
= M_HORIZONTAL
then
485 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
486 glTexCoord2f(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
487 glTexCoord2f(0, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
488 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
491 if Mirror
= M_VERTICAL
then
493 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
494 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
495 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
496 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
504 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
505 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
509 if e_NoGraphics
then Exit
;
510 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
512 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
517 if (AlphaChannel
) or (Alpha
> 0) then
518 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
521 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
524 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
526 glEnable(GL_TEXTURE_2D
);
527 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
529 u
:= e_Textures
[ID
].tx
.u
;
530 v
:= e_Textures
[ID
].tx
.v
;
533 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
534 glTexCoord2f(u
, v
); glVertex2i(X
+ Width
, Y
);
535 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
536 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
542 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
543 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
547 if e_NoGraphics
then Exit
;
548 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
550 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
555 if (AlphaChannel
) or (Alpha
> 0) then
556 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
559 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
562 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
564 glEnable(GL_TEXTURE_2D
);
565 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
568 u
:= e_Textures
[ID
].tx
.u
;
569 v
:= e_Textures
[ID
].tx
.v
;
571 if Mirror
= M_NONE
then
573 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
);
574 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
575 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ Height
);
576 glTexCoord2f(u
, -v
); glVertex2i(X
+ Width
, Y
+ Height
);
579 if Mirror
= M_HORIZONTAL
then
581 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
582 glTexCoord2f(0, 0); glVertex2i(X
+ Width
, Y
);
583 glTexCoord2f(0, -v
); glVertex2i(X
+ Width
, Y
+ Height
);
584 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ Height
);
587 if Mirror
= M_VERTICAL
then
589 glTexCoord2f(u
, -v
); glVertex2i(X
+ Width
, Y
);
590 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
591 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
592 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
600 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
601 AlphaChannel
: Boolean; Blending
: Boolean);
603 X2
, Y2
, dx
, w
, h
: Integer;
606 if e_NoGraphics
then Exit
;
607 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
609 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
614 if (AlphaChannel
) or (Alpha
> 0) then
615 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
618 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
621 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
629 glEnable(GL_TEXTURE_2D
);
630 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
632 X2
:= X
+ e_Textures
[ID
].Width
* XCount
;
633 Y2
:= Y
+ e_Textures
[ID
].Height
* YCount
;
635 //k8: this SHOULD work... i hope
636 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
639 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
640 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
641 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
642 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
649 u
:= e_Textures
[ID
].tx
.u
;
650 v
:= e_Textures
[ID
].tx
.v
;
651 w
:= e_Textures
[ID
].tx
.width
;
652 h
:= e_Textures
[ID
].tx
.height
;
659 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
660 glTexCoord2f(u
, v
); glVertex2i(X
+w
, Y
);
661 glTexCoord2f(u
, 0); glVertex2i(X
+w
, Y
+h
);
662 glTexCoord2f(0, 0); glVertex2i(X
, Y
+h
);
676 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
677 Blending
: Boolean; Angle
: Single; RC
: PPoint
; Mirror
: TMirrorType
= M_NONE
);
681 if e_NoGraphics
then Exit
;
682 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
684 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
689 if (AlphaChannel
) or (Alpha
> 0) then
690 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
693 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
696 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
698 if (Angle
<> 0) and (RC
<> nil) then
701 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
702 glRotatef(Angle
, 0, 0, 1);
703 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
706 glEnable(GL_TEXTURE_2D
);
707 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
708 glBegin(GL_QUADS
); //0-1 1-1
711 u
:= e_Textures
[ID
].tx
.u
;
712 v
:= e_Textures
[ID
].tx
.v
;
714 if Mirror
= M_NONE
then
716 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
717 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
718 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
719 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
722 if Mirror
= M_HORIZONTAL
then
724 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
725 glTexCoord2f(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
726 glTexCoord2f(0, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
727 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
730 if Mirror
= M_VERTICAL
then
732 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
733 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
734 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
735 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
746 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
748 if e_NoGraphics
then Exit
;
749 glDisable(GL_TEXTURE_2D
);
750 glColor3ub(Red
, Green
, Blue
);
753 if (Size
= 2) or (Size
= 4) then
757 glVertex2f(X
+0.3, Y
+1.0);
760 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
763 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
765 // Make lines only top-left/bottom-right and top-right/bottom-left
777 // Pixel-perfect hack
785 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
787 nX1
, nY1
, nX2
, nY2
: Integer;
789 if e_NoGraphics
then Exit
;
790 // Only top-left/bottom-right quad
807 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
811 glDisable(GL_TEXTURE_2D
);
812 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
816 nX1
:= X1
; nY1
:= Y1
;
817 nX2
:= X2
; nY2
:= Y1
;
818 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
819 glVertex2i(nX1
, nY1
);
820 glVertex2i(nX2
, nY2
);
822 nX1
:= X2
; nY1
:= Y1
;
823 nX2
:= X2
; nY2
:= Y2
;
824 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
825 glVertex2i(nX1
, nY1
);
826 glVertex2i(nX2
, nY2
);
828 nX1
:= X2
; nY1
:= Y2
;
829 nX2
:= X1
; nY2
:= Y2
;
830 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
831 glVertex2i(nX1
, nY1
);
832 glVertex2i(nX2
, nY2
);
834 nX1
:= X1
; nY1
:= Y2
;
835 nX2
:= X1
; nY2
:= Y1
;
836 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
837 glVertex2i(nX1
, nY1
);
838 glVertex2i(nX2
, nY2
);
841 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
846 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
847 Blending
: TBlending
= B_NONE
);
849 if e_NoGraphics
then Exit
;
850 if (Alpha
> 0) or (Blending
<> B_NONE
) then
855 if Blending
= B_BLEND
then
856 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
858 if Blending
= B_FILTER
then
859 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
861 if Blending
= B_INVERT
then
862 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
865 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
867 glDisable(GL_TEXTURE_2D
);
868 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
880 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
885 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
887 if e_NoGraphics
then Exit
;
888 // Pixel-perfect lines
890 e_LineCorrection(X1
, Y1
, X2
, Y2
);
895 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
899 glDisable(GL_TEXTURE_2D
);
900 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
908 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
913 //------------------------------------------------------------------
914 // Óäàëÿåò òåêñòóðó èç ìàññèâà
915 //------------------------------------------------------------------
916 procedure e_DeleteTexture(ID
: DWORD
);
918 if not e_NoGraphics
then
919 glDeleteTextures(1, @e_Textures
[ID
].tx
.id
);
920 e_Textures
[ID
].tx
.id
:= 0;
921 e_Textures
[ID
].Width
:= 0;
922 e_Textures
[ID
].Height
:= 0;
925 //------------------------------------------------------------------
926 // Óäàëÿåò âñå òåêñòóðû
927 //------------------------------------------------------------------
928 procedure e_RemoveAllTextures();
932 if e_Textures
= nil then Exit
;
934 for i
:= 0 to High(e_Textures
) do
935 if e_Textures
[i
].Width
<> 0 then e_DeleteTexture(i
);
939 //------------------------------------------------------------------
941 //------------------------------------------------------------------
942 procedure e_ReleaseEngine();
945 e_RemoveAllTextureFont
;
948 procedure e_BeginRender();
950 if e_NoGraphics
then Exit
;
951 glEnable(GL_ALPHA_TEST
);
952 glAlphaFunc(GL_GREATER
, 0.0);
955 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
957 if e_NoGraphics
then Exit
;
958 glClearColor(Red
, Green
, Blue
, 0);
962 procedure e_Clear(); overload
;
964 if e_NoGraphics
then Exit
;
965 glClearColor(0, 0, 0, 0);
966 glClear(GL_COLOR_BUFFER_BIT
);
969 procedure e_EndRender();
971 if e_NoGraphics
then Exit
;
975 function e_GetGamma(win
: PSDL_Window
): Byte;
977 ramp
: array [0..256*3-1] of Word;
978 rgb
: array [0..2] of Double;
987 if e_NoGraphics
then Exit
;
992 SDL_GetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1001 for j
:= min
to max
- 1 do
1004 B
:= (j
mod 256)/256;
1006 sum
:= sum
+ ln(A
)/ln(B
);
1009 rgb
[i
] := sum
/ count
;
1012 Result
:= 100 - Trunc(((rgb
[0] + rgb
[1] + rgb
[2])/3 - 0.23) * 100/(2.7 - 0.23));
1015 procedure e_SetGamma(win
: PSDL_Window
; Gamma
: Byte);
1017 ramp
: array [0..256*3-1] of Word;
1022 if e_NoGraphics
then Exit
;
1023 g
:= (100 - Gamma
)*(2.7 - 0.23)/100 + 0.23;
1025 for i
:= 0 to 255 do
1027 r
:= Exp(g
* ln(i
/256))*65536;
1028 if r
< 0 then r
:= 0
1029 else if r
> 65535 then r
:= 65535;
1030 ramp
[i
] := trunc(r
);
1031 ramp
[i
+ 256] := trunc(r
);
1032 ramp
[i
+ 512] := trunc(r
);
1035 SDL_SetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1038 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1042 e_WriteLog('Creating CharFont...', MSG_NOTIFY
);
1046 if e_CharFonts
<> nil then
1047 for i
:= 0 to High(e_CharFonts
) do
1048 if not e_CharFonts
[i
].Live
then
1054 if id
= DWORD(-1) then
1056 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1057 id
:= High(e_CharFonts
);
1060 with e_CharFonts
[id
] do
1062 for i
:= 0 to High(Chars
) do
1076 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1078 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1080 TextureID
:= Texture
;
1085 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1089 if e_NoGraphics
then Exit
;
1090 if Text = '' then Exit
;
1091 if e_CharFonts
= nil then Exit
;
1092 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1094 with e_CharFonts
[FontID
] do
1096 for a
:= 1 to Length(Text) do
1097 with Chars
[Ord(Text[a
])] do
1098 if TextureID
<> -1 then
1100 e_Draw(TextureID
, X
, Y
, 0, True, False);
1101 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1106 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1107 Color
: TRGB
; Scale
: Single = 1.0);
1112 if e_NoGraphics
then Exit
;
1113 if Text = '' then Exit
;
1114 if e_CharFonts
= nil then Exit
;
1115 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1117 with e_CharFonts
[FontID
] do
1119 for a
:= 1 to Length(Text) do
1120 with Chars
[Ord(Text[a
])] do
1121 if TextureID
<> -1 then
1123 if Scale
<> 1.0 then
1126 glScalef(Scale
, Scale
, 0);
1131 e_Draw(TextureID
, X
, Y
, 0, True, False);
1134 if Scale
<> 1.0 then glPopMatrix
;
1136 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1141 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1143 a
, TX
, TY
, len
: Integer;
1147 if e_NoGraphics
then Exit
;
1148 if Text = '' then Exit
;
1149 if e_CharFonts
= nil then Exit
;
1150 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1158 len
:= Length(Text);
1160 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1162 with e_CharFonts
[FontID
] do
1164 for a
:= 1 to len
do
1175 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1180 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1185 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1190 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1195 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1200 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1205 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1210 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1215 with Chars
[Ord(Text[a
])] do
1216 if TextureID
<> -1 then
1220 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1223 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1229 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1237 if Text = '' then Exit
;
1238 if e_CharFonts
= nil then Exit
;
1239 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1241 with e_CharFonts
[FontID
] do
1243 for a
:= 1 to Length(Text) do
1244 with Chars
[Ord(Text[a
])] do
1245 if TextureID
<> -1 then
1247 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1248 e_GetTextureSize(TextureID
, nil, @h2
);
1249 if h2
> h
then h
:= h2
;
1254 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1256 a
, lines
, len
: Integer;
1263 if Text = '' then Exit
;
1264 if e_CharFonts
= nil then Exit
;
1265 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1268 len
:= Length(Text);
1270 with e_CharFonts
[FontID
] do
1272 for a
:= 1 to len
do
1274 if Text[a
] = #10 then
1284 else if Text[a
] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1287 with Chars
[Ord(Text[a
])] do
1288 if TextureID
<> -1 then
1290 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1291 e_GetTextureSize(TextureID
, nil, @h2
);
1292 if h2
> h
then h
:= h2
;
1302 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1308 if e_CharFonts
= nil then Exit
;
1309 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1311 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1312 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1315 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1322 if e_CharFonts
= nil then Exit
;
1323 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1325 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1327 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1328 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1330 if h2
> Result
then Result
:= h2
;
1334 procedure e_CharFont_Remove(FontID
: DWORD
);
1338 with e_CharFonts
[FontID
] do
1339 for a
:= 0 to High(Chars
) do
1340 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1342 e_CharFonts
[FontID
].Live
:= False;
1345 procedure e_CharFont_RemoveAll();
1349 if e_CharFonts
= nil then Exit
;
1351 for a
:= 0 to High(e_CharFonts
) do
1352 e_CharFont_Remove(a
);
1357 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1364 if e_NoGraphics
then Exit
;
1365 e_WriteLog('Creating texture font...', MSG_NOTIFY
);
1369 if e_TextureFonts
<> nil then
1370 for i
:= 0 to High(e_TextureFonts
) do
1371 if e_TextureFonts
[i
].Base
= 0 then
1377 if id
= DWORD(-1) then
1379 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1380 id
:= High(e_TextureFonts
);
1383 with e_TextureFonts
[id
] do
1385 Base
:= glGenLists(XCount
*YCount
);
1386 TextureID
:= e_Textures
[Tex
].tx
.id
;
1387 CharWidth
:= (e_Textures
[Tex
].Width
div XCount
)+Space
;
1388 CharHeight
:= e_Textures
[Tex
].Height
div YCount
;
1395 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1396 for loop1
:= 0 to XCount
*YCount
-1 do
1398 cx
:= (loop1
mod XCount
)/XCount
;
1399 cy
:= (loop1
div YCount
)/YCount
;
1401 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1403 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1404 glVertex2d(0, e_Textures
[Tex
].Height
div YCount
);
1406 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1407 glVertex2i(e_Textures
[Tex
].Width
div XCount
, e_Textures
[Tex
].Height
div YCount
);
1409 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1410 glVertex2i(e_Textures
[Tex
].Width
div XCount
, 0);
1412 glTexCoord2f(cx
, 1.0-cy
);
1415 glTranslated((e_Textures
[Tex
].Width
div XCount
)+Space
, 0, 0);
1422 procedure e_TextureFontKill(FontID
: DWORD
);
1424 if e_NoGraphics
then Exit
;
1425 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1426 e_TextureFonts
[FontID
].Base
:= 0;
1429 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1431 if e_NoGraphics
then Exit
;
1432 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1433 if Text = '' then Exit
;
1435 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1438 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1441 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1442 glEnable(GL_TEXTURE_2D
);
1443 glTranslated(x
, y
, 0);
1444 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1445 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1446 glDisable(GL_TEXTURE_2D
);
1449 glDisable(GL_BLEND
);
1452 // god forgive me for this, but i cannot figure out how to do it without lists
1453 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1455 if e_NoGraphics
then Exit
;
1460 glColor4ub(0, 0, 0, 128);
1461 glTranslated(X
+1, Y
+1, 0);
1462 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1467 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1468 glTranslated(X
, Y
, 0);
1469 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1474 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1476 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1477 glEnable(GL_TEXTURE_2D
);
1478 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1480 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1482 e_TextureFontPrintChar(X
, Y
, Ch
, FontID
, Shadow
);
1483 glDisable(GL_TEXTURE_2D
);
1484 glDisable(GL_BLEND
);
1487 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
1489 result
:= e_TextureFonts
[FontID
].CharWidth
;
1492 procedure e_TextureFontPrintFmt(X
, Y
: Integer; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
1494 a
, TX
, TY
, len
: Integer;
1498 if e_NoGraphics
then Exit
;
1499 if Text = '' then Exit
;
1500 if e_TextureFonts
= nil then Exit
;
1501 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1509 len
:= Length(Text);
1511 w
:= e_TextureFonts
[FontID
].CharWidth
;
1513 with e_TextureFonts
[FontID
] do
1515 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1516 glEnable(GL_TEXTURE_2D
);
1517 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1519 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1522 for a
:= 1 to len
do
1533 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1538 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1543 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1548 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1553 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1558 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1563 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1568 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1575 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1580 glDisable(GL_TEXTURE_2D
);
1581 glDisable(GL_BLEND
);
1585 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1586 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1588 if e_NoGraphics
then Exit
;
1589 if Text = '' then Exit
;
1592 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1593 glEnable(GL_TEXTURE_2D
);
1594 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1596 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1601 glColor4ub(0, 0, 0, 128);
1602 glTranslated(x
+1, y
+1, 0);
1603 glScalef(Scale
, Scale
, 0);
1604 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1609 glColor4ub(Red
, Green
, Blue
, 255);
1610 glTranslated(x
, y
, 0);
1611 glScalef(Scale
, Scale
, 0);
1612 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1614 glDisable(GL_TEXTURE_2D
);
1616 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1617 glDisable(GL_BLEND
);
1620 procedure e_TextureFontGetSize(ID
: DWORD
; var CharWidth
, CharHeight
: Byte);
1624 if e_NoGraphics
then Exit
;
1625 if Integer(ID
) > High(e_TextureFonts
) then
1627 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1628 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1631 procedure e_RemoveAllTextureFont();
1635 if e_NoGraphics
then Exit
;
1636 if e_TextureFonts
= nil then Exit
;
1638 for i
:= 0 to High(e_TextureFonts
) do
1639 if e_TextureFonts
[i
].Base
<> 0 then
1641 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1642 e_TextureFonts
[i
].Base
:= 0;
1645 e_TextureFonts
:= nil;
1648 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1655 function _Point(X
, Y
: Integer): TPoint2i
;
1661 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1665 Result
.Width
:= Width
;
1666 Result
.Height
:= Height
;
1669 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
1678 procedure e_MakeScreenshot (st
: TStream
; Width
, Height
: Word);
1680 pixels
, obuf
, scln
, ps
, pd
: PByte;
1684 sign
: array [0..7] of Byte;
1685 hbuf
: array [0..12] of Byte;
1688 if e_NoGraphics
then Exit
;
1691 // first, extract and pack graphics data
1693 if (Width
mod 4) > 0 then Width
:= Width
+ 4 - (Width
mod 4);
1695 GetMem(pixels
, Width
*Height
*3);
1697 FillChar(pixels
^, Width
*Height
*3, 0);
1698 glReadPixels(0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pixels
);
1699 //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
1702 GetMem(scln
, (Width
*3+1)*Height
);
1706 Inc(ps
, (Width
*3)*(Height
-1));
1707 for i
:= 0 to Height
-1 do
1711 Move(ps
^, pd
^, Width
*3);
1722 obufsize
:= (Width
*3+1)*Height
*2;
1723 GetMem(obuf
, obufsize
);
1728 res
:= compress2(Pointer(obuf
), dlen
, Pointer(pixels
), (Width
*3+1)*Height
, 9);
1729 if res
= Z_OK
then break
;
1730 if res
<> Z_BUF_ERROR
then raise Exception
.Create('can''t pack data for PNG');
1731 obufsize
:= obufsize
*2;
1734 GetMem(obuf
, obufsize
);
1736 //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
1749 st
.writeBuffer(sign
, 8);
1750 //e_WriteLog('PNG: signature written', MSG_NOTIFY);
1753 writeIntBE(st
, LongWord(13));
1758 st
.writeBuffer(sign
, 4);
1759 crc
:= crc32(0, @sign
, 4);
1762 hbuf
[2] := (Width
shr 8) and $ff;
1763 hbuf
[3] := Width
and $ff;
1766 hbuf
[6] := (Height
shr 8) and $ff;
1767 hbuf
[7] := Height
and $ff;
1768 hbuf
[8] := 8; // bit depth
1769 hbuf
[9] := 2; // RGB
1770 hbuf
[10] := 0; // compression method
1771 hbuf
[11] := 0; // filter method
1772 hbuf
[12] := 0; // no interlace
1773 crc
:= crc32(crc
, @hbuf
, 13);
1774 st
.writeBuffer(hbuf
, 13);
1775 writeIntBE(st
, crc
);
1776 //e_WriteLog('PNG: header written', MSG_NOTIFY);
1779 writeIntBE(st
, LongWord(dlen
));
1784 st
.writeBuffer(sign
, 4);
1785 crc
:= crc32(0, @sign
, 4);
1786 crc
:= crc32(crc
, obuf
, dlen
);
1787 st
.writeBuffer(obuf
^, dlen
);
1788 writeIntBE(st
, crc
);
1789 //e_WriteLog('PNG: image data written', MSG_NOTIFY);
1792 writeIntBE(st
, LongWord(0));
1797 st
.writeBuffer(sign
, 4);
1798 crc
:= crc32(0, @sign
, 4);
1799 writeIntBE(st
, crc
);
1800 //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
1802 if obuf
<> nil then FreeMem(obuf
);