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
;
15 width
, height
: Word; // real
16 glwidth
, glheight
: Word; // powerof2
17 u
, v
: Single; // usually 1.0
21 fUseMipmaps
: Boolean = False;
22 TEXTUREFILTER
: Integer = GL_NEAREST
;
24 function CreateTexture(var tex
: GLTexture
; Width
, Height
, Format
: Word; pData
: Pointer ): Boolean;
26 // Standard set of images loading functions
27 function LoadTexture( Filename
: String; var Texture
: GLTexture
;
28 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
30 function LoadTextureEx( Filename
: String; var Texture
: GLTexture
;
31 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
33 function LoadTextureMem( pData
: Pointer; var Texture
: GLTexture
;
34 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
36 function LoadTextureMemEx( pData
: Pointer; var Texture
: GLTexture
;
37 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
44 function AlignP2 (n
: Word): Word;
58 TTGAHeader
= packed record
62 ColorMapSpec
: array[0..4] of Byte;
63 OrigX
: array[0..1] of Byte;
64 OrigY
: array[0..1] of Byte;
65 Width
: array[0..1] of Byte;
66 Height
: array[0..1] of Byte;
71 // This is auxiliary function that creates OpenGL texture from raw image data
72 function CreateTexture (var tex
: GLTexture
; Width
, Height
, Format
: Word; pData
: Pointer): Boolean;
78 tex
.glwidth
:= AlignP2(Width
);
79 tex
.glheight
:= AlignP2(Height
);
80 if (tex
.glwidth
= tex
.glwidth
) and (tex
.glheight
= tex
.height
) then
87 tex
.u
:= (tex
.width
+0.0)/(tex
.glwidth
+0.0);
88 tex
.v
:= (tex
.height
+0.0)/(tex
.height
+0.0);
91 glGenTextures(1, @Texture
);
93 glBindTexture(GL_TEXTURE_2D
, Texture
);
95 // texture blends with object background
96 glTexEnvi( GL_TEXTURE_ENV
, GL_TEXTURE_ENV_MODE
, GL_MODULATE
);
97 // texture does NOT blend with object background
98 //glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
101 Select a filtering type.
102 BiLinear filtering produces very good results with little performance impact
104 GL_NEAREST - Basic texture (grainy looking texture)
105 GL_LINEAR - BiLinear filtering
106 GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
107 GL_LINEAR_MIPMAP_LINEAR - BiLinear Mipmapped texture
110 // for GL_TEXTURE_MAG_FILTER only first two can be used
111 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, TEXTUREFILTER
);
112 // for GL_TEXTURE_MIN_FILTER all of the above can be used
113 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, TEXTUREFILTER
);
115 // create empty texture
116 if Format
= GL_RGBA
then
118 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGBA
, tex
.glwidth
, tex
.glheight
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, nil);
119 glTexSubImage2D(GL_TEXTURE_2D
, 0, 0, 0, Width
, Height
, GL_RGBA
, GL_UNSIGNED_BYTE
, pData
);
123 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGB
, tex
.glwidth
, tex
.glheight
, 0, GL_RGB
, GL_UNSIGNED_BYTE
, nil);
124 glTexSubImage2D(GL_TEXTURE_2D
, 0, 0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pData
);
127 // the following is ok too
129 //glTextureSubImage2D(tid, 0, 0, 0, img.width, img.height, GL_RGBA, GL_UNSIGNED_BYTE, img.imageData.bytes.ptr);
132 if (tex.glwidth = tex.glwidth) and (tex.glheight = tex.height) then
134 if Format = GL_RGBA then
136 glTexImage2D(GL_TEXTURE_2D, 0, 4, Width, Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, pData);
140 glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData);
145 glBindTexture(GL_TEXTURE_2D
, 0);
150 function LoadTextureMem( pData
: Pointer; var Texture
: GLTexture
;
151 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
153 TGAHeader
: TTGAHeader
;
155 Width
, Height
: Integer;
169 CopyMemory( @TGAHeader
, pData
, SizeOf(TGAHeader
) );
171 if ( TGAHeader
.ImageType
<> 2 ) then
173 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
177 if ( TGAHeader
.ColorMapType
<> 0 ) then
179 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
183 if ( TGAHeader
.BPP
< 24 ) then
185 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
189 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
190 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
191 BPP
:= TGAHeader
.BPP
;
193 ImageSize
:= Width
* Height
* (BPP
div 8);
195 GetMem( Image
, ImageSize
);
196 CopyMemory( Image
, PByte(pData
) + SizeOf(TGAHeader
), ImageSize
);
198 for i
:= 0 to Width
* Height
- 1 do
200 Front
:= PByte(Image
) + i
*(BPP
div 8);
201 Back
:= PByte(Image
) + i
*(BPP
div 8) + 2;
212 CreateTexture(Texture
, Width
, Height
, TFmt
, Image
);
216 if Fmt
<> nil then Fmt
^ := TFmt
;
224 function LoadTextureMemEx( pData
: Pointer; var Texture
: GLTexture
;
225 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
227 TGAHeader
: TTGAHeader
;
228 image
, image2
: Pointer;
229 Width
, Height
: Integer;
242 CopyMemory( @TGAHeader
, pData
, SizeOf(TGAHeader
) );
244 if ( TGAHeader
.ImageType
<> 2 ) then
246 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
250 if ( TGAHeader
.ColorMapType
<> 0 ) then
252 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
256 if ( TGAHeader
.BPP
< 24 ) then
258 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
262 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
263 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
264 BPP
:= TGAHeader
.BPP
;
266 if fX
> Width
then Exit
;
267 if fY
> Height
then Exit
;
268 if fX
+fWidth
> Width
then Exit
;
269 if fY
+fHeight
> Height
then Exit
;
271 ImageSize
:= Width
* Height
* (BPP
div 8);
272 GetMem( Image2
, ImageSize
);
273 CopyMemory( Image2
, PByte(pData
) + SizeOf(TGAHeader
), ImageSize
);
277 for i
:= 0 to Width
* Height
- 1 do
279 Front
:= PByte(Image2
) + i
* a
;
280 Back
:= PByte(Image2
) + i
* a
+ 2;
286 fY
:= Height
- (fY
+ fHeight
);
288 ImageSize
:= fHeight
* fWidth
* (BPP
div 8);
289 GetMem( Image
, ImageSize
);
291 Base
:= PByte( Image2
) + fY
* Width
* (BPP
div 8) + fX
* (BPP
div 8);
292 a
:= fWidth
* (BPP
div 8);
293 b
:= Width
* (BPP
div 8);
295 for i
:= 0 to fHeight
-1 do
296 CopyMemory( PByte(image
) + a
*i
, Base
+ b
*i
, a
);
303 CreateTexture(Texture
, fWidth
, fHeight
, TFmt
, Image
);
308 if Fmt
<> nil then Fmt
^ := TFmt
;
313 function LoadTexture( Filename
: String; var Texture
: GLTexture
;
314 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
316 TGAHeader
: TTGAHeader
;
320 Width
, Height
: Integer;
334 if not FileExists(Filename
) then
336 e_WriteLog('Texture ' + Filename
+ ' not found', MSG_WARNING
);
340 AssignFile( TGAFile
, Filename
);
342 BlockRead( TGAFile
, TGAHeader
, SizeOf(TGAHeader
) );
344 if ( TGAHeader
.ImageType
<> 2 ) then
346 CloseFile( TGAFile
);
347 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
351 if ( TGAHeader
.ColorMapType
<> 0 ) then
353 CloseFile( TGAFile
);
354 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
358 if ( TGAHeader
.BPP
< 24 ) then
360 CloseFile( TGAFile
);
361 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
365 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
366 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
367 BPP
:= TGAHeader
.BPP
;
369 ImageSize
:= Width
* Height
* (BPP
div 8);
371 GetMem( Image
, ImageSize
);
373 BlockRead( TGAFile
, image
^, ImageSize
, bytesRead
);
374 if ( bytesRead
<> ImageSize
) then
376 CloseFile( TGAFile
);
380 CloseFile( TGAFile
);
382 for i
:= 0 to Width
* Height
- 1 do
384 Front
:= PByte(Image
) + i
* (BPP
div 8);
385 Back
:= PByte(Image
) + i
* (BPP
div 8) + 2;
396 CreateTexture(Texture
, Width
, Height
, TFmt
, Image
);
400 if Fmt
<> nil then Fmt
^ := TFmt
;
408 function LoadTextureEx( Filename
: String; var Texture
: GLTexture
;
409 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
411 TGAHeader
: TTGAHeader
;
413 image
, image2
: Pointer;
414 Width
, Height
: Integer;
427 if not FileExists(Filename
) then
429 e_WriteLog( 'Texture ' + Filename
+ ' not found', MSG_WARNING
);
433 AssignFile( TGAFile
, Filename
);
435 BlockRead( TGAFile
, TGAHeader
, SizeOf(TGAHeader
) );
437 if ( TGAHeader
.ImageType
<> 2 ) then
439 CloseFile( TGAFile
);
440 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
444 if ( TGAHeader
.ColorMapType
<> 0 ) then
446 CloseFile( TGAFile
);
447 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
451 if ( TGAHeader
.BPP
< 24 ) then
453 CloseFile( TGAFile
);
454 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
458 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
459 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
460 BPP
:= TGAHeader
.BPP
;
462 if fX
> Width
then Exit
;
463 if fY
> Height
then Exit
;
464 if fX
+fWidth
> Width
then Exit
;
465 if fY
+fHeight
> Height
then Exit
;
467 ImageSize
:= Width
* Height
* (BPP
div 8);
468 GetMem( Image2
, ImageSize
);
469 BlockRead( TGAFile
, Image2
^, ImageSize
);
471 CloseFile( TGAFile
);
473 for i
:= 0 to Width
* Height
- 1 do
475 Front
:= PByte(Image2
) + i
* (BPP
div 8);
476 Back
:= PByte(Image2
) + i
* (BPP
div 8) + 2;
482 fY
:= Height
- (fY
+ fHeight
);
484 ImageSize
:= fHeight
* fWidth
* (BPP
div 8);
485 GetMem( Image
, ImageSize
);
487 Base
:= PByte(Image2
) + fY
* Width
* (BPP
div 8) + fX
* (BPP
div 8);
489 for i
:= 0 to fHeight
-1 do
491 CopyMemory( PByte(image
) + fWidth
* (BPP
div 8) * i
,
492 Base
+ Width
* (BPP
div 8) * i
, fWidth
* (BPP
div 8) );
500 CreateTexture(Texture
, fWidth
, fHeight
, TFmt
, Image
);
505 if Fmt
<> nil then Fmt
^ := TFmt
;