6 windows
, SysUtils
, Math
, e_log
, e_textures
, dglOpenGL
;
9 TMirrorType
=(M_NONE
, M_HORIZONTAL
, M_VERTICAL
);
10 TBlending
=(B_NONE
, B_BLEND
, B_FILTER
, B_INVERT
);
20 TRect
= windows
.TRect
;
37 //------------------------------------------------------------------
39 //------------------------------------------------------------------
40 procedure e_InitGL(VSync
: Boolean);
41 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
42 procedure e_ResizeWindow(Width
, Height
: Integer);
44 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
45 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
46 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
47 Blending
: Boolean; Angle
: Single; RC
: PPoint
; Mirror
: TMirrorType
= M_NONE
);
48 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
49 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
50 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
51 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
52 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
53 AlphaChannel
: Boolean; Blending
: Boolean);
54 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
55 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
56 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
57 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
58 Blending
: TBlending
= B_NONE
);
60 function e_CreateTexture(FileName
: string; var ID
: DWORD
): Boolean;
61 function e_CreateTextureEx(FileName
: string; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
62 function e_CreateTextureMem(pData
: Pointer; var ID
: DWORD
): Boolean;
63 function e_CreateTextureMemEx(pData
: Pointer; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
64 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
65 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
66 procedure e_DeleteTexture(ID
: DWORD
);
67 procedure e_RemoveAllTextures();
70 function e_SimpleFontCreate(FontName
: PChar; Size
: Byte; Weight
: Word; DC
: HDC
): DWORD
;
71 procedure e_SimpleFontFree(Font
: DWORD
);
72 procedure e_SimpleFontPrint(X
, Y
: SmallInt; Text: PChar; Font
: Integer; Red
, Green
, Blue
: Byte);
73 procedure e_SimpleFontPrintEx(X
, Y
: SmallInt; Text: PChar; Font
: DWORD
; Red
, Green
, Blue
,
74 sRed
, sGreen
, sBlue
, sWidth
: Byte);
77 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
78 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
79 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
80 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
81 Color
: TRGB
; Scale
: Single = 1.0);
82 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
83 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
84 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
85 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
86 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
87 procedure e_CharFont_Remove(FontID
: DWORD
);
88 procedure e_CharFont_RemoveAll();
91 procedure e_TextureFontBuild(Texture
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
93 procedure e_TextureFontKill(FontID
: DWORD
);
94 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
95 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
96 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
97 procedure e_TextureFontPrintFmt(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
98 procedure e_TextureFontGetSize(ID
: DWORD
; var CharWidth
, CharHeight
: Byte);
99 procedure e_RemoveAllTextureFont();
101 procedure e_ReleaseEngine();
102 procedure e_BeginRender();
103 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single);
104 procedure e_EndRender();
106 function e_GetGamma(DC
: HDC
): Byte;
107 procedure e_SetGamma(Gamma
: Byte; DC
: HDC
);
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
;
128 TTextureFont
= record
136 Chars
: array[0..255] of
147 e_Textures
: array of TTexture
= nil;
148 e_TextureFonts
: array of TTextureFont
= nil;
149 e_CharFonts
: array of TCharFont
;
151 //------------------------------------------------------------------
152 // Èíèöèàëèçèðóåò OpenGL
153 //------------------------------------------------------------------
154 procedure e_InitGL(VSync
: Boolean);
157 wglSwapIntervalEXT(1)
159 wglSwapIntervalEXT(0);
160 glDisable(GL_DEPTH_TEST
);
161 glEnable(GL_SCISSOR_TEST
);
165 glClearColor(0, 0, 0, 0);
168 procedure e_SetViewPort(X
, Y
, Width
, Height
: Word);
170 mat
: Array [0..15] of GLDouble
;
174 glScissor(X
, Y
, Width
, Height
);
175 glViewport(X
, Y
, Width
, Height
);
176 //gluOrtho2D(0, Width, Height, 0);
178 glMatrixMode(GL_PROJECTION
);
180 mat
[ 0] := 2.0 / Width
;
186 mat
[ 5] := -2.0 / Height
;
200 glLoadMatrixd(@mat
[0]);
202 glMatrixMode(GL_MODELVIEW
);
206 //------------------------------------------------------------------
207 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
208 //------------------------------------------------------------------
209 function FindTexture(): DWORD
;
213 if e_Textures
<> nil then
214 for i
:= 0 to High(e_Textures
) do
215 if e_Textures
[i
].Width
= 0 then
221 if e_Textures
= nil then
223 SetLength(e_Textures
, 32);
228 Result
:= High(e_Textures
) + 1;
229 SetLength(e_Textures
, Length(e_Textures
) + 32);
233 //------------------------------------------------------------------
235 //------------------------------------------------------------------
236 function e_CreateTexture(FileName
: String; var ID
: DWORD
): Boolean;
242 e_WriteLog('Loading texture from '+FileName
, MSG_NOTIFY
);
244 find_id
:= FindTexture();
246 if not LoadTexture(FileName
, e_Textures
[find_id
].ID
, e_Textures
[find_id
].Width
,
247 e_Textures
[find_id
].Height
) then Exit
;
254 function e_CreateTextureEx(FileName
: String; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
260 find_id
:= FindTexture();
262 if not LoadTextureEx(FileName
, e_Textures
[find_id
].ID
, fX
, fY
, fWidth
, fHeight
) then Exit
;
264 e_Textures
[find_id
].Width
:= fWidth
;
265 e_Textures
[find_id
].Height
:= fHeight
;
272 function e_CreateTextureMem(pData
: Pointer; var ID
: DWORD
): Boolean;
278 find_id
:= FindTexture
;
280 if not LoadTextureMem(pData
, e_Textures
[find_id
].ID
, e_Textures
[find_id
].Width
,
281 e_Textures
[find_id
].Height
) then Exit
;
288 function e_CreateTextureMemEx(pData
: Pointer; var ID
: DWORD
; fX
, fY
, fWidth
, fHeight
: Word): Boolean;
294 find_id
:= FindTexture();
296 if not LoadTextureMemEx(pData
, e_Textures
[find_id
].ID
, fX
, fY
, fWidth
, fHeight
) then Exit
;
298 e_Textures
[find_id
].Width
:= fWidth
;
299 e_Textures
[find_id
].Height
:= fHeight
;
306 procedure e_GetTextureSize(ID
: DWORD
; Width
, Height
: PWord);
308 if Width
<> nil then Width
^ := e_Textures
[ID
].Width
;
309 if Height
<> nil then Height
^ := e_Textures
[ID
].Height
;
312 function e_GetTextureSize2(ID
: DWORD
): TRectWH
;
320 w
:= e_Textures
[ID
].Width
;
321 h
:= e_Textures
[ID
].Height
;
322 data
:= GetMemory(w
*h
*4);
323 glEnable(GL_TEXTURE_2D
);
324 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].ID
);
325 glGetTexImage(GL_TEXTURE_2D
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, data
);
332 for y
:= h
-1 downto 0 do
339 a
:= Byte(Pointer(Integer(data
)+y
*w
*4+x
*4+3)^) <> 0;
345 Result
.Y
:= h
-lastline
;
357 a
:= Byte(Pointer(Integer(data
)+y
*w
*4+x
*4+3)^) <> 0;
363 Result
.Height
:= h
-lastline
-Result
.Y
;
375 a
:= Byte(Pointer(Integer(data
)+y
*w
*4+x
*4+3)^) <> 0;
381 Result
.X
:= lastline
+1;
386 for x
:= w
-1 downto 0 do
393 a
:= Byte(Pointer(Integer(data
)+y
*w
*4+x
*4+3)^) <> 0;
399 Result
.Width
:= lastline
-Result
.X
+1;
407 procedure e_ResizeWindow(Width
, Height
: Integer);
411 e_SetViewPort(0, 0, Width
, Height
);
414 procedure e_Draw(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
415 Blending
: Boolean; Mirror
: TMirrorType
= M_NONE
);
417 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
419 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
424 if (AlphaChannel
) or (Alpha
> 0) then
425 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
428 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
431 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
433 glEnable(GL_TEXTURE_2D
);
434 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].ID
);
437 if Mirror
= M_NONE
then
439 glTexCoord2i(1, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
440 glTexCoord2i(0, 0); glVertex2i(X
, Y
);
441 glTexCoord2i(0, -1); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
442 glTexCoord2i(1, -1); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
445 if Mirror
= M_HORIZONTAL
then
447 glTexCoord2i(1, 0); glVertex2i(X
, Y
);
448 glTexCoord2i(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
449 glTexCoord2i(0, -1); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
450 glTexCoord2i(1, -1); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
453 if Mirror
= M_VERTICAL
then
455 glTexCoord2i(1, -1); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
456 glTexCoord2i(0, -1); glVertex2i(X
, Y
);
457 glTexCoord2i(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
458 glTexCoord2i(1, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
466 procedure e_DrawSize(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
467 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
469 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
471 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
476 if (AlphaChannel
) or (Alpha
> 0) then
477 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
480 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
483 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
485 glEnable(GL_TEXTURE_2D
);
486 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].ID
);
489 glTexCoord2i(0, 1); glVertex2i(X
, Y
);
490 glTexCoord2i(1, 1); glVertex2i(X
+ Width
, Y
);
491 glTexCoord2i(1, 0); glVertex2i(X
+ Width
, Y
+ Height
);
492 glTexCoord2i(0, 0); glVertex2i(X
, Y
+ Height
);
498 procedure e_DrawSizeMirror(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
499 Blending
: Boolean; Width
, Height
: Word; Mirror
: TMirrorType
= M_NONE
);
501 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
503 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
508 if (AlphaChannel
) or (Alpha
> 0) then
509 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
512 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
515 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
517 glEnable(GL_TEXTURE_2D
);
518 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].ID
);
521 if Mirror
= M_NONE
then
523 glTexCoord2i(1, 0); glVertex2i(X
+ Width
, Y
);
524 glTexCoord2i(0, 0); glVertex2i(X
, Y
);
525 glTexCoord2i(0, -1); glVertex2i(X
, Y
+ Height
);
526 glTexCoord2i(1, -1); glVertex2i(X
+ Width
, Y
+ Height
);
529 if Mirror
= M_HORIZONTAL
then
531 glTexCoord2i(1, 0); glVertex2i(X
, Y
);
532 glTexCoord2i(0, 0); glVertex2i(X
+ Width
, Y
);
533 glTexCoord2i(0, -1); glVertex2i(X
+ Width
, Y
+ Height
);
534 glTexCoord2i(1, -1); glVertex2i(X
, Y
+ Height
);
537 if Mirror
= M_VERTICAL
then
539 glTexCoord2i(1, -1); glVertex2i(X
+ Width
, Y
);
540 glTexCoord2i(0, -1); glVertex2i(X
, Y
);
541 glTexCoord2i(0, 0); glVertex2i(X
, Y
+ Height
);
542 glTexCoord2i(1, 0); glVertex2i(X
+ Width
, Y
+ Height
);
550 procedure e_DrawFill(ID
: DWORD
; X
, Y
: Integer; XCount
, YCount
: Word; Alpha
: Integer;
551 AlphaChannel
: Boolean; Blending
: Boolean);
556 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
558 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
563 if (AlphaChannel
) or (Alpha
> 0) then
564 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
567 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
570 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
578 glEnable(GL_TEXTURE_2D
);
579 glBindTexture(GL_TEXTURE_2D
, e_Textures
[ID
].ID
);
581 X2
:= X
+ e_Textures
[ID
].Width
* XCount
;
582 Y2
:= Y
+ e_Textures
[ID
].Height
* YCount
;
585 glTexCoord2i(0, YCount
); glVertex2i(X
, Y
);
586 glTexCoord2i(XCount
, YCount
); glVertex2i(X2
, Y
);
587 glTexCoord2i(XCount
, 0); glVertex2i(X2
, Y2
);
588 glTexCoord2i(0, 0); glVertex2i(X
, Y2
);
594 procedure e_DrawAdv(ID
: DWORD
; X
, Y
: Integer; Alpha
: Byte; AlphaChannel
: Boolean;
595 Blending
: Boolean; Angle
: Single; RC
: PPoint
; Mirror
: TMirrorType
= M_NONE
);
597 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
599 if (Alpha
> 0) or (AlphaChannel
) or (Blending
) then
604 if (AlphaChannel
) or (Alpha
> 0) then
605 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
608 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255-Alpha
);
611 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
);
613 if (Angle
<> 0) and (RC
<> nil) then
616 glTranslatef(X
+RC
.X
, Y
+RC
.Y
, 0);
617 glRotatef(Angle
, 0, 0, 1);
618 glTranslatef(-(X
+RC
.X
), -(Y
+RC
.Y
), 0);
621 glEnable(GL_TEXTURE_2D
);
622 glBindTexture(GL_TEXTURE_2D
, e_Textures
[id
].ID
);
623 glBegin(GL_QUADS
); //0-1 1-1
625 if Mirror
= M_NONE
then
627 glTexCoord2i(1, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
628 glTexCoord2i(0, 0); glVertex2i(X
, Y
);
629 glTexCoord2i(0, -1); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
630 glTexCoord2i(1, -1); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
633 if Mirror
= M_HORIZONTAL
then
635 glTexCoord2i(1, 0); glVertex2i(X
, Y
);
636 glTexCoord2i(0, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
637 glTexCoord2i(0, -1); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
638 glTexCoord2i(1, -1); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
641 if Mirror
= M_VERTICAL
then
643 glTexCoord2i(1, -1); glVertex2i(X
+ e_Textures
[id
].Width
, Y
);
644 glTexCoord2i(0, -1); glVertex2i(X
, Y
);
645 glTexCoord2i(0, 0); glVertex2i(X
, Y
+ e_Textures
[id
].Height
);
646 glTexCoord2i(1, 0); glVertex2i(X
+ e_Textures
[id
].Width
, Y
+ e_Textures
[id
].Height
);
657 procedure e_DrawPoint(Size
: Byte; X
, Y
: Integer; Red
, Green
, Blue
: Byte);
659 glDisable(GL_TEXTURE_2D
);
660 glColor3ub(Red
, Green
, Blue
);
663 if (Size
= 2) or (Size
= 4) then
667 glVertex2f(X
+0.3, Y
+1.0);
670 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
673 procedure e_LineCorrection(var X1
, Y1
, X2
, Y2
: Integer);
675 // Make lines only top-left/bottom-right and top-right/bottom-left
687 // Pixel-perfect hack
695 procedure e_DrawQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
697 nX1
, nY1
, nX2
, nY2
: Integer;
699 // Only top-left/bottom-right quad
716 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
720 glDisable(GL_TEXTURE_2D
);
721 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
725 nX1
:= X1
; nY1
:= Y1
;
726 nX2
:= X2
; nY2
:= Y1
;
727 e_LineCorrection(nX1
, nY1
, nX2
, nY2
); // Pixel-perfect lines
728 glVertex2i(nX1
, nY1
);
729 glVertex2i(nX2
, nY2
);
731 nX1
:= X2
; nY1
:= Y1
;
732 nX2
:= X2
; nY2
:= Y2
;
733 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
734 glVertex2i(nX1
, nY1
);
735 glVertex2i(nX2
, nY2
);
737 nX1
:= X2
; nY1
:= Y2
;
738 nX2
:= X1
; nY2
:= Y2
;
739 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
740 glVertex2i(nX1
, nY1
);
741 glVertex2i(nX2
, nY2
);
743 nX1
:= X1
; nY1
:= Y2
;
744 nX2
:= X1
; nY2
:= Y1
;
745 e_LineCorrection(nX1
, nY1
, nX2
, nY2
);
746 glVertex2i(nX1
, nY1
);
747 glVertex2i(nX2
, nY2
);
750 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
755 procedure e_DrawFillQuad(X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
, Alpha
: Byte;
756 Blending
: TBlending
= B_NONE
);
758 if (Alpha
> 0) or (Blending
<> B_NONE
) then
763 if Blending
= B_BLEND
then
764 glBlendFunc(GL_SRC_ALPHA
, GL_ONE
)
766 if Blending
= B_FILTER
then
767 glBlendFunc(GL_DST_COLOR
, GL_SRC_COLOR
)
769 if Blending
= B_INVERT
then
770 glBlendFunc(GL_ONE_MINUS_DST_COLOR
, GL_ZERO
)
773 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
775 glDisable(GL_TEXTURE_2D
);
776 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
788 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
793 procedure e_DrawLine(Width
: Byte; X1
, Y1
, X2
, Y2
: Integer; Red
, Green
, Blue
: Byte; Alpha
: Byte = 0);
795 // Pixel-perfect lines
797 e_LineCorrection(X1
, Y1
, X2
, Y2
);
802 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
806 glDisable(GL_TEXTURE_2D
);
807 glColor4ub(Red
, Green
, Blue
, 255-Alpha
);
815 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
820 //------------------------------------------------------------------
821 // Óäàëÿåò òåêñòóðó èç ìàññèâà
822 //------------------------------------------------------------------
823 procedure e_DeleteTexture(ID
: DWORD
);
825 glDeleteTextures(1, @e_Textures
[ID
].ID
);
826 e_Textures
[ID
].ID
:= 0;
827 e_Textures
[ID
].Width
:= 0;
828 e_Textures
[ID
].Height
:= 0;
831 //------------------------------------------------------------------
832 // Óäàëÿåò âñå òåêñòóðû
833 //------------------------------------------------------------------
834 procedure e_RemoveAllTextures();
838 if e_Textures
= nil then Exit
;
840 for i
:= 0 to High(e_Textures
) do
841 if e_Textures
[i
].Width
<> 0 then e_DeleteTexture(i
);
845 //------------------------------------------------------------------
847 //------------------------------------------------------------------
848 procedure e_ReleaseEngine();
851 e_RemoveAllTextureFont
;
854 procedure e_BeginRender();
856 glEnable(GL_ALPHA_TEST
);
857 glAlphaFunc(GL_GREATER
, 0.0);
860 procedure e_Clear(Mask
: TGLbitfield
; Red
, Green
, Blue
: Single);
862 glClearColor(Red
, Green
, Blue
, 0);
866 procedure e_EndRender();
871 procedure e_MakeScreenshot(FileName
: String; Width
, Height
: Word);
873 aRGB
= Array [0..1] of TRGB
;
876 TByteArray
= Array [0..1] of Byte;
877 PByteArray
= ^TByteArray
;
880 FILEHEADER
: BITMAPFILEHEADER
;
881 INFOHEADER
: BITMAPINFOHEADER
;
888 if (Width
mod 4) > 0 then
889 Width
:= Width
+ 4 - (Width
mod 4);
891 GetMem(pixels
, Width
*Height
*3);
892 glReadPixels(0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pixels
);
895 for i
:= 0 to Width
* Height
- 1 do
896 with PaRGB(pixels
)[i
] do
906 bfType
:= $4D42; // "BM"
907 bfSize
:= Width
*Height
*3 + SizeOf(BITMAPFILEHEADER
) + SizeOf(BITMAPINFOHEADER
);
910 bfOffBits
:= SizeOf(BITMAPFILEHEADER
) + SizeOf(BITMAPINFOHEADER
);
915 biSize
:= SizeOf(BITMAPINFOHEADER
);
921 biSizeImage
:= Width
*Height
*3;
922 biXPelsPerMeter
:= 0;
923 biYPelsPerMeter
:= 0;
928 AssignFile(F
, FileName
);
931 BlockWrite(F
, FILEHEADER
, SizeOf(FILEHEADER
));
932 BlockWrite(F
, INFOHEADER
, SizeOf(INFOHEADER
));
933 BlockWrite(F
, pixels
[0], Width
*Height
*3);
940 function e_GetGamma(DC
: HDC
): Byte;
942 ramp
: array [0..256*3-1] of Word;
943 rgb
: array [0..2] of Double;
955 GetDeviceGammaRamp(DC
, ramp
);
964 for j
:= min
to max
- 1 do
967 B
:= (j
mod 256)/256;
969 sum
:= sum
+ ln(A
)/ln(B
);
972 rgb
[i
] := sum
/ count
;
975 Result
:= 100 - Trunc(((rgb
[0] + rgb
[1] + rgb
[2])/3 - 0.23) * 100/(2.7 - 0.23));
978 procedure e_SetGamma(Gamma
: Byte; DC
: HDC
);
980 ramp
: array [0..256*3-1] of Word;
985 g
:= (100 - Gamma
)*(2.7 - 0.23)/100 + 0.23;
989 r
:= Exp(g
* ln(i
/256))*65536;
991 else if r
> 65535 then r
:= 65535;
993 ramp
[i
+ 256] := trunc(r
);
994 ramp
[i
+ 512] := trunc(r
);
997 SetDeviceGammaRamp(DC
, ramp
);
1000 function e_SimpleFontCreate(FontName
: PChar; Size
: Byte; Weight
: Word; DC
: HDC
): DWORD
;
1004 Result
:= glGenLists(96); // Generate enough display lists to hold
1005 font
:= CreateFont(-Size
, // height of font
1006 0, // average character width
1007 0, // angle of escapement
1008 0, // base-line orientation angle
1009 Weight
, // font weight
1013 RUSSIAN_CHARSET
, // character set
1014 OUT_TT_PRECIS
, // output precision
1015 CLIP_DEFAULT_PRECIS
, // clipping precision
1016 ANTIALIASED_QUALITY
, // output quality
1017 FF_DONTCARE
or DEFAULT_PITCH
, // pitch and family
1019 SelectObject(DC
, font
); // Sets the new font as the current font in the device context
1020 wglUseFontBitmaps(DC
, 32, 224, Result
); // Creates a set display lists containing the bitmap fonts
1023 procedure e_SimpleFontFree(Font
: DWORD
);
1025 glDeleteLists(Font
, 223); // Delete the font display lists, returning used memory
1028 procedure e_SimpleFontPrint(X
, Y
: SmallInt; Text: PChar; Font
: Integer; Red
, Green
, Blue
: Byte);
1030 glPopAttrib(); // Rendering bug workaround
1032 glColor3ub(Red
, Green
, Blue
);
1033 glDisable(GL_TEXTURE_2D
); // Turn off textures, don't want our text textured
1034 glRasterPos2i(X
, Y
); // Position the Text
1035 glPushAttrib(GL_LIST_BIT
); // Save's the current base list
1036 glListBase(DWORD(Font
-32)); // Set the base list to our character list
1037 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, Text); // Display the text
1038 glPopAttrib(); // Restore the old base list
1041 procedure e_SimpleFontPrintEx(X
, Y
: SmallInt; Text: PChar; Font
: DWORD
; Red
, Green
, Blue
,
1042 sRed
, sGreen
, sBlue
, sWidth
: Byte);
1044 e_SimpleFontPrint(X
, Y
, Text, Font
, Red
, Green
, Blue
);
1045 e_SimpleFontPrint(X
+sWidth
, Y
+sWidth
, Text, Font
, sRed
, sGreen
, sBlue
);
1048 function e_CharFont_Create(sp
: ShortInt=0): DWORD
;
1052 e_WriteLog('Creating CharFont...', MSG_NOTIFY
);
1056 if e_CharFonts
<> nil then
1057 for i
:= 0 to High(e_CharFonts
) do
1058 if not e_CharFonts
[i
].Live
then
1064 if id
= DWORD(-1) then
1066 SetLength(e_CharFonts
, Length(e_CharFonts
) + 1);
1067 id
:= High(e_CharFonts
);
1070 with e_CharFonts
[id
] do
1072 for i
:= 0 to High(Chars
) do
1086 procedure e_CharFont_AddChar(FontID
: DWORD
; Texture
: Integer; c
: Char; w
: Byte);
1088 with e_CharFonts
[FontID
].Chars
[Ord(c
)] do
1090 TextureID
:= Texture
;
1095 procedure e_CharFont_Print(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1099 if Text = '' then Exit
;
1100 if e_CharFonts
= nil then Exit
;
1101 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1103 with e_CharFonts
[FontID
] do
1105 for a
:= 1 to Length(Text) do
1106 with Chars
[Ord(Text[a
])] do
1107 if TextureID
<> -1 then
1109 e_Draw(TextureID
, X
, Y
, 0, True, False);
1110 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1115 procedure e_CharFont_PrintEx(FontID
: DWORD
; X
, Y
: Integer; Text: string;
1116 Color
: TRGB
; Scale
: Single = 1.0);
1121 if Text = '' then Exit
;
1122 if e_CharFonts
= nil then Exit
;
1123 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1125 with e_CharFonts
[FontID
] do
1127 for a
:= 1 to Length(Text) do
1128 with Chars
[Ord(Text[a
])] do
1129 if TextureID
<> -1 then
1131 if Scale
<> 1.0 then
1134 glScalef(Scale
, Scale
, 0);
1139 e_Draw(TextureID
, X
, Y
, 0, True, False);
1142 if Scale
<> 1.0 then glPopMatrix
;
1144 X
:= X
+Width
+IfThen(a
= Length(Text), 0, Space
);
1149 procedure e_CharFont_PrintFmt(FontID
: DWORD
; X
, Y
: Integer; Text: string);
1151 a
, TX
, TY
, len
: Integer;
1155 if Text = '' then Exit
;
1156 if e_CharFonts
= nil then Exit
;
1157 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1165 len
:= Length(Text);
1167 e_CharFont_GetSize(FontID
, 'A', w
, h
);
1169 with e_CharFonts
[FontID
] do
1171 for a
:= 1 to len
do
1182 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1187 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1192 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1197 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1202 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1207 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1212 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1217 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1222 with Chars
[Ord(Text[a
])] do
1223 if TextureID
<> -1 then
1227 e_Draw(TextureID
, TX
, TY
, 0, True, False);
1230 TX
:= TX
+Width
+IfThen(a
= Length(Text), 0, Space
);
1236 procedure e_CharFont_GetSize(FontID
: DWORD
; Text: string; var w
, h
: Word);
1244 if Text = '' then Exit
;
1245 if e_CharFonts
= nil then Exit
;
1246 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1248 with e_CharFonts
[FontID
] do
1250 for a
:= 1 to Length(Text) do
1251 with Chars
[Ord(Text[a
])] do
1252 if TextureID
<> -1 then
1254 w
:= w
+Width
+IfThen(a
= Length(Text), 0, Space
);
1255 e_GetTextureSize(TextureID
, nil, @h2
);
1256 if h2
> h
then h
:= h2
;
1261 procedure e_CharFont_GetSizeFmt(FontID
: DWORD
; Text: string; var w
, h
: Word);
1263 a
, lines
, len
: Integer;
1270 if Text = '' then Exit
;
1271 if e_CharFonts
= nil then Exit
;
1272 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1275 len
:= Length(Text);
1277 with e_CharFonts
[FontID
] do
1279 for a
:= 1 to len
do
1281 if Text[a
] = #10 then
1291 else if Text[a
] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1294 with Chars
[Ord(Text[a
])] do
1295 if TextureID
<> -1 then
1297 w2
:= w2
+ Width
+ IfThen(a
= len
, 0, Space
);
1298 e_GetTextureSize(TextureID
, nil, @h2
);
1299 if h2
> h
then h
:= h2
;
1309 function e_CharFont_GetMaxWidth(FontID
: DWORD
): Word;
1315 if e_CharFonts
= nil then Exit
;
1316 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1318 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1319 Result
:= Max(Result
, e_CharFonts
[FontID
].Chars
[a
].Width
);
1322 function e_CharFont_GetMaxHeight(FontID
: DWORD
): Word;
1329 if e_CharFonts
= nil then Exit
;
1330 if Integer(FontID
) > High(e_CharFonts
) then Exit
;
1332 for a
:= 0 to High(e_CharFonts
[FontID
].Chars
) do
1334 if e_CharFonts
[FontID
].Chars
[a
].TextureID
<> -1 then
1335 e_GetTextureSize(e_CharFonts
[FontID
].Chars
[a
].TextureID
, nil, @h2
)
1337 if h2
> Result
then Result
:= h2
;
1341 procedure e_CharFont_Remove(FontID
: DWORD
);
1345 with e_CharFonts
[FontID
] do
1346 for a
:= 0 to High(Chars
) do
1347 if Chars
[a
].TextureID
<> -1 then e_DeleteTexture(Chars
[a
].TextureID
);
1349 e_CharFonts
[FontID
].Live
:= False;
1352 procedure e_CharFont_RemoveAll();
1356 if e_CharFonts
= nil then Exit
;
1358 for a
:= 0 to High(e_CharFonts
) do
1359 e_CharFont_Remove(a
);
1364 procedure e_TextureFontBuild(Texture
: DWORD
; var FontID
: DWORD
; XCount
, YCount
: Word;
1371 e_WriteLog('Creating texture font...', MSG_NOTIFY
);
1375 if e_TextureFonts
<> nil then
1376 for i
:= 0 to High(e_TextureFonts
) do
1377 if e_TextureFonts
[i
].Base
= 0 then
1383 if id
= DWORD(-1) then
1385 SetLength(e_TextureFonts
, Length(e_TextureFonts
) + 1);
1386 id
:= High(e_TextureFonts
);
1389 with e_TextureFonts
[id
] do
1391 Base
:= glGenLists(XCount
*YCount
);
1392 TextureID
:= e_Textures
[Texture
].ID
;
1393 CharWidth
:= (e_Textures
[Texture
].Width
div XCount
)+Space
;
1394 CharHeight
:= e_Textures
[Texture
].Height
div YCount
;
1397 glBindTexture(GL_TEXTURE_2D
, e_Textures
[Texture
].ID
);
1398 for loop1
:= 0 to XCount
*YCount
-1 do
1400 cx
:= (loop1
mod XCount
)/XCount
;
1401 cy
:= (loop1
div YCount
)/YCount
;
1403 glNewList(e_TextureFonts
[id
].Base
+loop1
, GL_COMPILE
);
1405 glTexCoord2f(cx
, 1.0-cy
-1/YCount
);
1406 glVertex2d(0, e_Textures
[Texture
].Height
div YCount
);
1408 glTexCoord2f(cx
+1/XCount
, 1.0-cy
-1/YCount
);
1409 glVertex2i(e_Textures
[Texture
].Width
div XCount
, e_Textures
[Texture
].Height
div YCount
);
1411 glTexCoord2f(cx
+1/XCount
, 1.0-cy
);
1412 glVertex2i(e_Textures
[Texture
].Width
div XCount
, 0);
1414 glTexCoord2f(cx
, 1.0-cy
);
1417 glTranslated((e_Textures
[Texture
].Width
div XCount
)+Space
, 0, 0);
1424 procedure e_TextureFontKill(FontID
: DWORD
);
1426 glDeleteLists(e_TextureFonts
[FontID
].Base
, 256);
1427 e_TextureFonts
[FontID
].Base
:= 0;
1430 procedure e_TextureFontPrint(X
, Y
: GLint
; Text: string; FontID
: DWORD
);
1432 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1433 if Text = '' then Exit
;
1435 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1438 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1441 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1442 glEnable(GL_TEXTURE_2D
);
1443 glTranslated(x
, y
, 0);
1444 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1445 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1446 glDisable(GL_TEXTURE_2D
);
1449 glDisable(GL_BLEND
);
1452 // god forgive me for this, but i cannot figure out how to do it without lists
1453 procedure e_TextureFontPrintChar(X
, Y
: Integer; Ch
: Char; FontID
: DWORD
; Shadow
: Boolean = False);
1459 glColor4ub(0, 0, 0, 128);
1460 glTranslated(X
+1, Y
+1, 0);
1461 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1466 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
1467 glTranslated(X
, Y
, 0);
1468 glCallLists(1, GL_UNSIGNED_BYTE
, @Ch
);
1473 procedure e_TextureFontPrintFmt(X
, Y
: Integer; Text: string; FontID
: DWORD
; Shadow
: Boolean = False);
1475 a
, TX
, TY
, len
: Integer;
1479 if Text = '' then Exit
;
1480 if e_TextureFonts
= nil then Exit
;
1481 if Integer(FontID
) > High(e_TextureFonts
) then Exit
;
1489 len
:= Length(Text);
1491 w
:= e_TextureFonts
[FontID
].CharWidth
;
1493 with e_TextureFonts
[FontID
] do
1495 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1496 glEnable(GL_TEXTURE_2D
);
1497 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1499 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1502 for a
:= 1 to len
do
1513 c
.R
:= 0; c
.G
:= 0; c
.B
:= 0;
1518 c
.R
:= 255; c
.G
:= 255; c
.B
:= 255;
1523 c
.R
:= c
.R
div 2; c
.G
:= c
.G
div 2; c
.B
:= c
.B
div 2;
1528 c
.R
:= Min(c
.R
* 2, 255); c
.G
:= Min(c
.G
* 2, 255); c
.B
:= Min(c
.B
* 2, 255);
1533 c
.R
:= 255; c
.G
:= 0; c
.B
:= 0;
1538 c
.R
:= 0; c
.G
:= 255; c
.B
:= 0;
1543 c
.R
:= 0; c
.G
:= 0; c
.B
:= 255;
1548 c
.R
:= 255; c
.G
:= 255; c
.B
:= 0;
1555 e_TextureFontPrintChar(TX
, TY
, Text[a
], FontID
, Shadow
);
1560 glDisable(GL_TEXTURE_2D
);
1561 glDisable(GL_BLEND
);
1565 procedure e_TextureFontPrintEx(X
, Y
: GLint
; Text: string; FontID
: DWORD
; Red
, Green
,
1566 Blue
: Byte; Scale
: Single; Shadow
: Boolean = False);
1568 if Text = '' then Exit
;
1571 glBindTexture(GL_TEXTURE_2D
, e_TextureFonts
[FontID
].TextureID
);
1572 glEnable(GL_TEXTURE_2D
);
1573 glListBase(DWORD(Integer(e_TextureFonts
[FontID
].Base
)-32));
1575 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1580 glColor4ub(0, 0, 0, 128);
1581 glTranslated(x
+1, y
+1, 0);
1582 glScalef(Scale
, Scale
, 0);
1583 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1588 glColor4ub(Red
, Green
, Blue
, 255);
1589 glTranslated(x
, y
, 0);
1590 glScalef(Scale
, Scale
, 0);
1591 glCallLists(Length(Text), GL_UNSIGNED_BYTE
, PChar(Text));
1593 glDisable(GL_TEXTURE_2D
);
1595 glColor3ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
);
1596 glDisable(GL_BLEND
);
1599 procedure e_TextureFontGetSize(ID
: DWORD
; var CharWidth
, CharHeight
: Byte);
1601 if Integer(ID
) > High(e_TextureFonts
) then
1603 CharWidth
:= e_TextureFonts
[ID
].CharWidth
;
1604 CharHeight
:= e_TextureFonts
[ID
].CharHeight
;
1607 procedure e_RemoveAllTextureFont();
1611 if e_TextureFonts
= nil then Exit
;
1613 for i
:= 0 to High(e_TextureFonts
) do
1614 if e_TextureFonts
[i
].Base
<> 0 then
1616 glDeleteLists(e_TextureFonts
[i
].Base
, 256);
1617 e_TextureFonts
[i
].Base
:= 0;
1620 e_TextureFonts
:= nil;
1623 function _RGB(Red
, Green
, Blue
: Byte): TRGB
;
1630 function _Point(X
, Y
: Integer): TPoint2i
;
1636 function _Rect(X
, Y
: Integer; Width
, Height
: Word): TRectWH
;
1640 Result
.Width
:= Width
;
1641 Result
.Height
:= Height
;