6 SysUtils
, Math
, e_log
, e_textures
, SDL
, 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 procedure e_SaveGLContext();
106 procedure e_RestoreGLContext();
108 function e_GetGamma(): Byte;
109 procedure e_SetGamma(Gamma
: Byte);
111 procedure e_MakeScreenshot(FileName
: string; Width
, Height
: Word);
113 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
114 function _Point(X
, Y
: Integer): TPoint2i
;
115 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
116 function _TRect(L
, T
, R
, B
: LongInt): TRect
;
132 TTextureFont
= record
142 Chars
: array[0..255] of
152 TSavedTexture
= record
159 e_Textures
: array of TTexture
= nil;
160 e_TextureFonts
: array of TTextureFont
= nil;
161 e_CharFonts
: array of TCharFont
;
162 e_SavedTextures
: array of TSavedTexture
;
164 //------------------------------------------------------------------
165 // Èíèöèàëèçèðóåò OpenGL
166 //------------------------------------------------------------------
167 procedure e_InitGL();
169 glDisable(GL_DEPTH_TEST
);
170 glEnable(GL_SCISSOR_TEST
);
174 glClearColor(0, 0, 0, 0);
177 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
179 mat
: Array [0..15] of GLDouble
;
183 glScissor(X
, Y
, Width
, Height
);
184 glViewport(X
, Y
, Width
, Height
);
185 //gluOrtho2D(0, Width, Height, 0);
187 glMatrixMode(GL_PROJECTION
);
189 mat
[ 0] := 2.0 / Width
;
195 mat
[ 5] := -2.0 / Height
;
209 glLoadMatrixd(@mat
[0]);
211 glMatrixMode(GL_MODELVIEW
);
215 //------------------------------------------------------------------
216 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
217 //------------------------------------------------------------------
218 function FindTexture(): DWORD
;
222 if e_Textures
<> nil then
223 for i
:= 0 to High(e_Textures
) do
224 if e_Textures
[i
].Width
= 0 then
230 if e_Textures
= nil then
232 SetLength(e_Textures
, 32);
237 Result
:= High(e_Textures
) + 1;
238 SetLength(e_Textures
, Length(e_Textures
) + 32);
242 //------------------------------------------------------------------
244 //------------------------------------------------------------------
245 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
252 e_WriteLog('Loading texture from '+FileName
, MSG_NOTIFY
);
254 find_id
:= FindTexture();
256 if not LoadTexture(FileName
, e_Textures
[find_id
].ID
, e_Textures
[find_id
].Width
,
257 e_Textures
[find_id
].Height
, @fmt
) then Exit
;
260 e_Textures
[ID
].Fmt
:= fmt
;
265 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
272 find_id
:= FindTexture();
274 if not LoadTextureEx(FileName
, e_Textures
[find_id
].ID
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
276 e_Textures
[find_id
].Width
:= fWidth
;
277 e_Textures
[find_id
].Height
:= fHeight
;
278 e_Textures
[find_id
].Fmt
:= fmt
;
285 function e_CreateTextureMem(pData
: Pointer; var ID
: DWORD
): Boolean;
292 find_id
:= FindTexture
;
294 if not LoadTextureMem(pData
, e_Textures
[find_id
].ID
, e_Textures
[find_id
].Width
,
295 e_Textures
[find_id
].Height
, @fmt
) then exit
;
298 e_Textures
[id
].Fmt
:= fmt
;
303 function e_CreateTextureMemEx(pData
: Pointer; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
310 find_id
:= FindTexture();
312 if not LoadTextureMemEx(pData
, e_Textures
[find_id
].ID
, fX
, fY
, fWidth
, fHeight
, @fmt
) then exit
;
314 e_Textures
[find_id
].Width
:= fWidth
;
315 e_Textures
[find_id
].Height
:= fHeight
;
316 e_Textures
[find_id
].Fmt
:= fmt
;
323 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
325 if Width
<> nil then Width
^ := e_Textures
[ID
].Width
;
326 if Height
<> nil then Height
^ := e_Textures
[ID
].Height
;
329 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
337 w
:= e_Textures
[ID
].Width
;
338 h
:= e_Textures
[ID
].Height
;
339 data
:= GetMemory(w
*h
*4);
340 glEnable(GL_TEXTURE_2D
);
341 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].ID
);
342 glGetTexImage(GL_TEXTURE_2D
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, data
);
349 for y
:= h
-1 downto 0 do
356 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
362 Result
.Y
:= h
-lastline
;
374 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
380 Result
.Height
:= h
-lastline
-Result
.Y
;
392 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
398 Result
.X
:= lastline
+1;
403 for x
:= w
-1 downto 0 do
410 a
:= Byte((data
+y
*w
*4+x
*4+3)^) <> 0;
416 Result
.Width
:= lastline
-Result
.X
+1;
424 procedure e_ResizeWindow(Width
, Height
: Integer);
428 e_SetViewPort(0, 0, Width
, Height
);
431 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
432 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
434 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
436 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
441 if (AlphaChannel
) or (Alpha
> 0) then
442 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
445 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
448 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
450 glEnable(GL_TEXTURE_2D
);
451 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].ID
);
454 if Mirror
= M_NONE
then
456 glTexCoord2i(1, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
457 glTexCoord2i(0, 0); glVertex2i(X
, Y
);
458 glTexCoord2i(0, -1); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
459 glTexCoord2i(1, -1); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
462 if Mirror
= M_HORIZONTAL
then
464 glTexCoord2i(1, 0); glVertex2i(X
, Y
);
465 glTexCoord2i(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
466 glTexCoord2i(0, -1); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
467 glTexCoord2i(1, -1); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
470 if Mirror
= M_VERTICAL
then
472 glTexCoord2i(1, -1); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
473 glTexCoord2i(0, -1); glVertex2i(X
, Y
);
474 glTexCoord2i(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
475 glTexCoord2i(1, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
483 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
484 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
486 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
488 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
493 if (AlphaChannel
) or (Alpha
> 0) then
494 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
497 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
500 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
502 glEnable(GL_TEXTURE_2D
);
503 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].ID
);
506 glTexCoord2i(0, 1); glVertex2i(X
, Y
);
507 glTexCoord2i(1, 1); glVertex2i(X
+ Width
, Y
);
508 glTexCoord2i(1, 0); glVertex2i(X
+ Width
, Y
+ Height
);
509 glTexCoord2i(0, 0); glVertex2i(X
, Y
+ Height
);
515 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
516 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
518 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
520 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
525 if (AlphaChannel
) or (Alpha
> 0) then
526 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
529 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
532 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
534 glEnable(GL_TEXTURE_2D
);
535 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].ID
);
538 if Mirror
= M_NONE
then
540 glTexCoord2i(1, 0); glVertex2i(X
+ Width
, Y
);
541 glTexCoord2i(0, 0); glVertex2i(X
, Y
);
542 glTexCoord2i(0, -1); glVertex2i(X
, Y
+ Height
);
543 glTexCoord2i(1, -1); glVertex2i(X
+ Width
, Y
+ Height
);
546 if Mirror
= M_HORIZONTAL
then
548 glTexCoord2i(1, 0); glVertex2i(X
, Y
);
549 glTexCoord2i(0, 0); glVertex2i(X
+ Width
, Y
);
550 glTexCoord2i(0, -1); glVertex2i(X
+ Width
, Y
+ Height
);
551 glTexCoord2i(1, -1); glVertex2i(X
, Y
+ Height
);
554 if Mirror
= M_VERTICAL
then
556 glTexCoord2i(1, -1); glVertex2i(X
+ Width
, Y
);
557 glTexCoord2i(0, -1); glVertex2i(X
, Y
);
558 glTexCoord2i(0, 0); glVertex2i(X
, Y
+ Height
);
559 glTexCoord2i(1, 0); glVertex2i(X
+ Width
, Y
+ Height
);
567 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
568 AlphaChannel
: Boolean; Blending
: Boolean);
573 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
575 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
580 if (AlphaChannel
) or (Alpha
> 0) then
581 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
584 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
587 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
595 glEnable(GL_TEXTURE_2D
);
596 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].ID
);
598 X2
:= X
+ e_Textures
[ID
].Width
* XCount
;
599 Y2
:= Y
+ e_Textures
[ID
].Height
* YCount
;
602 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
603 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
604 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
605 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
611 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
612 Blending
: Boolean; Angle
: Single; RC
: PPoint
; Mirror
: TMirrorType
= M_NONE
);
614 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
616 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
621 if (AlphaChannel
) or (Alpha
> 0) then
622 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
625 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
628 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
630 if (Angle
<> 0) and (RC
<> nil) then
633 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
634 glRotatef(Angle
, 0, 0, 1);
635 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
638 glEnable(GL_TEXTURE_2D
);
639 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].ID
);
640 glBegin(GL_QUADS
); //0-1 1-1
642 if Mirror
= M_NONE
then
644 glTexCoord2i(1, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
645 glTexCoord2i(0, 0); glVertex2i(X
, Y
);
646 glTexCoord2i(0, -1); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
647 glTexCoord2i(1, -1); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
650 if Mirror
= M_HORIZONTAL
then
652 glTexCoord2i(1, 0); glVertex2i(X
, Y
);
653 glTexCoord2i(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
654 glTexCoord2i(0, -1); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
655 glTexCoord2i(1, -1); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
658 if Mirror
= M_VERTICAL
then
660 glTexCoord2i(1, -1); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
661 glTexCoord2i(0, -1); glVertex2i(X
, Y
);
662 glTexCoord2i(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
663 glTexCoord2i(1, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
674 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
676 glDisable(GL_TEXTURE_2D
);
677 glColor3ub(Red
, Green
, Blue
);
680 if (Size
= 2) or (Size
= 4) then
684 glVertex2f(X
+0.3, Y
+1.0);
687 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
690 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
692 // Make lines only top-left/bottom-right and top-right/bottom-left
704 // Pixel-perfect hack
712 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
714 nX1
, nY1
, nX2
, nY2
: Integer;
716 // Only top-left/bottom-right quad
733 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
737 glDisable(GL_TEXTURE_2D
);
738 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
742 nX1
:= X1
; nY1
:= Y1
;
743 nX2
:= X2
; nY2
:= Y1
;
744 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
745 glVertex2i(nX1
, nY1
);
746 glVertex2i(nX2
, nY2
);
748 nX1
:= X2
; nY1
:= Y1
;
749 nX2
:= X2
; nY2
:= Y2
;
750 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
751 glVertex2i(nX1
, nY1
);
752 glVertex2i(nX2
, nY2
);
754 nX1
:= X2
; nY1
:= Y2
;
755 nX2
:= X1
; nY2
:= Y2
;
756 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
757 glVertex2i(nX1
, nY1
);
758 glVertex2i(nX2
, nY2
);
760 nX1
:= X1
; nY1
:= Y2
;
761 nX2
:= X1
; nY2
:= Y1
;
762 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
763 glVertex2i(nX1
, nY1
);
764 glVertex2i(nX2
, nY2
);
767 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
772 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
773 Blending
: TBlending
= B_NONE
);
775 if (Alpha
> 0) or (Blending
<> B_NONE
) then
780 if Blending
= B_BLEND
then
781 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
783 if Blending
= B_FILTER
then
784 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
786 if Blending
= B_INVERT
then
787 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
790 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
792 glDisable(GL_TEXTURE_2D
);
793 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
805 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
810 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
812 // Pixel-perfect lines
814 e_LineCorrection(X1
, Y1
, X2
, Y2
);
819 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
823 glDisable(GL_TEXTURE_2D
);
824 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
832 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
837 //------------------------------------------------------------------
838 // Óäàëÿåò òåêñòóðó èç ìàññèâà
839 //------------------------------------------------------------------
840 procedure e_DeleteTexture(ID
: DWORD
);
842 glDeleteTextures(1, @e_Textures
[ID
].ID
);
843 e_Textures
[ID
].ID
:= 0;
844 e_Textures
[ID
].Width
:= 0;
845 e_Textures
[ID
].Height
:= 0;
848 //------------------------------------------------------------------
849 // Óäàëÿåò âñå òåêñòóðû
850 //------------------------------------------------------------------
851 procedure e_RemoveAllTextures();
855 if e_Textures
= nil then Exit
;
857 for i
:= 0 to High(e_Textures
) do
858 if e_Textures
[i
].Width
<> 0 then e_DeleteTexture(i
);
862 //------------------------------------------------------------------
864 //------------------------------------------------------------------
865 procedure e_ReleaseEngine();
868 e_RemoveAllTextureFont
;
871 procedure e_BeginRender();
873 glEnable(GL_ALPHA_TEST
);
874 glAlphaFunc(GL_GREATER
, 0.0);
877 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single); overload
;
879 glClearColor(Red
, Green
, Blue
, 0);
883 procedure e_Clear(); overload
;
885 glClearColor(0, 0, 0, 0);
886 glClear(GL_COLOR_BUFFER_BIT
);
889 procedure e_EndRender();
894 procedure e_MakeScreenshot(FileName
: String; Width
, Height
: Word);
899 aRGB = Array [0..1] of TRGB;
902 TByteArray = Array [0..1] of Byte;
903 PByteArray = ^TByteArray;
906 FILEHEADER: BITMAPFILEHEADER;
907 INFOHEADER: BITMAPINFOHEADER;
914 if (Width mod 4) > 0 then
915 Width := Width + 4 - (Width mod 4);
917 GetMem(pixels, Width*Height*3);
918 glReadPixels(0, 0, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pixels);
920 for i := 0 to Width * Height - 1 do
921 with PaRGB(pixels)[i] do
930 bfType := $4D42; // "BM"
931 bfSize := Width*Height*3 + SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER);
934 bfOffBits := SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER);
939 biSize := SizeOf(BITMAPINFOHEADER);
945 biSizeImage := Width*Height*3;
946 biXPelsPerMeter := 0;
947 biYPelsPerMeter := 0;
952 AssignFile(F, FileName);
955 BlockWrite(F, FILEHEADER, SizeOf(FILEHEADER));
956 BlockWrite(F, INFOHEADER, SizeOf(INFOHEADER));
957 BlockWrite(F, pixels[0], Width*Height*3);
964 function e_GetGamma(): Byte;
966 ramp
: array [0..256*3-1] of Word;
967 rgb
: array [0..2] of Double;
979 SDL_GetGammaRamp(@ramp
[0], @ramp
[256], @ramp
[512]);
988 for j
:= min
to max
- 1 do
991 B
:= (j
mod 256)/256;
993 sum
:= sum
+ ln(A
)/ln(B
);
996 rgb
[i
] := sum
/ count
;
999 Result
:= 100 - Trunc(((rgb
[0] + rgb
[1] + rgb
[2])/3 - 0.23) * 100/(2.7 - 0.23));
1002 procedure e_SetGamma(Gamma
: Byte);
1004 ramp
: array [0..256*3-1] of Word;
1009 g
:= (100 - Gamma
)*(2.7 - 0.23)/100 + 0.23;
1011 for i
:= 0 to 255 do
1013 r
:= Exp(g
* ln(i
/256))*65536;
1014 if r
< 0 then r
:= 0
1015 else if r
> 65535 then r
:= 65535;
1016 ramp
[i
] := trunc(r
);
1017 ramp
[i
+ 256] := trunc(r
);
1018 ramp
[i
+ 512] := trunc(r
);
1021 SDL_SetGammaRamp(@ramp
[0], @ramp
[256], @ramp
[512]);
1024 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1028 e_WriteLog('Creating CharFont...', MSG_NOTIFY
);
1032 if e_CharFonts
<> nil then
1033 for i
:= 0 to High(e_CharFonts
) do
1034 if not e_CharFonts
[i
].Live
then
1040 if id
= DWORD(-1) then
1042 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1043 id
:= High(e_CharFonts
);
1046 with e_CharFonts
[id
] do
1048 for i
:= 0 to High(Chars
) do
1062 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1064 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1066 TextureID
:= Texture
;
1071 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1075 if Text = '' then Exit
;
1076 if e_CharFonts
= nil then Exit
;
1077 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1079 with e_CharFonts
[FontID
] do
1081 for a
:= 1 to Length(Text) do
1082 with Chars
[Ord(Text[a
])] do
1083 if TextureID
<> -1 then
1085 e_Draw(TextureID
, X
, Y
, 0, True, False);
1086 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1091 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1092 Color
: TRGB
; Scale
: Single = 1.0);
1097 if Text = '' then Exit
;
1098 if e_CharFonts
= nil then Exit
;
1099 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1101 with e_CharFonts
[FontID
] do
1103 for a
:= 1 to Length(Text) do
1104 with Chars
[Ord(Text[a
])] do
1105 if TextureID
<> -1 then
1107 if Scale
<> 1.0 then
1110 glScalef(Scale
, Scale
, 0);
1115 e_Draw(TextureID
, X
, Y
, 0, True, False);
1118 if Scale
<> 1.0 then glPopMatrix
;
1120 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1125 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1127 a
, TX
, TY
, len
: Integer;
1131 if Text = '' then Exit
;
1132 if e_CharFonts
= nil then Exit
;
1133 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1141 len
:= Length(Text);
1143 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1145 with e_CharFonts
[FontID
] do
1147 for a
:= 1 to len
do
1158 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1163 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1168 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1173 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1178 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1183 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1188 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1193 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1198 with Chars
[Ord(Text[a
])] do
1199 if TextureID
<> -1 then
1203 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1206 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1212 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
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 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1231 e_GetTextureSize(TextureID
, nil, @h2
);
1232 if h2
> h
then h
:= h2
;
1237 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1239 a
, lines
, len
: Integer;
1246 if Text = '' then Exit
;
1247 if e_CharFonts
= nil then Exit
;
1248 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1251 len
:= Length(Text);
1253 with e_CharFonts
[FontID
] do
1255 for a
:= 1 to len
do
1257 if Text[a
] = #10 then
1267 else if Text[a
] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1270 with Chars
[Ord(Text[a
])] do
1271 if TextureID
<> -1 then
1273 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1274 e_GetTextureSize(TextureID
, nil, @h2
);
1275 if h2
> h
then h
:= h2
;
1285 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1291 if e_CharFonts
= nil then Exit
;
1292 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1294 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1295 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1298 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1305 if e_CharFonts
= nil then Exit
;
1306 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1308 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1310 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1311 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1313 if h2
> Result
then Result
:= h2
;
1317 procedure e_CharFont_Remove(FontID
: DWORD
);
1321 with e_CharFonts
[FontID
] do
1322 for a
:= 0 to High(Chars
) do
1323 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1325 e_CharFonts
[FontID
].Live
:= False;
1328 procedure e_CharFont_RemoveAll();
1332 if e_CharFonts
= nil then Exit
;
1334 for a
:= 0 to High(e_CharFonts
) do
1335 e_CharFont_Remove(a
);
1340 procedure e_TextureFontBuild(Tex
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1347 e_WriteLog('Creating texture font...', MSG_NOTIFY
);
1351 if e_TextureFonts
<> nil then
1352 for i
:= 0 to High(e_TextureFonts
) do
1353 if e_TextureFonts
[i
].Base
= 0 then
1359 if id
= DWORD(-1) then
1361 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1362 id
:= High(e_TextureFonts
);
1365 with e_TextureFonts
[id
] do
1367 Base
:= glGenLists(XCount
*YCount
);
1368 TextureID
:= e_Textures
[Tex
].ID
;
1369 CharWidth
:= (e_Textures
[Tex
].Width
div XCount
)+Space
;
1370 CharHeight
:= e_Textures
[Tex
].Height
div YCount
;
1377 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].ID
);
1378 for loop1
:= 0 to XCount
*YCount
-1 do
1380 cx
:= (loop1
mod XCount
)/XCount
;
1381 cy
:= (loop1
div YCount
)/YCount
;
1383 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1385 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1386 glVertex2d(0, e_Textures
[Tex
].Height
div YCount
);
1388 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1389 glVertex2i(e_Textures
[Tex
].Width
div XCount
, e_Textures
[Tex
].Height
div YCount
);
1391 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1392 glVertex2i(e_Textures
[Tex
].Width
div XCount
, 0);
1394 glTexCoord2f(cx
, 1.0-cy
);
1397 glTranslated((e_Textures
[Tex
].Width
div XCount
)+Space
, 0, 0);
1404 procedure e_TextureFontBuildInPlace(id
: DWORD
);
1408 XCount
, YCount
, Space
: Integer;
1411 with e_TextureFonts
[id
] do
1413 Base
:= glGenLists(XC
*YC
);
1414 TextureID
:= e_Textures
[Texture
].ID
;
1421 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Tex
].ID
);
1422 for loop1
:= 0 to XCount
*YCount
-1 do
1424 cx
:= (loop1
mod XCount
)/XCount
;
1425 cy
:= (loop1
div YCount
)/YCount
;
1427 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1429 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1430 glVertex2d(0, e_Textures
[Tex
].Height
div YCount
);
1432 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1433 glVertex2i(e_Textures
[Tex
].Width
div XCount
, e_Textures
[Tex
].Height
div YCount
);
1435 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1436 glVertex2i(e_Textures
[Tex
].Width
div XCount
, 0);
1438 glTexCoord2f(cx
, 1.0-cy
);
1441 glTranslated((e_Textures
[Tex
].Width
div XCount
)+Space
, 0, 0);
1446 procedure e_TextureFontKill(FontID
: DWORD
);
1448 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1449 e_TextureFonts
[FontID
].Base
:= 0;
1452 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1454 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1455 if Text = '' then Exit
;
1457 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1460 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1463 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1464 glEnable(GL_TEXTURE_2D
);
1465 glTranslated(x
, y
, 0);
1466 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1467 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1468 glDisable(GL_TEXTURE_2D
);
1471 glDisable(GL_BLEND
);
1474 // god forgive me for this, but i cannot figure out how to do it without lists
1475 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1481 glColor4ub(0, 0, 0, 128);
1482 glTranslated(X
+1, Y
+1, 0);
1483 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1488 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1489 glTranslated(X
, Y
, 0);
1490 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1495 procedure e_TextureFontPrintFmt(X
, Y
: Integer; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
1497 a
, TX
, TY
, len
: Integer;
1501 if Text = '' then Exit
;
1502 if e_TextureFonts
= nil then Exit
;
1503 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1511 len
:= Length(Text);
1513 w
:= e_TextureFonts
[FontID
].CharWidth
;
1515 with e_TextureFonts
[FontID
] do
1517 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1518 glEnable(GL_TEXTURE_2D
);
1519 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1521 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1524 for a
:= 1 to len
do
1535 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1540 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1545 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1550 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1555 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1560 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1565 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1570 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1577 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1582 glDisable(GL_TEXTURE_2D
);
1583 glDisable(GL_BLEND
);
1587 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1588 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1590 if Text = '' then Exit
;
1593 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1594 glEnable(GL_TEXTURE_2D
);
1595 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1597 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1602 glColor4ub(0, 0, 0, 128);
1603 glTranslated(x
+1, y
+1, 0);
1604 glScalef(Scale
, Scale
, 0);
1605 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1610 glColor4ub(Red
, Green
, Blue
, 255);
1611 glTranslated(x
, y
, 0);
1612 glScalef(Scale
, Scale
, 0);
1613 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1615 glDisable(GL_TEXTURE_2D
);
1617 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1618 glDisable(GL_BLEND
);
1621 procedure e_TextureFontGetSize(ID
: DWORD
; var CharWidth
, CharHeight
: Byte);
1623 if Integer(ID
) > High(e_TextureFonts
) then
1625 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1626 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1629 procedure e_RemoveAllTextureFont();
1633 if e_TextureFonts
= nil then Exit
;
1635 for i
:= 0 to High(e_TextureFonts
) do
1636 if e_TextureFonts
[i
].Base
<> 0 then
1638 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1639 e_TextureFonts
[i
].Base
:= 0;
1642 e_TextureFonts
:= nil;
1645 procedure e_SaveGLContext();
1650 e_WriteLog('Backing up GL context:', MSG_NOTIFY
);
1652 glPushAttrib(GL_ALL_ATTRIB_BITS
);
1653 glPushClientAttrib(GL_CLIENT_ALL_ATTRIB_BITS
);
1655 if e_Textures
<> nil then
1657 e_WriteLog(' Backing up textures...', MSG_NOTIFY
);
1658 SetLength(e_SavedTextures
, Length(e_Textures
));
1659 for i
:= Low(e_Textures
) to High(e_Textures
) do
1661 e_SavedTextures
[i
].Pixels
:= nil;
1662 if e_Textures
[i
].Width
> 0 then
1664 with e_SavedTextures
[i
] do
1667 if e_Textures
[i
].Fmt
= GL_RGBA
then Inc(PxLen
);
1668 Pixels
:= GetMem(PxLen
* e_Textures
[i
].Width
* e_Textures
[i
].Height
);
1669 glBindTexture(GL_TEXTURE_2D
, e_Textures
[i
].ID
);
1670 glGetTexImage(GL_TEXTURE_2D
, 0, e_Textures
[i
].Fmt
, GL_UNSIGNED_BYTE
, Pixels
);
1671 glBindTexture(GL_TEXTURE_2D
, 0);
1672 OldID
:= e_Textures
[i
].ID
;
1679 if e_TextureFonts
<> nil then
1681 e_WriteLog(' Releasing texturefonts...', MSG_NOTIFY
);
1682 for i
:= 0 to High(e_TextureFonts
) do
1683 if e_TextureFonts
[i
].Base
<> 0 then
1685 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1686 e_TextureFonts
[i
].Base
:= 0;
1691 procedure e_RestoreGLContext();
1696 e_WriteLog('Restoring GL context:', MSG_NOTIFY
);
1698 glPopClientAttrib();
1701 if e_SavedTextures
<> nil then
1703 e_WriteLog(' Regenerating textures...', MSG_NOTIFY
);
1704 for i
:= Low(e_SavedTextures
) to High(e_SavedTextures
) do
1706 if e_SavedTextures
[i
].Pixels
<> nil then
1707 with e_SavedTextures
[i
] do
1709 GLID
:= CreateTexture(e_Textures
[TexID
].Width
, e_Textures
[TexID
].Height
,
1710 e_Textures
[TexID
].Fmt
, Pixels
);
1711 e_Textures
[TexID
].ID
:= GLID
;
1717 if e_TextureFonts
<> nil then
1719 e_WriteLog(' Regenerating texturefonts...', MSG_NOTIFY
);
1720 for i
:= Low(e_TextureFonts
) to High(e_TextureFonts
) do
1721 with e_TextureFonts
[i
] do
1723 TextureID
:= e_Textures
[Texture
].ID
;
1725 e_TextureFontBuildInPlace(i
);
1729 SetLength(e_SavedTextures
, 0);
1733 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1740 function _Point(X
, Y
: Integer): TPoint2i
;
1746 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1750 Result
.Width
:= Width
;
1751 Result
.Height
:= Height
;
1754 function _TRect(L
, T
, R
, B
: LongInt): TRect
;