9f9bfa20f348a020eb03fec23d8a42b4b16df184
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;
140 TTextureFont
= record
150 Chars
: array[0..255] of
160 TSavedTexture
= record
167 e_Textures
: array of TTexture
= nil;
168 e_TextureFonts
: array of TTextureFont
= nil;
169 e_CharFonts
: array of TCharFont
;
170 //e_SavedTextures: array of TSavedTexture;
172 //------------------------------------------------------------------
173 // Èíèöèàëèçèðóåò OpenGL
174 //------------------------------------------------------------------
175 procedure e_InitGL();
179 e_DummyTextures
:= True;
185 glDisable(GL_DEPTH_TEST
);
186 glEnable(GL_SCISSOR_TEST
);
187 glClearColor(0, 0, 0, 0);
190 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
192 mat
: Array [0..15] of GLDouble
;
195 if e_NoGraphics
then Exit
;
197 glScissor(X
, Y
, Width
, Height
);
198 glViewport(X
, Y
, Width
, Height
);
199 //gluOrtho2D(0, Width, Height, 0);
201 glMatrixMode(GL_PROJECTION
);
203 mat
[ 0] := 2.0 / Width
;
209 mat
[ 5] := -2.0 / Height
;
223 glLoadMatrixd(@mat
[0]);
225 glMatrixMode(GL_MODELVIEW
);
229 //------------------------------------------------------------------
230 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
231 //------------------------------------------------------------------
232 function FindTexture(): DWORD
;
236 if e_Textures
<> nil then
237 for i
:= 0 to High(e_Textures
) do
238 if e_Textures
[i
].Width
= 0 then
244 if e_Textures
= nil then
246 SetLength(e_Textures
, 32);
251 Result
:= High(e_Textures
) + 1;
252 SetLength(e_Textures
, Length(e_Textures
) + 32);
256 //------------------------------------------------------------------
258 //------------------------------------------------------------------
259 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
266 e_WriteLog('Loading texture from '+FileName
, MSG_NOTIFY
);
268 find_id
:= FindTexture();
270 if not LoadTexture(FileName
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].Width
,
271 e_Textures
[find_id
].Height
, @fmt
) then Exit
;
274 e_Textures
[ID
].Fmt
:= fmt
;
279 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
286 find_id
:= FindTexture();
288 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
290 e_Textures
[find_id
].Width
:= fWidth
;
291 e_Textures
[find_id
].Height
:= fHeight
;
292 e_Textures
[find_id
].Fmt
:= fmt
;
299 function e_CreateTextureMem(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
): Boolean;
306 find_id
:= FindTexture
;
308 if not LoadTextureMem(pData
, dataSize
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].Width
, e_Textures
[find_id
].Height
, @fmt
) then exit
;
311 e_Textures
[id
].Fmt
:= fmt
;
316 function e_CreateTextureMemEx(pData
: Pointer; dataSize
: LongInt; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
323 find_id
:= FindTexture();
325 if not LoadTextureMemEx(pData
, dataSize
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
327 e_Textures
[find_id
].Width
:= fWidth
;
328 e_Textures
[find_id
].Height
:= fHeight
;
329 e_Textures
[find_id
].Fmt
:= fmt
;
336 function e_CreateTextureImg (var img
: TImageData
; var ID
: DWORD
): Boolean;
342 find_id
:= FindTexture();
343 if not LoadTextureImg(img
, e_Textures
[find_id
].tx
, tw
, th
, @fmt
) then exit
;
344 //writeln(' tw=', tw, '; th=', th);
345 e_Textures
[find_id
].Width
:= tw
;
346 e_Textures
[find_id
].Height
:= th
;
347 e_Textures
[find_id
].Fmt
:= fmt
;
352 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
354 if Width
<> nil then Width
^ := e_Textures
[ID
].Width
;
355 if Height
<> nil then Height
^ := e_Textures
[ID
].Height
;
358 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
366 w
:= e_Textures
[ID
].Width
;
367 h
:= e_Textures
[ID
].Height
;
374 if e_NoGraphics
then Exit
;
376 data
:= GetMemory(w
*h
*4);
377 glEnable(GL_TEXTURE_2D
);
378 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
379 glGetTexImage(GL_TEXTURE_2D
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, data
);
381 for y
:= h
-1 downto 0 do
388 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
394 Result
.Y
:= h
-lastline
;
406 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
412 Result
.Height
:= h
-lastline
-Result
.Y
;
424 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
430 Result
.X
:= lastline
+1;
435 for x
:= w
-1 downto 0 do
442 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
448 Result
.Width
:= lastline
-Result
.X
+1;
456 procedure e_ResizeWindow(Width
, Height
: Integer);
460 e_SetViewPort(0, 0, Width
, Height
);
463 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
464 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
468 if e_NoGraphics
then Exit
;
469 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
471 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
476 if (AlphaChannel
) or (Alpha
> 0) then
477 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
480 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
483 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
485 glEnable(GL_TEXTURE_2D
);
486 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
489 u
:= e_Textures
[ID
].tx
.u
;
490 v
:= e_Textures
[ID
].tx
.v
;
492 if Mirror
= M_NONE
then
494 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
495 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
496 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
497 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
500 if Mirror
= M_HORIZONTAL
then
502 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
503 glTexCoord2f(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
504 glTexCoord2f(0, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
505 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
508 if Mirror
= M_VERTICAL
then
510 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
511 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
512 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
513 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
521 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
522 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
526 if e_NoGraphics
then Exit
;
527 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
529 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
534 if (AlphaChannel
) or (Alpha
> 0) then
535 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
538 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
541 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
543 glEnable(GL_TEXTURE_2D
);
544 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
546 u
:= e_Textures
[ID
].tx
.u
;
547 v
:= e_Textures
[ID
].tx
.v
;
550 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
551 glTexCoord2f(u
, v
); glVertex2i(X
+ Width
, Y
);
552 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
553 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
559 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
560 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
564 if e_NoGraphics
then Exit
;
565 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
567 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
572 if (AlphaChannel
) or (Alpha
> 0) then
573 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
576 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
579 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
581 glEnable(GL_TEXTURE_2D
);
582 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
585 u
:= e_Textures
[ID
].tx
.u
;
586 v
:= e_Textures
[ID
].tx
.v
;
588 if Mirror
= M_NONE
then
590 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
);
591 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
592 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ Height
);
593 glTexCoord2f(u
, -v
); glVertex2i(X
+ Width
, Y
+ Height
);
596 if Mirror
= M_HORIZONTAL
then
598 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
599 glTexCoord2f(0, 0); glVertex2i(X
+ Width
, Y
);
600 glTexCoord2f(0, -v
); glVertex2i(X
+ Width
, Y
+ Height
);
601 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ Height
);
604 if Mirror
= M_VERTICAL
then
606 glTexCoord2f(u
, -v
); glVertex2i(X
+ Width
, Y
);
607 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
608 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
609 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
617 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
618 AlphaChannel
: Boolean; Blending
: Boolean);
620 X2
, Y2
, dx
, w
, h
: Integer;
623 if e_NoGraphics
then Exit
;
624 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
626 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
631 if (AlphaChannel
) or (Alpha
> 0) then
632 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
635 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
638 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
646 glEnable(GL_TEXTURE_2D
);
647 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
649 X2
:= X
+ e_Textures
[ID
].Width
* XCount
;
650 Y2
:= Y
+ e_Textures
[ID
].Height
* YCount
;
652 //k8: this SHOULD work... i hope
653 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
656 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
657 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
658 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
659 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
666 u
:= e_Textures
[ID
].tx
.u
;
667 v
:= e_Textures
[ID
].tx
.v
;
668 w
:= e_Textures
[ID
].tx
.width
;
669 h
:= e_Textures
[ID
].tx
.height
;
676 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
677 glTexCoord2f(u
, v
); glVertex2i(X
+w
, Y
);
678 glTexCoord2f(u
, 0); glVertex2i(X
+w
, Y
+h
);
679 glTexCoord2f(0, 0); glVertex2i(X
, Y
+h
);
693 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
694 Blending
: Boolean; Angle
: Single; RC
: PPoint
; Mirror
: TMirrorType
= M_NONE
);
698 if e_NoGraphics
then Exit
;
699 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
701 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
706 if (AlphaChannel
) or (Alpha
> 0) then
707 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
710 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
713 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
715 if (Angle
<> 0) and (RC
<> nil) then
718 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
719 glRotatef(Angle
, 0, 0, 1);
720 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
723 glEnable(GL_TEXTURE_2D
);
724 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
725 glBegin(GL_QUADS
); //0-1 1-1
728 u
:= e_Textures
[ID
].tx
.u
;
729 v
:= e_Textures
[ID
].tx
.v
;
731 if Mirror
= M_NONE
then
733 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
734 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
735 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
736 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
739 if Mirror
= M_HORIZONTAL
then
741 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
742 glTexCoord2f(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
743 glTexCoord2f(0, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
744 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
747 if Mirror
= M_VERTICAL
then
749 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
750 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
751 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
752 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
763 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
765 if e_NoGraphics
then Exit
;
766 glDisable(GL_TEXTURE_2D
);
767 glColor3ub(Red
, Green
, Blue
);
770 if (Size
= 2) or (Size
= 4) then
774 glVertex2f(X
+0.3, Y
+1.0);
777 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
780 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
782 // Make lines only top-left/bottom-right and top-right/bottom-left
794 // Pixel-perfect hack
802 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
804 nX1
, nY1
, nX2
, nY2
: Integer;
806 if e_NoGraphics
then Exit
;
807 // Only top-left/bottom-right quad
824 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
828 glDisable(GL_TEXTURE_2D
);
829 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
833 nX1
:= X1
; nY1
:= Y1
;
834 nX2
:= X2
; nY2
:= Y1
;
835 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
836 glVertex2i(nX1
, nY1
);
837 glVertex2i(nX2
, nY2
);
839 nX1
:= X2
; nY1
:= Y1
;
840 nX2
:= X2
; nY2
:= Y2
;
841 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
842 glVertex2i(nX1
, nY1
);
843 glVertex2i(nX2
, nY2
);
845 nX1
:= X2
; nY1
:= Y2
;
846 nX2
:= X1
; nY2
:= Y2
;
847 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
848 glVertex2i(nX1
, nY1
);
849 glVertex2i(nX2
, nY2
);
851 nX1
:= X1
; nY1
:= Y2
;
852 nX2
:= X1
; nY2
:= Y1
;
853 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
854 glVertex2i(nX1
, nY1
);
855 glVertex2i(nX2
, nY2
);
858 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
863 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
864 Blending
: TBlending
= B_NONE
);
866 if e_NoGraphics
then Exit
;
867 if (Alpha
> 0) or (Blending
<> B_NONE
) then
872 if Blending
= B_BLEND
then
873 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
875 if Blending
= B_FILTER
then
876 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
878 if Blending
= B_INVERT
then
879 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
882 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
884 glDisable(GL_TEXTURE_2D
);
885 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
897 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
902 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
904 if e_NoGraphics
then Exit
;
905 // Pixel-perfect lines
907 e_LineCorrection(X1
, Y1
, X2
, Y2
);
912 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
916 glDisable(GL_TEXTURE_2D
);
917 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
925 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
930 //------------------------------------------------------------------
931 // Óäàëÿåò òåêñòóðó èç ìàññèâà
932 //------------------------------------------------------------------
933 procedure e_DeleteTexture(ID
: DWORD
);
935 if not e_NoGraphics
then
936 glDeleteTextures(1, @e_Textures
[ID
].tx
.id
);
937 e_Textures
[ID
].tx
.id
:= 0;
938 e_Textures
[ID
].Width
:= 0;
939 e_Textures
[ID
].Height
:= 0;
942 //------------------------------------------------------------------
943 // Óäàëÿåò âñå òåêñòóðû
944 //------------------------------------------------------------------
945 procedure e_RemoveAllTextures();
949 if e_Textures
= nil then Exit
;
951 for i
:= 0 to High(e_Textures
) do
952 if e_Textures
[i
].Width
<> 0 then e_DeleteTexture(i
);
956 //------------------------------------------------------------------
958 //------------------------------------------------------------------
959 procedure e_ReleaseEngine();
962 e_RemoveAllTextureFont
;
965 procedure e_BeginRender();
967 if e_NoGraphics
then Exit
;
968 glEnable(GL_ALPHA_TEST
);
969 glAlphaFunc(GL_GREATER
, 0.0);
972 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
974 if e_NoGraphics
then Exit
;
975 glClearColor(Red
, Green
, Blue
, 0);
979 procedure e_Clear(); overload
;
981 if e_NoGraphics
then Exit
;
982 glClearColor(0, 0, 0, 0);
983 glClear(GL_COLOR_BUFFER_BIT
);
986 procedure e_EndRender();
988 if e_NoGraphics
then Exit
;
992 function e_GetGamma(win
: PSDL_Window
): Byte;
994 ramp
: array [0..256*3-1] of Word;
995 rgb
: array [0..2] of Double;
1004 if e_NoGraphics
then Exit
;
1009 SDL_GetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1018 for j
:= min
to max
- 1 do
1021 B
:= (j
mod 256)/256;
1023 sum
:= sum
+ ln(A
)/ln(B
);
1026 rgb
[i
] := sum
/ count
;
1029 Result
:= 100 - Trunc(((rgb
[0] + rgb
[1] + rgb
[2])/3 - 0.23) * 100/(2.7 - 0.23));
1032 procedure e_SetGamma(win
: PSDL_Window
; Gamma
: Byte);
1034 ramp
: array [0..256*3-1] of Word;
1039 if e_NoGraphics
then Exit
;
1040 g
:= (100 - Gamma
)*(2.7 - 0.23)/100 + 0.23;
1042 for i
:= 0 to 255 do
1044 r
:= Exp(g
* ln(i
/256))*65536;
1045 if r
< 0 then r
:= 0
1046 else if r
> 65535 then r
:= 65535;
1047 ramp
[i
] := trunc(r
);
1048 ramp
[i
+ 256] := trunc(r
);
1049 ramp
[i
+ 512] := trunc(r
);
1052 SDL_SetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1055 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1059 e_WriteLog('Creating CharFont...', MSG_NOTIFY
);
1063 if e_CharFonts
<> nil then
1064 for i
:= 0 to High(e_CharFonts
) do
1065 if not e_CharFonts
[i
].Live
then
1071 if id
= DWORD(-1) then
1073 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1074 id
:= High(e_CharFonts
);
1077 with e_CharFonts
[id
] do
1079 for i
:= 0 to High(Chars
) do
1093 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1095 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1097 TextureID
:= Texture
;
1102 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1106 if e_NoGraphics
then Exit
;
1107 if Text = '' then Exit
;
1108 if e_CharFonts
= nil then Exit
;
1109 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1111 with e_CharFonts
[FontID
] do
1113 for a
:= 1 to Length(Text) do
1114 with Chars
[Ord(Text[a
])] do
1115 if TextureID
<> -1 then
1117 e_Draw(TextureID
, X
, Y
, 0, True, False);
1118 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1123 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1124 Color
: TRGB
; Scale
: Single = 1.0);
1129 if e_NoGraphics
then Exit
;
1130 if Text = '' then Exit
;
1131 if e_CharFonts
= nil then Exit
;
1132 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1134 with e_CharFonts
[FontID
] do
1136 for a
:= 1 to Length(Text) do
1137 with Chars
[Ord(Text[a
])] do
1138 if TextureID
<> -1 then
1140 if Scale
<> 1.0 then
1143 glScalef(Scale
, Scale
, 0);
1148 e_Draw(TextureID
, X
, Y
, 0, True, False);
1151 if Scale
<> 1.0 then glPopMatrix
;
1153 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1158 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1160 a
, TX
, TY
, len
: Integer;
1164 if e_NoGraphics
then Exit
;
1165 if Text = '' then Exit
;
1166 if e_CharFonts
= nil then Exit
;
1167 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1175 len
:= Length(Text);
1177 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1179 with e_CharFonts
[FontID
] do
1181 for a
:= 1 to len
do
1192 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1197 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1202 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1207 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1212 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1217 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1222 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1227 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1232 with Chars
[Ord(Text[a
])] do
1233 if TextureID
<> -1 then
1237 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1240 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1246 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1254 if Text = '' then Exit
;
1255 if e_CharFonts
= nil then Exit
;
1256 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1258 with e_CharFonts
[FontID
] do
1260 for a
:= 1 to Length(Text) do
1261 with Chars
[Ord(Text[a
])] do
1262 if TextureID
<> -1 then
1264 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1265 e_GetTextureSize(TextureID
, nil, @h2
);
1266 if h2
> h
then h
:= h2
;
1271 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1273 a
, lines
, len
: Integer;
1280 if Text = '' then Exit
;
1281 if e_CharFonts
= nil then Exit
;
1282 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1285 len
:= Length(Text);
1287 with e_CharFonts
[FontID
] do
1289 for a
:= 1 to len
do
1291 if Text[a
] = #10 then
1301 else if Text[a
] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1304 with Chars
[Ord(Text[a
])] do
1305 if TextureID
<> -1 then
1307 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1308 e_GetTextureSize(TextureID
, nil, @h2
);
1309 if h2
> h
then h
:= h2
;
1319 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1325 if e_CharFonts
= nil then Exit
;
1326 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1328 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1329 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1332 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1339 if e_CharFonts
= nil then Exit
;
1340 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1342 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1344 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1345 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1347 if h2
> Result
then Result
:= h2
;
1351 procedure e_CharFont_Remove(FontID
: DWORD
);
1355 with e_CharFonts
[FontID
] do
1356 for a
:= 0 to High(Chars
) do
1357 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1359 e_CharFonts
[FontID
].Live
:= False;
1362 procedure e_CharFont_RemoveAll();
1366 if e_CharFonts
= nil then Exit
;
1368 for a
:= 0 to High(e_CharFonts
) do
1369 e_CharFont_Remove(a
);
1374 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1381 if e_NoGraphics
then Exit
;
1382 e_WriteLog('Creating texture font...', MSG_NOTIFY
);
1386 if e_TextureFonts
<> nil then
1387 for i
:= 0 to High(e_TextureFonts
) do
1388 if e_TextureFonts
[i
].Base
= 0 then
1394 if id
= DWORD(-1) then
1396 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1397 id
:= High(e_TextureFonts
);
1400 with e_TextureFonts
[id
] do
1402 Base
:= glGenLists(XCount
*YCount
);
1403 TextureID
:= e_Textures
[Tex
].tx
.id
;
1404 CharWidth
:= (e_Textures
[Tex
].Width
div XCount
)+Space
;
1405 CharHeight
:= e_Textures
[Tex
].Height
div YCount
;
1412 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1413 for loop1
:= 0 to XCount
*YCount
-1 do
1415 cx
:= (loop1
mod XCount
)/XCount
;
1416 cy
:= (loop1
div YCount
)/YCount
;
1418 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1420 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1421 glVertex2d(0, e_Textures
[Tex
].Height
div YCount
);
1423 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1424 glVertex2i(e_Textures
[Tex
].Width
div XCount
, e_Textures
[Tex
].Height
div YCount
);
1426 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1427 glVertex2i(e_Textures
[Tex
].Width
div XCount
, 0);
1429 glTexCoord2f(cx
, 1.0-cy
);
1432 glTranslated((e_Textures
[Tex
].Width
div XCount
)+Space
, 0, 0);
1439 procedure e_TextureFontKill(FontID
: DWORD
);
1441 if e_NoGraphics
then Exit
;
1442 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1443 e_TextureFonts
[FontID
].Base
:= 0;
1446 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1448 if e_NoGraphics
then Exit
;
1449 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1450 if Text = '' then Exit
;
1452 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1455 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1458 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1459 glEnable(GL_TEXTURE_2D
);
1460 glTranslated(x
, y
, 0);
1461 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1462 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1463 glDisable(GL_TEXTURE_2D
);
1466 glDisable(GL_BLEND
);
1469 // god forgive me for this, but i cannot figure out how to do it without lists
1470 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1472 if e_NoGraphics
then Exit
;
1477 glColor4ub(0, 0, 0, 128);
1478 glTranslated(X
+1, Y
+1, 0);
1479 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1484 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1485 glTranslated(X
, Y
, 0);
1486 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1491 procedure e_TextureFontPrintCharEx (X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1493 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1494 glEnable(GL_TEXTURE_2D
);
1495 //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1497 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1499 e_TextureFontPrintChar(X
, Y
, Ch
, FontID
, Shadow
);
1500 glDisable(GL_TEXTURE_2D
);
1501 glDisable(GL_BLEND
);
1504 function e_TextureFontCharWidth (ch
: Char; FontID
: DWORD
): Integer;
1506 result
:= e_TextureFonts
[FontID
].CharWidth
;
1509 procedure e_TextureFontPrintFmt(X
, Y
: Integer; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
1511 a
, TX
, TY
, len
: Integer;
1515 if e_NoGraphics
then Exit
;
1516 if Text = '' then Exit
;
1517 if e_TextureFonts
= nil then Exit
;
1518 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1526 len
:= Length(Text);
1528 w
:= e_TextureFonts
[FontID
].CharWidth
;
1530 with e_TextureFonts
[FontID
] do
1532 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1533 glEnable(GL_TEXTURE_2D
);
1534 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1536 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1539 for a
:= 1 to len
do
1550 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1555 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1560 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1565 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1570 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1575 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1580 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1585 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1592 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1597 glDisable(GL_TEXTURE_2D
);
1598 glDisable(GL_BLEND
);
1602 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1603 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1605 if e_NoGraphics
then Exit
;
1606 if Text = '' then Exit
;
1609 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1610 glEnable(GL_TEXTURE_2D
);
1611 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1613 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1618 glColor4ub(0, 0, 0, 128);
1619 glTranslated(x
+1, y
+1, 0);
1620 glScalef(Scale
, Scale
, 0);
1621 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1626 glColor4ub(Red
, Green
, Blue
, 255);
1627 glTranslated(x
, y
, 0);
1628 glScalef(Scale
, Scale
, 0);
1629 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1631 glDisable(GL_TEXTURE_2D
);
1633 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1634 glDisable(GL_BLEND
);
1637 procedure e_TextureFontGetSize(ID
: DWORD
; var CharWidth
, CharHeight
: Byte);
1641 if e_NoGraphics
then Exit
;
1642 if Integer(ID
) > High(e_TextureFonts
) then
1644 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1645 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1648 procedure e_RemoveAllTextureFont();
1652 if e_NoGraphics
then Exit
;
1653 if e_TextureFonts
= nil then Exit
;
1655 for i
:= 0 to High(e_TextureFonts
) do
1656 if e_TextureFonts
[i
].Base
<> 0 then
1658 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1659 e_TextureFonts
[i
].Base
:= 0;
1662 e_TextureFonts
:= nil;
1665 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1672 function _Point(X
, Y
: Integer): TPoint2i
;
1678 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1682 Result
.Width
:= Width
;
1683 Result
.Height
:= Height
;
1686 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
1695 procedure e_MakeScreenshot (st
: TStream
; Width
, Height
: Word);
1697 pixels
, obuf
, scln
, ps
, pd
: PByte;
1701 sign
: array [0..7] of Byte;
1702 hbuf
: array [0..12] of Byte;
1705 if e_NoGraphics
then Exit
;
1708 // first, extract and pack graphics data
1710 if (Width
mod 4) > 0 then Width
:= Width
+ 4 - (Width
mod 4);
1712 GetMem(pixels
, Width
*Height
*3);
1714 FillChar(pixels
^, Width
*Height
*3, 0);
1715 glReadPixels(0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pixels
);
1716 //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
1719 GetMem(scln
, (Width
*3+1)*Height
);
1723 Inc(ps
, (Width
*3)*(Height
-1));
1724 for i
:= 0 to Height
-1 do
1728 Move(ps
^, pd
^, Width
*3);
1739 obufsize
:= (Width
*3+1)*Height
*2;
1740 GetMem(obuf
, obufsize
);
1745 res
:= compress2(Pointer(obuf
), dlen
, Pointer(pixels
), (Width
*3+1)*Height
, 9);
1746 if res
= Z_OK
then break
;
1747 if res
<> Z_BUF_ERROR
then raise Exception
.Create('can''t pack data for PNG');
1748 obufsize
:= obufsize
*2;
1751 GetMem(obuf
, obufsize
);
1753 //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
1766 st
.writeBuffer(sign
, 8);
1767 //e_WriteLog('PNG: signature written', MSG_NOTIFY);
1770 writeIntBE(st
, LongWord(13));
1775 st
.writeBuffer(sign
, 4);
1776 crc
:= crc32(0, @sign
, 4);
1779 hbuf
[2] := (Width
shr 8) and $ff;
1780 hbuf
[3] := Width
and $ff;
1783 hbuf
[6] := (Height
shr 8) and $ff;
1784 hbuf
[7] := Height
and $ff;
1785 hbuf
[8] := 8; // bit depth
1786 hbuf
[9] := 2; // RGB
1787 hbuf
[10] := 0; // compression method
1788 hbuf
[11] := 0; // filter method
1789 hbuf
[12] := 0; // no interlace
1790 crc
:= crc32(crc
, @hbuf
, 13);
1791 st
.writeBuffer(hbuf
, 13);
1792 writeIntBE(st
, crc
);
1793 //e_WriteLog('PNG: header written', MSG_NOTIFY);
1796 writeIntBE(st
, LongWord(dlen
));
1801 st
.writeBuffer(sign
, 4);
1802 crc
:= crc32(0, @sign
, 4);
1803 crc
:= crc32(crc
, obuf
, dlen
);
1804 st
.writeBuffer(obuf
^, dlen
);
1805 writeIntBE(st
, crc
);
1806 //e_WriteLog('PNG: image data written', MSG_NOTIFY);
1809 writeIntBE(st
, LongWord(0));
1814 st
.writeBuffer(sign
, 4);
1815 crc
:= crc32(0, @sign
, 4);
1816 writeIntBE(st
, crc
);
1817 //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
1819 if obuf
<> nil then FreeMem(obuf
);