1 (* Copyright (C) Doom 2D: Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE ../shared/a_modes.inc}
19 { This unit provides interface to load 24-bit and 32-bit uncompressed images
20 from Truevision Targa (TGA) graphic files, and create OpenGL textures
26 {$INCLUDE ../nogl/noGLuses.inc}
27 SysUtils
, e_log
, ImagingTypes
, Imaging
, ImagingUtility
;
32 width
, height
: Word; // real
33 glwidth
, glheight
: Word; // powerof2
34 u
, v
: Single; // usually 1.0
39 e_DummyTextures
: Boolean = False;
40 TEXTUREFILTER
: Integer = GL_NEAREST
;
42 function CreateTexture (var tex
: GLTexture
; Width
, Height
, aFormat
: Word; pData
: Pointer): Boolean;
44 // Standard set of images loading functions
45 function LoadTexture (Filename
: String; var Texture
: GLTexture
; var pWidth
, pHeight
: Word; Fmt
: PWord
=nil): Boolean;
46 function LoadTextureEx (Filename
: String; var Texture
: GLTexture
; fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord
=nil): Boolean;
47 function LoadTextureMem (pData
: Pointer; dataSize
: LongInt; var Texture
: GLTexture
; var pWidth
, pHeight
: Word; Fmt
: PWord
=nil): Boolean;
48 function LoadTextureMemEx (pData
: Pointer; dataSize
: LongInt; var Texture
: GLTexture
; fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord
=nil): Boolean;
50 // `img` must be valid!
51 function LoadTextureImg (var img
: TImageData
; var Texture
: GLTexture
; var pWidth
, pHeight
: Word; Fmt
: PWord
=nil): Boolean;
57 Classes
, g_options
, utils
;
60 function AlignP2 (n
: Word): Word;
73 // This is auxiliary function that creates OpenGL texture from raw image data
74 function CreateTexture (var tex
: GLTexture
; Width
, Height
, aFormat
: Word; pData
: Pointer): Boolean;
84 tex
.glheight
:= Height
;
90 tex
.glwidth
:= AlignP2(Width
);
91 tex
.glheight
:= AlignP2(Height
);
92 if tex
.glwidth
<> tex
.width
then tex
.u
:= (tex
.width
+0.0)/(tex
.glwidth
+0.0);
93 if tex
.glheight
<> tex
.height
then tex
.v
:= (tex
.height
+0.0)/(tex
.glheight
+0.0);
96 //if (tex.glwidth <> tex.width) or (tex.glheight <> tex.height) then
97 // e_WriteLog(Format('NPOT: orig is %ux%u; gl is %ux%u; u=%f; v=%f', [Width, Height, tex.glwidth, tex.glheight, tex.u, tex.v]), MSG_NOTIFY);
99 if e_DummyTextures
then
101 tex
.id
:= GLuint(-1);
106 glGenTextures(1, @Texture
);
108 glBindTexture(GL_TEXTURE_2D
, Texture
);
110 if (tex
.glwidth
<> tex
.width
) or (tex
.glheight
<> tex
.height
) then
111 e_WriteLog(Format('NPOT: %u is %ux%u; gl is %ux%u; u=%f; v=%f', [tex
.id
, Width
, Height
, tex
.glwidth
, tex
.glheight
, tex
.u
, tex
.v
]), TMsgType
.Notify
);
113 // texture blends with object background
114 glTexEnvi(GL_TEXTURE_ENV
, GL_TEXTURE_ENV_MODE
, GL_MODULATE
);
115 // texture does NOT blend with object background
116 //glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
119 Select a filtering type.
120 BiLinear filtering produces very good results with little performance impact
122 GL_NEAREST - Basic texture (grainy looking texture)
123 GL_LINEAR - BiLinear filtering
124 GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
125 GL_LINEAR_MIPMAP_LINEAR - BiLinear Mipmapped texture
128 // for GL_TEXTURE_MAG_FILTER only first two can be used
129 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, TEXTUREFILTER
);
130 // for GL_TEXTURE_MIN_FILTER all of the above can be used
131 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, TEXTUREFILTER
);
133 // create empty texture
134 if aFormat
= GL_RGBA
then fmt
:= GL_RGBA
else fmt
:= GL_RGB
; // silly, yeah?
135 glTexImage2D(GL_TEXTURE_2D
, 0, fmt
, tex
.glwidth
, tex
.glheight
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, nil);
138 GetMem(buf, tex.glwidth*4*tex.glheight);
140 FillChar(buf^, tex.glwidth*4*tex.glheight, 255);
141 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, tex.glwidth, tex.glheight, fmt, GL_UNSIGNED_BYTE, buf);
142 if (tex.glheight = 128) and (tex.height = 80) then
144 for f := 0 to tex.glheight-1 do
146 for c := 0 to tex.glwidth-1 do
148 buf[f*(tex.glwidth*4)+c*4+0] := 255;
149 buf[f*(tex.glwidth*4)+c*4+1] := 127;
150 buf[f*(tex.glwidth*4)+c*4+2] := 0;
153 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 82, tex.glwidth, {tex.glheight}1, fmt, GL_UNSIGNED_BYTE, buf);
160 glTexSubImage2D(GL_TEXTURE_2D
, 0, 0, 0, Width
, Height
, fmt
, GL_UNSIGNED_BYTE
, pData
);
161 //glTexSubImage2D(GL_TEXTURE_2D, 0, 0, tex.glheight-tex.height, Width, Height, fmt, GL_UNSIGNED_BYTE, pData);
163 glBindTexture(GL_TEXTURE_2D
, 0);
165 // so driver will really upload the texture (this is *sometimes* required for buggy videodrivers)
172 // `img` must be valid!
173 function LoadTextureImg (var img
: TImageData
; var Texture
: GLTexture
; var pWidth
, pHeight
: Word; Fmt
: PWord
=nil): Boolean;
176 width
, height
: Integer;
184 if Fmt
<> nil then Fmt
^ := GL_RGBA
; // anyway
186 if (img
.width
< 1) or (img
.width
> 32768) or (img
.height
< 1) or (img
.height
> 32768) then
188 e_WriteLog('Error loading texture: invalid image dimensions', TMsgType
.Warning
);
191 //ConvertImage(img, ifA8R8G8B8);
193 height
:= img
.height
;
196 imageSize
:= Width
*Height
*4;
197 GetMem(image
, imageSize
);
199 // it is slow, but i don't care for now
201 for y
:= height
-1 downto 0 do
203 for x
:= 0 to width
-1 do
205 clr
:= GetPixel32(img
, x
, y
);
206 ii
^ := clr
.r
; Inc(ii
);
207 ii
^ := clr
.g
; Inc(ii
);
208 ii
^ := clr
.b
; Inc(ii
);
209 ii
^ := clr
.a
; Inc(ii
);
212 CreateTexture(Texture
, width
, height
, GL_RGBA
, image
);
220 function LoadTextureMem (pData
: Pointer; dataSize
: LongInt; var Texture
: GLTexture
; var pWidth
, pHeight
: Word; Fmt
: PWord
=nil): Boolean;
223 //width, height: Integer;
224 //imageSize: Integer;
232 if Fmt
<> nil then Fmt
^ := GL_RGBA
; // anyway
235 if not LoadImageFromMemory(pData
, dataSize
, img
) then
237 e_WriteLog('Error loading texture: unknown image format', TMsgType
.Warning
);
241 result
:= LoadTextureImg(img
, Texture
, pWidth
, pHeight
, Fmt
);
248 function LoadTextureMemEx (pData
: Pointer; dataSize
: LongInt; var Texture
: GLTexture
; fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord
=nil): Boolean;
251 //width, height: Integer;
258 if Fmt
<> nil then Fmt
^ := GL_RGBA
; // anyway
261 if not LoadImageFromMemory(pData
, dataSize
, img
) then
263 e_WriteLog('Error loading texture: unknown image format', TMsgType
.Warning
);
267 if (img
.width
< 1) or (img
.width
> 32768) or (img
.height
< 1) or (img
.height
> 32768) then
269 e_WriteLog('Error loading texture: invalid image dimensions', TMsgType
.Warning
);
272 //ConvertImage(img, ifA8R8G8B8);
273 if fX
> img
.width
then exit
;
274 if fY
> img
.height
then exit
;
275 if fX
+fWidth
> img
.width
then exit
;
276 if fY
+fHeight
> img
.height
then exit
;
277 //writeln('fX=', fX, '; fY=', fY, '; fWidth=', fWidth, '; fHeight=', fHeight);
278 imageSize
:= img
.width
*img
.height
*4;
279 GetMem(image
, imageSize
);
281 // it is slow, but i don't care for now
283 for y
:= fY
+fHeight
-1 downto fY
do
285 for x
:= fX
to fX
+fWidth
-1 do
287 clr
:= GetPixel32(img
, x
, y
);
288 ii
^ := clr
.r
; Inc(ii
);
289 ii
^ := clr
.g
; Inc(ii
);
290 ii
^ := clr
.b
; Inc(ii
);
291 ii
^ := clr
.a
; Inc(ii
);
294 CreateTexture(Texture
, fWidth
, fHeight
, GL_RGBA
, image
);
305 function LoadTexture (filename
: AnsiString
; var Texture
: GLTexture
; var pWidth
, pHeight
: Word; Fmt
: PWord
=nil): Boolean;
314 if Fmt
<> nil then Fmt
^ := GL_RGBA
; // anyway
318 fs
:= openDiskFileRO(filename
);
324 e_WriteLog('Texture "'+filename
+'" not found', TMsgType
.Warning
);
329 imageSize
:= fs
.size
;
330 GetMem(img
, imageSize
);
332 fs
.readBuffer(img
^, imageSize
);
333 result
:= LoadTextureMem(img
, imageSize
, Texture
, pWidth
, pHeight
, Fmt
);
343 function LoadTextureEx (filename
: AnsiString
; var Texture
: GLTexture
; fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord
=nil): Boolean;
350 if Fmt
<> nil then Fmt
^ := GL_RGBA
; // anyway
354 fs
:= openDiskFileRO(filename
);
360 e_WriteLog('Texture "'+filename
+'" not found', TMsgType
.Warning
);
365 imageSize
:= fs
.size
;
366 GetMem(img
, imageSize
);
368 fs
.readBuffer(img
^, imageSize
);
369 result
:= LoadTextureMemEx(img
, imageSize
, Texture
, fX
, fY
, fWidth
, fHeight
, Fmt
);