f2afd54004adf64ac075f26888dab9c23298e371
6 SysUtils
, Math
, e_log
, e_textures
, SDL2
, GL
, GLExt
, MAPDEF
;
9 TMirrorType
=(M_NONE
, M_HORIZONTAL
, M_VERTICAL
);
10 TBlending
=(B_NONE
, B_BLEND
, B_FILTER
, B_INVERT
);
16 TPoint
= MAPDEF
.TPoint
; // TODO: create an utiltypes.pas or something
17 // for other types like rect as well
24 Left
, Top
, Right
, Bottom
: Integer;
42 //------------------------------------------------------------------
44 //------------------------------------------------------------------
46 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
47 procedure e_ResizeWindow(Width
, Height
: Integer);
49 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
50 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
51 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
52 Blending
: Boolean; Angle
: Single; RC
: PPoint
; Mirror
: TMirrorType
= M_NONE
);
53 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
54 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
55 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
56 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
57 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
58 AlphaChannel
: Boolean; Blending
: Boolean);
59 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
60 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
61 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
62 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
63 Blending
: TBlending
= B_NONE
);
65 function e_CreateTexture(FileName
: string; var ID
: DWORD
): Boolean;
66 function e_CreateTextureEx(FileName
: string; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
67 function e_CreateTextureMem(pData
: Pointer; var ID
: DWORD
): Boolean;
68 function e_CreateTextureMemEx(pData
: Pointer; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
69 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
70 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
71 procedure e_DeleteTexture(ID
: DWORD
);
72 procedure e_RemoveAllTextures();
75 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
76 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
77 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
78 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
79 Color
: TRGB
; Scale
: Single = 1.0);
80 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
81 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
82 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
83 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
84 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
85 procedure e_CharFont_Remove(FontID
: DWORD
);
86 procedure e_CharFont_RemoveAll();
89 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
91 procedure e_TextureFontKill(FontID
: DWORD
);
92 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
93 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
94 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
95 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
96 procedure e_TextureFontGetSize(ID
: DWORD
; var CharWidth
, CharHeight
: Byte);
97 procedure e_RemoveAllTextureFont();
99 procedure e_ReleaseEngine();
100 procedure e_BeginRender();
101 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
102 procedure e_Clear(); overload
;
103 procedure e_EndRender();
105 function e_GetGamma(win
: PSDL_Window
): Byte;
106 procedure e_SetGamma(win
: PSDL_Window
;Gamma
: Byte);
108 procedure e_MakeScreenshot(FileName
: string; Width
, Height
: Word);
110 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
111 function _Point(X
, Y
: Integer): TPoint2i
;
112 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
113 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
118 e_NoGraphics
: Boolean = False;
124 BITMAPINFOHEADER
= record
130 biCompression
: DWORD
;
132 biXPelsPerMeter
: LONG
;
133 biYPelsPerMeter
: LONG
;
135 biClrImportant
: DWORD
;
137 LPBITMAPINFOHEADER
= ^BITMAPINFOHEADER
;
138 TBITMAPINFOHEADER
= BITMAPINFOHEADER
;
139 PBITMAPINFOHEADER
= ^BITMAPINFOHEADER
;
147 tagRGBQUAD
= RGBQUAD
;
152 bmiHeader
: BITMAPINFOHEADER
;
153 bmiColors
: array[0..0] of RGBQUAD
;
155 LPBITMAPINFO
= ^BITMAPINFO
;
156 PBITMAPINFO
= ^BITMAPINFO
;
157 TBITMAPINFO
= BITMAPINFO
;
159 BITMAPFILEHEADER
= packed record
166 tagBITMAPFILEHEADER
= BITMAPFILEHEADER
;
177 TTextureFont
= record
187 Chars
: array[0..255] of
197 TSavedTexture
= record
204 e_Textures
: array of TTexture
= nil;
205 e_TextureFonts
: array of TTextureFont
= nil;
206 e_CharFonts
: array of TCharFont
;
207 //e_SavedTextures: array of TSavedTexture;
209 //------------------------------------------------------------------
210 // Èíèöèàëèçèðóåò OpenGL
211 //------------------------------------------------------------------
212 procedure e_InitGL();
216 e_DummyTextures
:= True;
222 glDisable(GL_DEPTH_TEST
);
223 glEnable(GL_SCISSOR_TEST
);
224 glClearColor(0, 0, 0, 0);
227 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
229 mat
: Array [0..15] of GLDouble
;
232 if e_NoGraphics
then Exit
;
234 glScissor(X
, Y
, Width
, Height
);
235 glViewport(X
, Y
, Width
, Height
);
236 //gluOrtho2D(0, Width, Height, 0);
238 glMatrixMode(GL_PROJECTION
);
240 mat
[ 0] := 2.0 / Width
;
246 mat
[ 5] := -2.0 / Height
;
260 glLoadMatrixd(@mat
[0]);
262 glMatrixMode(GL_MODELVIEW
);
266 //------------------------------------------------------------------
267 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
268 //------------------------------------------------------------------
269 function FindTexture(): DWORD
;
273 if e_Textures
<> nil then
274 for i
:= 0 to High(e_Textures
) do
275 if e_Textures
[i
].Width
= 0 then
281 if e_Textures
= nil then
283 SetLength(e_Textures
, 32);
288 Result
:= High(e_Textures
) + 1;
289 SetLength(e_Textures
, Length(e_Textures
) + 32);
293 //------------------------------------------------------------------
295 //------------------------------------------------------------------
296 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
303 e_WriteLog('Loading texture from '+FileName
, MSG_NOTIFY
);
305 find_id
:= FindTexture();
307 if not LoadTexture(FileName
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].Width
,
308 e_Textures
[find_id
].Height
, @fmt
) then Exit
;
311 e_Textures
[ID
].Fmt
:= fmt
;
316 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
323 find_id
:= FindTexture();
325 if not LoadTextureEx(FileName
, 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_CreateTextureMem(pData
: Pointer; var ID
: DWORD
): Boolean;
343 find_id
:= FindTexture
;
345 if not LoadTextureMem(pData
, e_Textures
[find_id
].tx
, e_Textures
[find_id
].Width
,
346 e_Textures
[find_id
].Height
, @fmt
) then exit
;
349 e_Textures
[id
].Fmt
:= fmt
;
354 function e_CreateTextureMemEx(pData
: Pointer; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
361 find_id
:= FindTexture();
363 if not LoadTextureMemEx(pData
, e_Textures
[find_id
].tx
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
365 e_Textures
[find_id
].Width
:= fWidth
;
366 e_Textures
[find_id
].Height
:= fHeight
;
367 e_Textures
[find_id
].Fmt
:= fmt
;
374 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
376 if Width
<> nil then Width
^ := e_Textures
[ID
].Width
;
377 if Height
<> nil then Height
^ := e_Textures
[ID
].Height
;
380 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
388 w
:= e_Textures
[ID
].Width
;
389 h
:= e_Textures
[ID
].Height
;
396 if e_NoGraphics
then Exit
;
398 data
:= GetMemory(w
*h
*4);
399 glEnable(GL_TEXTURE_2D
);
400 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
401 glGetTexImage(GL_TEXTURE_2D
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, data
);
403 for y
:= h
-1 downto 0 do
410 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
416 Result
.Y
:= h
-lastline
;
428 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
434 Result
.Height
:= h
-lastline
-Result
.Y
;
446 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
452 Result
.X
:= lastline
+1;
457 for x
:= w
-1 downto 0 do
464 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
470 Result
.Width
:= lastline
-Result
.X
+1;
478 procedure e_ResizeWindow(Width
, Height
: Integer);
482 e_SetViewPort(0, 0, Width
, Height
);
485 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
486 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
490 if e_NoGraphics
then Exit
;
491 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
493 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
498 if (AlphaChannel
) or (Alpha
> 0) then
499 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
502 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
505 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
507 glEnable(GL_TEXTURE_2D
);
508 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
511 u
:= e_Textures
[ID
].tx
.u
;
512 v
:= e_Textures
[ID
].tx
.v
;
514 if Mirror
= M_NONE
then
516 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
517 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
518 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
519 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
522 if Mirror
= M_HORIZONTAL
then
524 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
525 glTexCoord2f(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
526 glTexCoord2f(0, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
527 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
530 if Mirror
= M_VERTICAL
then
532 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
533 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
534 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
535 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
543 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
544 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
548 if e_NoGraphics
then Exit
;
549 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
551 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
556 if (AlphaChannel
) or (Alpha
> 0) then
557 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
560 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
563 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
565 glEnable(GL_TEXTURE_2D
);
566 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
568 u
:= e_Textures
[ID
].tx
.u
;
569 v
:= e_Textures
[ID
].tx
.v
;
572 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
573 glTexCoord2f(u
, v
); glVertex2i(X
+ Width
, Y
);
574 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
575 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
581 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
582 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
586 if e_NoGraphics
then Exit
;
587 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
589 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
594 if (AlphaChannel
) or (Alpha
> 0) then
595 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
598 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
601 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
603 glEnable(GL_TEXTURE_2D
);
604 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
607 u
:= e_Textures
[ID
].tx
.u
;
608 v
:= e_Textures
[ID
].tx
.v
;
610 if Mirror
= M_NONE
then
612 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
);
613 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
614 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ Height
);
615 glTexCoord2f(u
, -v
); glVertex2i(X
+ Width
, Y
+ Height
);
618 if Mirror
= M_HORIZONTAL
then
620 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
621 glTexCoord2f(0, 0); glVertex2i(X
+ Width
, Y
);
622 glTexCoord2f(0, -v
); glVertex2i(X
+ Width
, Y
+ Height
);
623 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ Height
);
626 if Mirror
= M_VERTICAL
then
628 glTexCoord2f(u
, -v
); glVertex2i(X
+ Width
, Y
);
629 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
630 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ Height
);
631 glTexCoord2f(u
, 0); glVertex2i(X
+ Width
, Y
+ Height
);
639 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
640 AlphaChannel
: Boolean; Blending
: Boolean);
642 X2
, Y2
, dx
, w
, h
: Integer;
645 if e_NoGraphics
then Exit
;
646 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
648 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
653 if (AlphaChannel
) or (Alpha
> 0) then
654 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
657 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
660 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
668 glEnable(GL_TEXTURE_2D
);
669 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].tx
.id
);
671 X2
:= X
+ e_Textures
[ID
].Width
* XCount
;
672 Y2
:= Y
+ e_Textures
[ID
].Height
* YCount
;
674 //k8: this SHOULD work... i hope
675 if (e_Textures
[ID
].tx
.width
= e_Textures
[ID
].tx
.glwidth
) and (e_Textures
[ID
].tx
.height
= e_Textures
[ID
].tx
.glheight
) then
678 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
679 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
680 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
681 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
688 u
:= e_Textures
[ID
].tx
.u
;
689 v
:= e_Textures
[ID
].tx
.v
;
690 w
:= e_Textures
[ID
].tx
.width
;
691 h
:= e_Textures
[ID
].tx
.height
;
698 glTexCoord2f(0, v
); glVertex2i(X
, Y
);
699 glTexCoord2f(u
, v
); glVertex2i(X
+w
, Y
);
700 glTexCoord2f(u
, 0); glVertex2i(X
+w
, Y
+h
);
701 glTexCoord2f(0, 0); glVertex2i(X
, Y
+h
);
715 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
716 Blending
: Boolean; Angle
: Single; RC
: PPoint
; Mirror
: TMirrorType
= M_NONE
);
720 if e_NoGraphics
then Exit
;
721 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
723 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
728 if (AlphaChannel
) or (Alpha
> 0) then
729 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
732 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
735 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
737 if (Angle
<> 0) and (RC
<> nil) then
740 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
741 glRotatef(Angle
, 0, 0, 1);
742 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
745 glEnable(GL_TEXTURE_2D
);
746 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].tx
.id
);
747 glBegin(GL_QUADS
); //0-1 1-1
750 u
:= e_Textures
[ID
].tx
.u
;
751 v
:= e_Textures
[ID
].tx
.v
;
753 if Mirror
= M_NONE
then
755 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
756 glTexCoord2f(0, 0); glVertex2i(X
, Y
);
757 glTexCoord2f(0, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
758 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
761 if Mirror
= M_HORIZONTAL
then
763 glTexCoord2f(u
, 0); glVertex2i(X
, Y
);
764 glTexCoord2f(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
765 glTexCoord2f(0, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
766 glTexCoord2f(u
, -v
); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
769 if Mirror
= M_VERTICAL
then
771 glTexCoord2f(u
, -v
); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
772 glTexCoord2f(0, -v
); glVertex2i(X
, Y
);
773 glTexCoord2f(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
774 glTexCoord2f(u
, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
785 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
787 if e_NoGraphics
then Exit
;
788 glDisable(GL_TEXTURE_2D
);
789 glColor3ub(Red
, Green
, Blue
);
792 if (Size
= 2) or (Size
= 4) then
796 glVertex2f(X
+0.3, Y
+1.0);
799 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
802 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
804 // Make lines only top-left/bottom-right and top-right/bottom-left
816 // Pixel-perfect hack
824 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
826 nX1
, nY1
, nX2
, nY2
: Integer;
828 if e_NoGraphics
then Exit
;
829 // Only top-left/bottom-right quad
846 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
850 glDisable(GL_TEXTURE_2D
);
851 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
855 nX1
:= X1
; nY1
:= Y1
;
856 nX2
:= X2
; nY2
:= Y1
;
857 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
858 glVertex2i(nX1
, nY1
);
859 glVertex2i(nX2
, nY2
);
861 nX1
:= X2
; nY1
:= Y1
;
862 nX2
:= X2
; nY2
:= Y2
;
863 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
864 glVertex2i(nX1
, nY1
);
865 glVertex2i(nX2
, nY2
);
867 nX1
:= X2
; nY1
:= Y2
;
868 nX2
:= X1
; nY2
:= Y2
;
869 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
870 glVertex2i(nX1
, nY1
);
871 glVertex2i(nX2
, nY2
);
873 nX1
:= X1
; nY1
:= Y2
;
874 nX2
:= X1
; nY2
:= Y1
;
875 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
876 glVertex2i(nX1
, nY1
);
877 glVertex2i(nX2
, nY2
);
880 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
885 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
886 Blending
: TBlending
= B_NONE
);
888 if e_NoGraphics
then Exit
;
889 if (Alpha
> 0) or (Blending
<> B_NONE
) then
894 if Blending
= B_BLEND
then
895 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
897 if Blending
= B_FILTER
then
898 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
900 if Blending
= B_INVERT
then
901 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
904 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
906 glDisable(GL_TEXTURE_2D
);
907 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
919 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
924 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
926 if e_NoGraphics
then Exit
;
927 // Pixel-perfect lines
929 e_LineCorrection(X1
, Y1
, X2
, Y2
);
934 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
938 glDisable(GL_TEXTURE_2D
);
939 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
947 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
952 //------------------------------------------------------------------
953 // Óäàëÿåò òåêñòóðó èç ìàññèâà
954 //------------------------------------------------------------------
955 procedure e_DeleteTexture(ID
: DWORD
);
957 if not e_NoGraphics
then
958 glDeleteTextures(1, @e_Textures
[ID
].tx
.id
);
959 e_Textures
[ID
].tx
.id
:= 0;
960 e_Textures
[ID
].Width
:= 0;
961 e_Textures
[ID
].Height
:= 0;
964 //------------------------------------------------------------------
965 // Óäàëÿåò âñå òåêñòóðû
966 //------------------------------------------------------------------
967 procedure e_RemoveAllTextures();
971 if e_Textures
= nil then Exit
;
973 for i
:= 0 to High(e_Textures
) do
974 if e_Textures
[i
].Width
<> 0 then e_DeleteTexture(i
);
978 //------------------------------------------------------------------
980 //------------------------------------------------------------------
981 procedure e_ReleaseEngine();
984 e_RemoveAllTextureFont
;
987 procedure e_BeginRender();
989 if e_NoGraphics
then Exit
;
990 glEnable(GL_ALPHA_TEST
);
991 glAlphaFunc(GL_GREATER
, 0.0);
994 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
996 if e_NoGraphics
then Exit
;
997 glClearColor(Red
, Green
, Blue
, 0);
1001 procedure e_Clear(); overload
;
1003 if e_NoGraphics
then Exit
;
1004 glClearColor(0, 0, 0, 0);
1005 glClear(GL_COLOR_BUFFER_BIT
);
1008 procedure e_EndRender();
1010 if e_NoGraphics
then Exit
;
1014 procedure e_MakeScreenshot(FileName
: String; Width
, Height
: Word);
1016 aRGB
= Array [0..1] of TRGB
;
1018 TByteArray
= Array [0..1] of Byte;
1019 PByteArray
= ^TByteArray
;
1021 FILEHEADER
: BITMAPFILEHEADER
;
1022 INFOHEADER
: BITMAPINFOHEADER
;
1028 if e_NoGraphics
then Exit
;
1030 if (Width
mod 4) > 0 then
1031 Width
:= Width
+ 4 - (Width
mod 4);
1033 GetMem(pixels
, Width
*Height
*3);
1034 glReadPixels(0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pixels
);
1036 for i
:= 0 to Width
* Height
- 1 do
1037 with PaRGB(pixels
)[i
] do
1046 bfType
:= $4D42; // "BM"
1047 bfSize
:= Width
*Height
*3 + SizeOf(BITMAPFILEHEADER
) + SizeOf(BITMAPINFOHEADER
);
1050 bfOffBits
:= SizeOf(BITMAPFILEHEADER
) + SizeOf(BITMAPINFOHEADER
);
1055 biSize
:= SizeOf(BITMAPINFOHEADER
);
1061 biSizeImage
:= Width
*Height
*3;
1062 biXPelsPerMeter
:= 0;
1063 biYPelsPerMeter
:= 0;
1065 biClrImportant
:= 0;
1068 //writeln('shot: ', FileName);
1069 AssignFile(F
, FileName
);
1072 BlockWrite(F
, FILEHEADER
, SizeOf(FILEHEADER
));
1073 BlockWrite(F
, INFOHEADER
, SizeOf(INFOHEADER
));
1074 BlockWrite(F
, pixels
[0], Width
*Height
*3);
1081 function e_GetGamma(win
: PSDL_Window
): Byte;
1083 ramp
: array [0..256*3-1] of Word;
1084 rgb
: array [0..2] of Double;
1093 if e_NoGraphics
then Exit
;
1098 SDL_GetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1107 for j
:= min
to max
- 1 do
1110 B
:= (j
mod 256)/256;
1112 sum
:= sum
+ ln(A
)/ln(B
);
1115 rgb
[i
] := sum
/ count
;
1118 Result
:= 100 - Trunc(((rgb
[0] + rgb
[1] + rgb
[2])/3 - 0.23) * 100/(2.7 - 0.23));
1121 procedure e_SetGamma(win
: PSDL_Window
; Gamma
: Byte);
1123 ramp
: array [0..256*3-1] of Word;
1128 if e_NoGraphics
then Exit
;
1129 g
:= (100 - Gamma
)*(2.7 - 0.23)/100 + 0.23;
1131 for i
:= 0 to 255 do
1133 r
:= Exp(g
* ln(i
/256))*65536;
1134 if r
< 0 then r
:= 0
1135 else if r
> 65535 then r
:= 65535;
1136 ramp
[i
] := trunc(r
);
1137 ramp
[i
+ 256] := trunc(r
);
1138 ramp
[i
+ 512] := trunc(r
);
1141 SDL_SetWindowGammaRamp(win
, @ramp
[0], @ramp
[256], @ramp
[512]);
1144 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1148 e_WriteLog('Creating CharFont...', MSG_NOTIFY
);
1152 if e_CharFonts
<> nil then
1153 for i
:= 0 to High(e_CharFonts
) do
1154 if not e_CharFonts
[i
].Live
then
1160 if id
= DWORD(-1) then
1162 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1163 id
:= High(e_CharFonts
);
1166 with e_CharFonts
[id
] do
1168 for i
:= 0 to High(Chars
) do
1182 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1184 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1186 TextureID
:= Texture
;
1191 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1195 if e_NoGraphics
then Exit
;
1196 if Text = '' then Exit
;
1197 if e_CharFonts
= nil then Exit
;
1198 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1200 with e_CharFonts
[FontID
] do
1202 for a
:= 1 to Length(Text) do
1203 with Chars
[Ord(Text[a
])] do
1204 if TextureID
<> -1 then
1206 e_Draw(TextureID
, X
, Y
, 0, True, False);
1207 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1212 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1213 Color
: TRGB
; Scale
: Single = 1.0);
1218 if e_NoGraphics
then Exit
;
1219 if Text = '' then Exit
;
1220 if e_CharFonts
= nil then Exit
;
1221 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1223 with e_CharFonts
[FontID
] do
1225 for a
:= 1 to Length(Text) do
1226 with Chars
[Ord(Text[a
])] do
1227 if TextureID
<> -1 then
1229 if Scale
<> 1.0 then
1232 glScalef(Scale
, Scale
, 0);
1237 e_Draw(TextureID
, X
, Y
, 0, True, False);
1240 if Scale
<> 1.0 then glPopMatrix
;
1242 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1247 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1249 a
, TX
, TY
, len
: Integer;
1253 if e_NoGraphics
then Exit
;
1254 if Text = '' then Exit
;
1255 if e_CharFonts
= nil then Exit
;
1256 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1264 len
:= Length(Text);
1266 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1268 with e_CharFonts
[FontID
] do
1270 for a
:= 1 to len
do
1281 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1286 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1291 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1296 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1301 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1306 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1311 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1316 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1321 with Chars
[Ord(Text[a
])] do
1322 if TextureID
<> -1 then
1326 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1329 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1335 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1343 if Text = '' then Exit
;
1344 if e_CharFonts
= nil then Exit
;
1345 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1347 with e_CharFonts
[FontID
] do
1349 for a
:= 1 to Length(Text) do
1350 with Chars
[Ord(Text[a
])] do
1351 if TextureID
<> -1 then
1353 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1354 e_GetTextureSize(TextureID
, nil, @h2
);
1355 if h2
> h
then h
:= h2
;
1360 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1362 a
, lines
, len
: Integer;
1369 if Text = '' then Exit
;
1370 if e_CharFonts
= nil then Exit
;
1371 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1374 len
:= Length(Text);
1376 with e_CharFonts
[FontID
] do
1378 for a
:= 1 to len
do
1380 if Text[a
] = #10 then
1390 else if Text[a
] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1393 with Chars
[Ord(Text[a
])] do
1394 if TextureID
<> -1 then
1396 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1397 e_GetTextureSize(TextureID
, nil, @h2
);
1398 if h2
> h
then h
:= h2
;
1408 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1414 if e_CharFonts
= nil then Exit
;
1415 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1417 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1418 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1421 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1428 if e_CharFonts
= nil then Exit
;
1429 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1431 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1433 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1434 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1436 if h2
> Result
then Result
:= h2
;
1440 procedure e_CharFont_Remove(FontID
: DWORD
);
1444 with e_CharFonts
[FontID
] do
1445 for a
:= 0 to High(Chars
) do
1446 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1448 e_CharFonts
[FontID
].Live
:= False;
1451 procedure e_CharFont_RemoveAll();
1455 if e_CharFonts
= nil then Exit
;
1457 for a
:= 0 to High(e_CharFonts
) do
1458 e_CharFont_Remove(a
);
1463 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1470 if e_NoGraphics
then Exit
;
1471 e_WriteLog('Creating texture font...', MSG_NOTIFY
);
1475 if e_TextureFonts
<> nil then
1476 for i
:= 0 to High(e_TextureFonts
) do
1477 if e_TextureFonts
[i
].Base
= 0 then
1483 if id
= DWORD(-1) then
1485 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1486 id
:= High(e_TextureFonts
);
1489 with e_TextureFonts
[id
] do
1491 Base
:= glGenLists(XCount
*YCount
);
1492 TextureID
:= e_Textures
[Tex
].tx
.id
;
1493 CharWidth
:= (e_Textures
[Tex
].Width
div XCount
)+Space
;
1494 CharHeight
:= e_Textures
[Tex
].Height
div YCount
;
1501 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].tx
.id
);
1502 for loop1
:= 0 to XCount
*YCount
-1 do
1504 cx
:= (loop1
mod XCount
)/XCount
;
1505 cy
:= (loop1
div YCount
)/YCount
;
1507 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1509 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1510 glVertex2d(0, e_Textures
[Tex
].Height
div YCount
);
1512 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1513 glVertex2i(e_Textures
[Tex
].Width
div XCount
, e_Textures
[Tex
].Height
div YCount
);
1515 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1516 glVertex2i(e_Textures
[Tex
].Width
div XCount
, 0);
1518 glTexCoord2f(cx
, 1.0-cy
);
1521 glTranslated((e_Textures
[Tex
].Width
div XCount
)+Space
, 0, 0);
1528 procedure e_TextureFontKill(FontID
: DWORD
);
1530 if e_NoGraphics
then Exit
;
1531 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1532 e_TextureFonts
[FontID
].Base
:= 0;
1535 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1537 if e_NoGraphics
then Exit
;
1538 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1539 if Text = '' then Exit
;
1541 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1544 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1547 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1548 glEnable(GL_TEXTURE_2D
);
1549 glTranslated(x
, y
, 0);
1550 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1551 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1552 glDisable(GL_TEXTURE_2D
);
1555 glDisable(GL_BLEND
);
1558 // god forgive me for this, but i cannot figure out how to do it without lists
1559 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1561 if e_NoGraphics
then Exit
;
1566 glColor4ub(0, 0, 0, 128);
1567 glTranslated(X
+1, Y
+1, 0);
1568 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1573 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1574 glTranslated(X
, Y
, 0);
1575 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1580 procedure e_TextureFontPrintFmt(X
, Y
: Integer; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
1582 a
, TX
, TY
, len
: Integer;
1586 if e_NoGraphics
then Exit
;
1587 if Text = '' then Exit
;
1588 if e_TextureFonts
= nil then Exit
;
1589 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1597 len
:= Length(Text);
1599 w
:= e_TextureFonts
[FontID
].CharWidth
;
1601 with e_TextureFonts
[FontID
] do
1603 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1604 glEnable(GL_TEXTURE_2D
);
1605 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1607 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1610 for a
:= 1 to len
do
1621 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1626 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1631 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1636 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1641 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1646 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1651 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1656 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1663 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1668 glDisable(GL_TEXTURE_2D
);
1669 glDisable(GL_BLEND
);
1673 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1674 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1676 if e_NoGraphics
then Exit
;
1677 if Text = '' then Exit
;
1680 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1681 glEnable(GL_TEXTURE_2D
);
1682 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1684 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1689 glColor4ub(0, 0, 0, 128);
1690 glTranslated(x
+1, y
+1, 0);
1691 glScalef(Scale
, Scale
, 0);
1692 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1697 glColor4ub(Red
, Green
, Blue
, 255);
1698 glTranslated(x
, y
, 0);
1699 glScalef(Scale
, Scale
, 0);
1700 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1702 glDisable(GL_TEXTURE_2D
);
1704 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1705 glDisable(GL_BLEND
);
1708 procedure e_TextureFontGetSize(ID
: DWORD
; var CharWidth
, CharHeight
: Byte);
1712 if e_NoGraphics
then Exit
;
1713 if Integer(ID
) > High(e_TextureFonts
) then
1715 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1716 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1719 procedure e_RemoveAllTextureFont();
1723 if e_NoGraphics
then Exit
;
1724 if e_TextureFonts
= nil then Exit
;
1726 for i
:= 0 to High(e_TextureFonts
) do
1727 if e_TextureFonts
[i
].Base
<> 0 then
1729 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1730 e_TextureFonts
[i
].Base
:= 0;
1733 e_TextureFonts
:= nil;
1736 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1743 function _Point(X
, Y
: Integer): TPoint2i
;
1749 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1753 Result
.Width
:= Width
;
1754 Result
.Height
:= Height
;
1757 function _TRect(L
, T
, R
, B
: LongInt): TRect
;