3 { This unit provides interface to load 24-bit and 32-bit uncompressed images
4 from Truevision Targa (TGA) graphic files, and create OpenGL textures
10 GL
, GLExt
, SysUtils
, e_log
;
13 fUseMipmaps
: Boolean = False;
14 TEXTUREFILTER
: Integer = GL_NEAREST
;
16 function CreateTexture( Width
, Height
, Format
: Word; pData
: Pointer ): Integer;
18 // Standard set of images loading functions
19 function LoadTexture( Filename
: String; var Texture
: GLuint
;
20 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
22 function LoadTextureEx( Filename
: String; var Texture
: GLuint
;
23 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
25 function LoadTextureMem( pData
: Pointer; var Texture
: GLuint
;
26 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
28 function LoadTextureMemEx( pData
: Pointer; var Texture
: GLuint
;
29 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
36 TTGAHeader
= packed record
40 ColorMapSpec
: array[0..4] of Byte;
41 OrigX
: array[0..1] of Byte;
42 OrigY
: array[0..1] of Byte;
43 Width
: array[0..1] of Byte;
44 Height
: array[0..1] of Byte;
49 // This is auxiliary function that creates OpenGL texture from raw image data
50 function CreateTexture( Width
, Height
, Format
: Word; pData
: Pointer ): Integer;
54 glGenTextures( 1, @Texture
);
55 glBindTexture( GL_TEXTURE_2D
, Texture
);
57 {Texture blends with object background}
58 glTexEnvi( GL_TEXTURE_ENV
, GL_TEXTURE_ENV_MODE
, GL_MODULATE
);
59 {Texture does NOT blend with object background}
60 // glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
63 Select a filtering type.
64 BiLinear filtering produces very good results with little performance impact
66 GL_NEAREST - Basic texture (grainy looking texture)
67 GL_LINEAR - BiLinear filtering
68 GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
69 GL_LINEAR_MIPMAP_LINEAR - BiLinear Mipmapped texture
72 // for GL_TEXTURE_MAG_FILTER only first two can be used
73 glTexParameteri( GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, TEXTUREFILTER
);
74 // for GL_TEXTURE_MIN_FILTER all of the above can be used
75 glTexParameteri( GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, TEXTUREFILTER
);
77 if Format
= GL_RGBA
then
79 glTexImage2D( GL_TEXTURE_2D
, 0, 4, Width
, Height
,
80 0, GL_RGBA
, GL_UNSIGNED_BYTE
, pData
);
83 glTexImage2D( GL_TEXTURE_2D
, 0, 3, Width
, Height
,
84 0, GL_RGB
, GL_UNSIGNED_BYTE
, pData
);
87 glBindTexture(GL_TEXTURE_2D
, 0);
92 function LoadTextureMem( pData
: Pointer; var Texture
: GLuint
;
93 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
95 TGAHeader
: TTGAHeader
;
97 Width
, Height
: Integer;
111 CopyMemory( @TGAHeader
, pData
, SizeOf(TGAHeader
) );
113 if ( TGAHeader
.ImageType
<> 2 ) then
115 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
119 if ( TGAHeader
.ColorMapType
<> 0 ) then
121 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
125 if ( TGAHeader
.BPP
< 24 ) then
127 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
131 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
132 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
133 BPP
:= TGAHeader
.BPP
;
135 ImageSize
:= Width
* Height
* (BPP
div 8);
137 GetMem( Image
, ImageSize
);
138 CopyMemory( Image
, PByte(pData
) + SizeOf(TGAHeader
), ImageSize
);
140 for i
:= 0 to Width
* Height
- 1 do
142 Front
:= PByte(Image
) + i
*(BPP
div 8);
143 Back
:= PByte(Image
) + i
*(BPP
div 8) + 2;
154 Texture
:= CreateTexture( Width
, Height
, TFmt
, Image
);
158 if Fmt
<> nil then Fmt
^ := TFmt
;
166 function LoadTextureMemEx( pData
: Pointer; var Texture
: GLuint
;
167 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
169 TGAHeader
: TTGAHeader
;
170 image
, image2
: Pointer;
171 Width
, Height
: Integer;
184 CopyMemory( @TGAHeader
, pData
, SizeOf(TGAHeader
) );
186 if ( TGAHeader
.ImageType
<> 2 ) then
188 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
192 if ( TGAHeader
.ColorMapType
<> 0 ) then
194 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
198 if ( TGAHeader
.BPP
< 24 ) then
200 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
204 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
205 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
206 BPP
:= TGAHeader
.BPP
;
208 if fX
> Width
then Exit
;
209 if fY
> Height
then Exit
;
210 if fX
+fWidth
> Width
then Exit
;
211 if fY
+fHeight
> Height
then Exit
;
213 ImageSize
:= Width
* Height
* (BPP
div 8);
214 GetMem( Image2
, ImageSize
);
215 CopyMemory( Image2
, PByte(pData
) + SizeOf(TGAHeader
), ImageSize
);
219 for i
:= 0 to Width
* Height
- 1 do
221 Front
:= PByte(Image2
) + i
* a
;
222 Back
:= PByte(Image2
) + i
* a
+ 2;
228 fY
:= Height
- (fY
+ fHeight
);
230 ImageSize
:= fHeight
* fWidth
* (BPP
div 8);
231 GetMem( Image
, ImageSize
);
233 Base
:= PByte( Image2
) + fY
* Width
* (BPP
div 8) + fX
* (BPP
div 8);
234 a
:= fWidth
* (BPP
div 8);
235 b
:= Width
* (BPP
div 8);
237 for i
:= 0 to fHeight
-1 do
238 CopyMemory( PByte(image
) + a
*i
, Base
+ b
*i
, a
);
245 Texture
:= CreateTexture( fWidth
, fHeight
, TFmt
, Image
);
250 if Fmt
<> nil then Fmt
^ := TFmt
;
255 function LoadTexture( Filename
: String; var Texture
: GLuint
;
256 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
258 TGAHeader
: TTGAHeader
;
262 Width
, Height
: Integer;
276 if not FileExists(Filename
) then
278 e_WriteLog('Texture ' + Filename
+ ' not found', MSG_WARNING
);
282 AssignFile( TGAFile
, Filename
);
284 BlockRead( TGAFile
, TGAHeader
, SizeOf(TGAHeader
) );
286 if ( TGAHeader
.ImageType
<> 2 ) then
288 CloseFile( TGAFile
);
289 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
293 if ( TGAHeader
.ColorMapType
<> 0 ) then
295 CloseFile( TGAFile
);
296 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
300 if ( TGAHeader
.BPP
< 24 ) then
302 CloseFile( TGAFile
);
303 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
307 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
308 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
309 BPP
:= TGAHeader
.BPP
;
311 ImageSize
:= Width
* Height
* (BPP
div 8);
313 GetMem( Image
, ImageSize
);
315 BlockRead( TGAFile
, image
^, ImageSize
, bytesRead
);
316 if ( bytesRead
<> ImageSize
) then
318 CloseFile( TGAFile
);
322 CloseFile( TGAFile
);
324 for i
:= 0 to Width
* Height
- 1 do
326 Front
:= PByte(Image
) + i
* (BPP
div 8);
327 Back
:= PByte(Image
) + i
* (BPP
div 8) + 2;
338 Texture
:= CreateTexture( Width
, Height
, TFmt
, Image
);
342 if Fmt
<> nil then Fmt
^ := TFmt
;
350 function LoadTextureEx( Filename
: String; var Texture
: GLuint
;
351 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
353 TGAHeader
: TTGAHeader
;
355 image
, image2
: Pointer;
356 Width
, Height
: Integer;
369 if not FileExists(Filename
) then
371 e_WriteLog( 'Texture ' + Filename
+ ' not found', MSG_WARNING
);
375 AssignFile( TGAFile
, Filename
);
377 BlockRead( TGAFile
, TGAHeader
, SizeOf(TGAHeader
) );
379 if ( TGAHeader
.ImageType
<> 2 ) then
381 CloseFile( TGAFile
);
382 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
386 if ( TGAHeader
.ColorMapType
<> 0 ) then
388 CloseFile( TGAFile
);
389 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
393 if ( TGAHeader
.BPP
< 24 ) then
395 CloseFile( TGAFile
);
396 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
400 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
401 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
402 BPP
:= TGAHeader
.BPP
;
404 if fX
> Width
then Exit
;
405 if fY
> Height
then Exit
;
406 if fX
+fWidth
> Width
then Exit
;
407 if fY
+fHeight
> Height
then Exit
;
409 ImageSize
:= Width
* Height
* (BPP
div 8);
410 GetMem( Image2
, ImageSize
);
411 BlockRead( TGAFile
, Image2
^, ImageSize
);
413 CloseFile( TGAFile
);
415 for i
:= 0 to Width
* Height
- 1 do
417 Front
:= PByte(Image2
) + i
* (BPP
div 8);
418 Back
:= PByte(Image2
) + i
* (BPP
div 8) + 2;
424 fY
:= Height
- (fY
+ fHeight
);
426 ImageSize
:= fHeight
* fWidth
* (BPP
div 8);
427 GetMem( Image
, ImageSize
);
429 Base
:= PByte(Image2
) + fY
* Width
* (BPP
div 8) + fX
* (BPP
div 8);
431 for i
:= 0 to fHeight
-1 do
433 CopyMemory( PByte(image
) + fWidth
* (BPP
div 8) * i
,
434 Base
+ Width
* (BPP
div 8) * i
, fWidth
* (BPP
div 8) );
442 Texture
:= CreateTexture( fWidth
, fHeight
, TFmt
, Image
);
447 if Fmt
<> nil then Fmt
^ := TFmt
;