7 SysUtils
, 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; var ID
: DWORD
): Boolean;
69 function e_CreateTextureMemEx(pData
: Pointer; 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 procedure e_ReleaseEngine();
101 procedure e_BeginRender();
102 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
103 procedure e_Clear(); overload
;
104 procedure e_EndRender();
106 function e_GetGamma(win
: PSDL_Window
): Byte;
107 procedure e_SetGamma(win
: PSDL_Window
;Gamma
: Byte);
109 procedure e_MakeScreenshot(FileName
: string; Width
, Height
: Word);
111 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
112 function _Point(X
, Y
: Integer): TPoint2i
;
113 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
114 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
119 e_NoGraphics
: Boolean = False;
125 BITMAPINFOHEADER
= record
131 biCompression
: DWORD
;
133 biXPelsPerMeter
: LONG
;
134 biYPelsPerMeter
: LONG
;
136 biClrImportant
: DWORD
;
138 LPBITMAPINFOHEADER
= ^BITMAPINFOHEADER
;
139 TBITMAPINFOHEADER
= BITMAPINFOHEADER
;
140 PBITMAPINFOHEADER
= ^BITMAPINFOHEADER
;
148 tagRGBQUAD
= RGBQUAD
;
153 bmiHeader
: BITMAPINFOHEADER
;
154 bmiColors
: array[0..0] of RGBQUAD
;
156 LPBITMAPINFO
= ^BITMAPINFO
;
157 PBITMAPINFO
= ^BITMAPINFO
;
158 TBITMAPINFO
= BITMAPINFO
;
160 BITMAPFILEHEADER
= packed record
167 tagBITMAPFILEHEADER
= BITMAPFILEHEADER
;
178 TTextureFont
= record
188 Chars
: array[0..255] of
198 TSavedTexture
= record
205 e_Textures
: array of TTexture
= nil;
206 e_TextureFonts
: array of TTextureFont
= nil;
207 e_CharFonts
: array of TCharFont
;
208 //e_SavedTextures: array of TSavedTexture;
210 //------------------------------------------------------------------
211 // Èíèöèàëèçèðóåò OpenGL
212 //------------------------------------------------------------------
213 procedure e_InitGL();
217 e_DummyTextures
:= True;
223 glDisable(GL_DEPTH_TEST
);
224 glEnable(GL_SCISSOR_TEST
);
225 glClearColor(0, 0, 0, 0);
228 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
230 mat
: Array [0..15] of GLDouble
;
233 if e_NoGraphics
then Exit
;
235 glScissor(X
, Y
, Width
, Height
);
236 glViewport(X
, Y
, Width
, Height
);
237 //gluOrtho2D(0, Width, Height, 0);
239 glMatrixMode(GL_PROJECTION
);
241 mat
[ 0] := 2.0 / Width
;
247 mat
[ 5] := -2.0 / Height
;
261 glLoadMatrixd(@mat
[0]);
263 glMatrixMode(GL_MODELVIEW
);
267 //------------------------------------------------------------------
268 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
269 //------------------------------------------------------------------
270 function FindTexture(): DWORD
;
274 if e_Textures
<> nil then
275 for i
:= 0 to High(e_Textures
) do
276 if e_Textures
[i
].Width
= 0 then
282 if e_Textures
= nil then
284 SetLength(e_Textures
, 32);
289 Result
:= High(e_Textures
) + 1;
290 SetLength(e_Textures
, Length(e_Textures
) + 32);
294 //------------------------------------------------------------------
296 //------------------------------------------------------------------
297 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
304 e_WriteLog('Loading texture from '+FileName
, MSG_NOTIFY
);
306 find_id
:= FindTexture();
308 if not LoadTexture(FileName
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].Width
,
309 e_Textures
[find_id
].Height
, @fmt
) then Exit
;
312 e_Textures
[ID
].Fmt
:= fmt
;
317 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
324 find_id
:= FindTexture();
326 if not LoadTextureEx(FileName
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
328 e_Textures
[find_id
].Width
:= fWidth
;
329 e_Textures
[find_id
].Height
:= fHeight
;
330 e_Textures
[find_id
].Fmt
:= fmt
;
337 function e_CreateTextureMem(pData
: Pointer; var ID
: DWORD
): Boolean;
344 find_id
:= FindTexture
;
346 if not LoadTextureMem(pData
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].Width
,
347 e_Textures
[find_id
].Height
, @fmt
) then exit
;
350 e_Textures
[id
].Fmt
:= fmt
;
355 function e_CreateTextureMemEx(pData
: Pointer; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
362 find_id
:= FindTexture();
364 if not LoadTextureMemEx(pData
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
366 e_Textures
[find_id
].Width
:= fWidth
;
367 e_Textures
[find_id
].Height
:= fHeight
;
368 e_Textures
[find_id
].Fmt
:= fmt
;
375 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
377 if Width
<> nil then Width
^ := e_Textures
[ID
].Width
;
378 if Height
<> nil then Height
^ := e_Textures
[ID
].Height
;
381 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
389 w
:= e_Textures
[ID
].Width
;
390 h
:= e_Textures
[ID
].Height
;
397 if e_NoGraphics
then Exit
;
399 data
:= GetMemory(w
*h
*4);
400 glEnable(GL_TEXTURE_2D
);
401 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
402 glGetTexImage(GL_TEXTURE_2D
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, data
);
404 for y
:= h
-1 downto 0 do
411 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
417 Result
.Y
:= h
-lastline
;
429 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
435 Result
.Height
:= h
-lastline
-Result
.Y
;
447 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
453 Result
.X
:= lastline
+1;
458 for x
:= w
-1 downto 0 do
465 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
471 Result
.Width
:= lastline
-Result
.X
+1;
479 procedure e_ResizeWindow(Width
, Height
: Integer);
483 e_SetViewPort(0, 0, Width
, Height
);
486 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
487 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
491 if e_NoGraphics
then Exit
;
492 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
494 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
499 if (AlphaChannel
) or (Alpha
> 0) then
500 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
503 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
506 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
508 glEnable(GL_TEXTURE_2D
);
509 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
512 u
:= e_Textures
[ID
].tx
.u
;
513 v
:= e_Textures
[ID
].tx
.v
;
515 if Mirror
= M_NONE
then
517 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
518 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
519 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
520 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
523 if Mirror
= M_HORIZONTAL
then
525 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
526 glTexCoord2f(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
527 glTexCoord2f(0, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
528 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
531 if Mirror
= M_VERTICAL
then
533 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
534 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
535 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
536 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
544 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
545 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
549 if e_NoGraphics
then Exit
;
550 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
552 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
557 if (AlphaChannel
) or (Alpha
> 0) then
558 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
561 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
564 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
566 glEnable(GL_TEXTURE_2D
);
567 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
569 u
:= e_Textures
[ID
].tx
.u
;
570 v
:= e_Textures
[ID
].tx
.v
;
573 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
574 glTexCoord2f(u
, v
); glVertex2i(X
+ Width
, Y
);
575 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
576 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
582 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
583 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
587 if e_NoGraphics
then Exit
;
588 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
590 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
595 if (AlphaChannel
) or (Alpha
> 0) then
596 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
599 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
602 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
604 glEnable(GL_TEXTURE_2D
);
605 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
608 u
:= e_Textures
[ID
].tx
.u
;
609 v
:= e_Textures
[ID
].tx
.v
;
611 if Mirror
= M_NONE
then
613 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
);
614 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
615 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ Height
);
616 glTexCoord2f(u
, -v
); glVertex2i(X
+ Width
, Y
+ Height
);
619 if Mirror
= M_HORIZONTAL
then
621 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
622 glTexCoord2f(0, 0); glVertex2i(X
+ Width
, Y
);
623 glTexCoord2f(0, -v
); glVertex2i(X
+ Width
, Y
+ Height
);
624 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ Height
);
627 if Mirror
= M_VERTICAL
then
629 glTexCoord2f(u
, -v
); glVertex2i(X
+ Width
, Y
);
630 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
631 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
632 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
640 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
641 AlphaChannel
: Boolean; Blending
: Boolean);
643 X2
, Y2
, dx
, w
, h
: Integer;
646 if e_NoGraphics
then Exit
;
647 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
649 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
654 if (AlphaChannel
) or (Alpha
> 0) then
655 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
658 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
661 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
669 glEnable(GL_TEXTURE_2D
);
670 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
672 X2
:= X
+ e_Textures
[ID
].Width
* XCount
;
673 Y2
:= Y
+ e_Textures
[ID
].Height
* YCount
;
675 //k8: this SHOULD work... i hope
676 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
679 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
680 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
681 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
682 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
689 u
:= e_Textures
[ID
].tx
.u
;
690 v
:= e_Textures
[ID
].tx
.v
;
691 w
:= e_Textures
[ID
].tx
.width
;
692 h
:= e_Textures
[ID
].tx
.height
;
699 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
700 glTexCoord2f(u
, v
); glVertex2i(X
+w
, Y
);
701 glTexCoord2f(u
, 0); glVertex2i(X
+w
, Y
+h
);
702 glTexCoord2f(0, 0); glVertex2i(X
, Y
+h
);
716 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
717 Blending
: Boolean; Angle
: Single; RC
: PPoint
; Mirror
: TMirrorType
= M_NONE
);
721 if e_NoGraphics
then Exit
;
722 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
724 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
729 if (AlphaChannel
) or (Alpha
> 0) then
730 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
733 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
736 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
738 if (Angle
<> 0) and (RC
<> nil) then
741 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
742 glRotatef(Angle
, 0, 0, 1);
743 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
746 glEnable(GL_TEXTURE_2D
);
747 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
748 glBegin(GL_QUADS
); //0-1 1-1
751 u
:= e_Textures
[ID
].tx
.u
;
752 v
:= e_Textures
[ID
].tx
.v
;
754 if Mirror
= M_NONE
then
756 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
757 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
758 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
759 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
762 if Mirror
= M_HORIZONTAL
then
764 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
765 glTexCoord2f(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
766 glTexCoord2f(0, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
767 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
770 if Mirror
= M_VERTICAL
then
772 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
773 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
774 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
775 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
786 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
788 if e_NoGraphics
then Exit
;
789 glDisable(GL_TEXTURE_2D
);
790 glColor3ub(Red
, Green
, Blue
);
793 if (Size
= 2) or (Size
= 4) then
797 glVertex2f(X
+0.3, Y
+1.0);
800 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
803 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
805 // Make lines only top-left/bottom-right and top-right/bottom-left
817 // Pixel-perfect hack
825 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
827 nX1
, nY1
, nX2
, nY2
: Integer;
829 if e_NoGraphics
then Exit
;
830 // Only top-left/bottom-right quad
847 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
851 glDisable(GL_TEXTURE_2D
);
852 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
856 nX1
:= X1
; nY1
:= Y1
;
857 nX2
:= X2
; nY2
:= Y1
;
858 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
859 glVertex2i(nX1
, nY1
);
860 glVertex2i(nX2
, nY2
);
862 nX1
:= X2
; nY1
:= Y1
;
863 nX2
:= X2
; nY2
:= Y2
;
864 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
865 glVertex2i(nX1
, nY1
);
866 glVertex2i(nX2
, nY2
);
868 nX1
:= X2
; nY1
:= Y2
;
869 nX2
:= X1
; nY2
:= Y2
;
870 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
871 glVertex2i(nX1
, nY1
);
872 glVertex2i(nX2
, nY2
);
874 nX1
:= X1
; nY1
:= Y2
;
875 nX2
:= X1
; nY2
:= Y1
;
876 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
877 glVertex2i(nX1
, nY1
);
878 glVertex2i(nX2
, nY2
);
881 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
886 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
887 Blending
: TBlending
= B_NONE
);
889 if e_NoGraphics
then Exit
;
890 if (Alpha
> 0) or (Blending
<> B_NONE
) then
895 if Blending
= B_BLEND
then
896 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
898 if Blending
= B_FILTER
then
899 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
901 if Blending
= B_INVERT
then
902 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
905 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
907 glDisable(GL_TEXTURE_2D
);
908 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
920 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
925 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
927 if e_NoGraphics
then Exit
;
928 // Pixel-perfect lines
930 e_LineCorrection(X1
, Y1
, X2
, Y2
);
935 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
939 glDisable(GL_TEXTURE_2D
);
940 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
948 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
953 //------------------------------------------------------------------
954 // Óäàëÿåò òåêñòóðó èç ìàññèâà
955 //------------------------------------------------------------------
956 procedure e_DeleteTexture(ID
: DWORD
);
958 if not e_NoGraphics
then
959 glDeleteTextures(1, @e_Textures
[ID
].tx
.id
);
960 e_Textures
[ID
].tx
.id
:= 0;
961 e_Textures
[ID
].Width
:= 0;
962 e_Textures
[ID
].Height
:= 0;
965 //------------------------------------------------------------------
966 // Óäàëÿåò âñå òåêñòóðû
967 //------------------------------------------------------------------
968 procedure e_RemoveAllTextures();
972 if e_Textures
= nil then Exit
;
974 for i
:= 0 to High(e_Textures
) do
975 if e_Textures
[i
].Width
<> 0 then e_DeleteTexture(i
);
979 //------------------------------------------------------------------
981 //------------------------------------------------------------------
982 procedure e_ReleaseEngine();
985 e_RemoveAllTextureFont
;
988 procedure e_BeginRender();
990 if e_NoGraphics
then Exit
;
991 glEnable(GL_ALPHA_TEST
);
992 glAlphaFunc(GL_GREATER
, 0.0);
995 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
997 if e_NoGraphics
then Exit
;
998 glClearColor(Red
, Green
, Blue
, 0);
1002 procedure e_Clear(); overload
;
1004 if e_NoGraphics
then Exit
;
1005 glClearColor(0, 0, 0, 0);
1006 glClear(GL_COLOR_BUFFER_BIT
);
1009 procedure e_EndRender();
1011 if e_NoGraphics
then Exit
;
1015 procedure e_MakeScreenshot(FileName
: String; Width
, Height
: Word);
1017 aRGB
= Array [0..1] of TRGB
;
1019 TByteArray
= Array [0..1] of Byte;
1020 PByteArray
= ^TByteArray
;
1022 FILEHEADER
: BITMAPFILEHEADER
;
1023 INFOHEADER
: BITMAPINFOHEADER
;
1029 if e_NoGraphics
then Exit
;
1031 if (Width
mod 4) > 0 then
1032 Width
:= Width
+ 4 - (Width
mod 4);
1034 GetMem(pixels
, Width
*Height
*3);
1035 glReadPixels(0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pixels
);
1037 for i
:= 0 to Width
* Height
- 1 do
1038 with PaRGB(pixels
)[i
] do
1047 bfType
:= $4D42; // "BM"
1048 bfSize
:= Width
*Height
*3 + SizeOf(BITMAPFILEHEADER
) + SizeOf(BITMAPINFOHEADER
);
1051 bfOffBits
:= SizeOf(BITMAPFILEHEADER
) + SizeOf(BITMAPINFOHEADER
);
1056 biSize
:= SizeOf(BITMAPINFOHEADER
);
1062 biSizeImage
:= Width
*Height
*3;
1063 biXPelsPerMeter
:= 0;
1064 biYPelsPerMeter
:= 0;
1066 biClrImportant
:= 0;
1069 //writeln('shot: ', FileName);
1070 AssignFile(F
, FileName
);
1073 BlockWrite(F
, FILEHEADER
, SizeOf(FILEHEADER
));
1074 BlockWrite(F
, INFOHEADER
, SizeOf(INFOHEADER
));
1075 BlockWrite(F
, pixels
[0], Width
*Height
*3);
1082 function e_GetGamma(win
: PSDL_Window
): Byte;
1084 ramp
: array [0..256*3-1] of Word;
1085 rgb
: array [0..2] of Double;
1094 if e_NoGraphics
then Exit
;
1099 SDL_GetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1108 for j
:= min
to max
- 1 do
1111 B
:= (j
mod 256)/256;
1113 sum
:= sum
+ ln(A
)/ln(B
);
1116 rgb
[i
] := sum
/ count
;
1119 Result
:= 100 - Trunc(((rgb
[0] + rgb
[1] + rgb
[2])/3 - 0.23) * 100/(2.7 - 0.23));
1122 procedure e_SetGamma(win
: PSDL_Window
; Gamma
: Byte);
1124 ramp
: array [0..256*3-1] of Word;
1129 if e_NoGraphics
then Exit
;
1130 g
:= (100 - Gamma
)*(2.7 - 0.23)/100 + 0.23;
1132 for i
:= 0 to 255 do
1134 r
:= Exp(g
* ln(i
/256))*65536;
1135 if r
< 0 then r
:= 0
1136 else if r
> 65535 then r
:= 65535;
1137 ramp
[i
] := trunc(r
);
1138 ramp
[i
+ 256] := trunc(r
);
1139 ramp
[i
+ 512] := trunc(r
);
1142 SDL_SetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1145 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1149 e_WriteLog('Creating CharFont...', MSG_NOTIFY
);
1153 if e_CharFonts
<> nil then
1154 for i
:= 0 to High(e_CharFonts
) do
1155 if not e_CharFonts
[i
].Live
then
1161 if id
= DWORD(-1) then
1163 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1164 id
:= High(e_CharFonts
);
1167 with e_CharFonts
[id
] do
1169 for i
:= 0 to High(Chars
) do
1183 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1185 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1187 TextureID
:= Texture
;
1192 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1196 if e_NoGraphics
then Exit
;
1197 if Text = '' then Exit
;
1198 if e_CharFonts
= nil then Exit
;
1199 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1201 with e_CharFonts
[FontID
] do
1203 for a
:= 1 to Length(Text) do
1204 with Chars
[Ord(Text[a
])] do
1205 if TextureID
<> -1 then
1207 e_Draw(TextureID
, X
, Y
, 0, True, False);
1208 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1213 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1214 Color
: TRGB
; Scale
: Single = 1.0);
1219 if e_NoGraphics
then Exit
;
1220 if Text = '' then Exit
;
1221 if e_CharFonts
= nil then Exit
;
1222 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1224 with e_CharFonts
[FontID
] do
1226 for a
:= 1 to Length(Text) do
1227 with Chars
[Ord(Text[a
])] do
1228 if TextureID
<> -1 then
1230 if Scale
<> 1.0 then
1233 glScalef(Scale
, Scale
, 0);
1238 e_Draw(TextureID
, X
, Y
, 0, True, False);
1241 if Scale
<> 1.0 then glPopMatrix
;
1243 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1248 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1250 a
, TX
, TY
, len
: Integer;
1254 if e_NoGraphics
then Exit
;
1255 if Text = '' then Exit
;
1256 if e_CharFonts
= nil then Exit
;
1257 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1265 len
:= Length(Text);
1267 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1269 with e_CharFonts
[FontID
] do
1271 for a
:= 1 to len
do
1282 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1287 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1292 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1297 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1302 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1307 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1312 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1317 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1322 with Chars
[Ord(Text[a
])] do
1323 if TextureID
<> -1 then
1327 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1330 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1336 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1344 if Text = '' then Exit
;
1345 if e_CharFonts
= nil then Exit
;
1346 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1348 with e_CharFonts
[FontID
] do
1350 for a
:= 1 to Length(Text) do
1351 with Chars
[Ord(Text[a
])] do
1352 if TextureID
<> -1 then
1354 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1355 e_GetTextureSize(TextureID
, nil, @h2
);
1356 if h2
> h
then h
:= h2
;
1361 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1363 a
, lines
, len
: Integer;
1370 if Text = '' then Exit
;
1371 if e_CharFonts
= nil then Exit
;
1372 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1375 len
:= Length(Text);
1377 with e_CharFonts
[FontID
] do
1379 for a
:= 1 to len
do
1381 if Text[a
] = #10 then
1391 else if Text[a
] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1394 with Chars
[Ord(Text[a
])] do
1395 if TextureID
<> -1 then
1397 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1398 e_GetTextureSize(TextureID
, nil, @h2
);
1399 if h2
> h
then h
:= h2
;
1409 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1415 if e_CharFonts
= nil then Exit
;
1416 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1418 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1419 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1422 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1429 if e_CharFonts
= nil then Exit
;
1430 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1432 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1434 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1435 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1437 if h2
> Result
then Result
:= h2
;
1441 procedure e_CharFont_Remove(FontID
: DWORD
);
1445 with e_CharFonts
[FontID
] do
1446 for a
:= 0 to High(Chars
) do
1447 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1449 e_CharFonts
[FontID
].Live
:= False;
1452 procedure e_CharFont_RemoveAll();
1456 if e_CharFonts
= nil then Exit
;
1458 for a
:= 0 to High(e_CharFonts
) do
1459 e_CharFont_Remove(a
);
1464 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1471 if e_NoGraphics
then Exit
;
1472 e_WriteLog('Creating texture font...', MSG_NOTIFY
);
1476 if e_TextureFonts
<> nil then
1477 for i
:= 0 to High(e_TextureFonts
) do
1478 if e_TextureFonts
[i
].Base
= 0 then
1484 if id
= DWORD(-1) then
1486 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1487 id
:= High(e_TextureFonts
);
1490 with e_TextureFonts
[id
] do
1492 Base
:= glGenLists(XCount
*YCount
);
1493 TextureID
:= e_Textures
[Tex
].tx
.id
;
1494 CharWidth
:= (e_Textures
[Tex
].Width
div XCount
)+Space
;
1495 CharHeight
:= e_Textures
[Tex
].Height
div YCount
;
1502 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1503 for loop1
:= 0 to XCount
*YCount
-1 do
1505 cx
:= (loop1
mod XCount
)/XCount
;
1506 cy
:= (loop1
div YCount
)/YCount
;
1508 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1510 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1511 glVertex2d(0, e_Textures
[Tex
].Height
div YCount
);
1513 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1514 glVertex2i(e_Textures
[Tex
].Width
div XCount
, e_Textures
[Tex
].Height
div YCount
);
1516 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1517 glVertex2i(e_Textures
[Tex
].Width
div XCount
, 0);
1519 glTexCoord2f(cx
, 1.0-cy
);
1522 glTranslated((e_Textures
[Tex
].Width
div XCount
)+Space
, 0, 0);
1529 procedure e_TextureFontKill(FontID
: DWORD
);
1531 if e_NoGraphics
then Exit
;
1532 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1533 e_TextureFonts
[FontID
].Base
:= 0;
1536 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1538 if e_NoGraphics
then Exit
;
1539 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1540 if Text = '' then Exit
;
1542 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1545 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1548 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1549 glEnable(GL_TEXTURE_2D
);
1550 glTranslated(x
, y
, 0);
1551 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1552 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1553 glDisable(GL_TEXTURE_2D
);
1556 glDisable(GL_BLEND
);
1559 // god forgive me for this, but i cannot figure out how to do it without lists
1560 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1562 if e_NoGraphics
then Exit
;
1567 glColor4ub(0, 0, 0, 128);
1568 glTranslated(X
+1, Y
+1, 0);
1569 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1574 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1575 glTranslated(X
, Y
, 0);
1576 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1581 procedure e_TextureFontPrintFmt(X
, Y
: Integer; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
1583 a
, TX
, TY
, len
: Integer;
1587 if e_NoGraphics
then Exit
;
1588 if Text = '' then Exit
;
1589 if e_TextureFonts
= nil then Exit
;
1590 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1598 len
:= Length(Text);
1600 w
:= e_TextureFonts
[FontID
].CharWidth
;
1602 with e_TextureFonts
[FontID
] do
1604 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1605 glEnable(GL_TEXTURE_2D
);
1606 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1608 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1611 for a
:= 1 to len
do
1622 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1627 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1632 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1637 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1642 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1647 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1652 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1657 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1664 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1669 glDisable(GL_TEXTURE_2D
);
1670 glDisable(GL_BLEND
);
1674 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1675 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1677 if e_NoGraphics
then Exit
;
1678 if Text = '' then Exit
;
1681 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1682 glEnable(GL_TEXTURE_2D
);
1683 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1685 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1690 glColor4ub(0, 0, 0, 128);
1691 glTranslated(x
+1, y
+1, 0);
1692 glScalef(Scale
, Scale
, 0);
1693 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1698 glColor4ub(Red
, Green
, Blue
, 255);
1699 glTranslated(x
, y
, 0);
1700 glScalef(Scale
, Scale
, 0);
1701 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1703 glDisable(GL_TEXTURE_2D
);
1705 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1706 glDisable(GL_BLEND
);
1709 procedure e_TextureFontGetSize(ID
: DWORD
; var CharWidth
, CharHeight
: Byte);
1713 if e_NoGraphics
then Exit
;
1714 if Integer(ID
) > High(e_TextureFonts
) then
1716 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1717 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1720 procedure e_RemoveAllTextureFont();
1724 if e_NoGraphics
then Exit
;
1725 if e_TextureFonts
= nil then Exit
;
1727 for i
:= 0 to High(e_TextureFonts
) do
1728 if e_TextureFonts
[i
].Base
<> 0 then
1730 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1731 e_TextureFonts
[i
].Base
:= 0;
1734 e_TextureFonts
:= nil;
1737 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1744 function _Point(X
, Y
: Integer): TPoint2i
;
1750 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1754 Result
.Width
:= Width
;
1755 Result
.Height
:= Height
;
1758 function _TRect(L
, T
, R
, B
: LongInt): TRect
;