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 e_DummyTextures
: Boolean = False;
22 TEXTUREFILTER
: Integer = GL_NEAREST
;
24 function CreateTexture(var tex
: GLTexture
; Width
, Height
, aFormat
: 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;
41 uses BinEditor
, g_options
;
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
, aFormat
: Word; pData
: Pointer): Boolean;
80 tex
.glwidth
:= AlignP2(Width
);
81 tex
.glheight
:= AlignP2(Height
);
86 tex
.glheight
:= Height
;
90 if tex
.glwidth
<> tex
.width
then tex
.u
:= (tex
.width
+0.0)/(tex
.glwidth
+0.0);
91 if tex
.glheight
<> tex
.height
then tex
.v
:= (tex
.height
+0.0)/(tex
.glheight
+0.0);
93 if (tex
.glwidth
<> tex
.width
) or (tex
.glheight
<> tex
.height
) then
95 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
);
98 if e_DummyTextures
then
100 tex
.id
:= GLuint(-1);
105 glGenTextures(1, @Texture
);
107 glBindTexture(GL_TEXTURE_2D
, Texture
);
109 // texture blends with object background
110 glTexEnvi( GL_TEXTURE_ENV
, GL_TEXTURE_ENV_MODE
, GL_MODULATE
);
111 // texture does NOT blend with object background
112 //glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
115 Select a filtering type.
116 BiLinear filtering produces very good results with little performance impact
118 GL_NEAREST - Basic texture (grainy looking texture)
119 GL_LINEAR - BiLinear filtering
120 GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
121 GL_LINEAR_MIPMAP_LINEAR - BiLinear Mipmapped texture
124 // for GL_TEXTURE_MAG_FILTER only first two can be used
125 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, TEXTUREFILTER
);
126 // for GL_TEXTURE_MIN_FILTER all of the above can be used
127 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, TEXTUREFILTER
);
129 // create empty texture
130 if aFormat
= GL_RGBA
then
132 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGBA
, tex
.glwidth
, tex
.glheight
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, nil);
133 glTexSubImage2D(GL_TEXTURE_2D
, 0, 0, 0, Width
, Height
, GL_RGBA
, GL_UNSIGNED_BYTE
, pData
);
137 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGB
, tex
.glwidth
, tex
.glheight
, 0, GL_RGB
, GL_UNSIGNED_BYTE
, nil);
138 glTexSubImage2D(GL_TEXTURE_2D
, 0, 0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pData
);
141 // the following is ok too
143 //glTextureSubImage2D(tid, 0, 0, 0, img.width, img.height, GL_RGBA, GL_UNSIGNED_BYTE, img.imageData.bytes.ptr);
146 if (tex.glwidth = tex.glwidth) and (tex.glheight = tex.height) then
148 if aFormat = GL_RGBA then
150 glTexImage2D(GL_TEXTURE_2D, 0, 4, Width, Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, pData);
154 glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData);
159 glBindTexture(GL_TEXTURE_2D
, 0);
164 function LoadTextureMem( pData
: Pointer; var Texture
: GLTexture
;
165 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
167 TGAHeader
: TTGAHeader
;
169 Width
, Height
: Integer;
183 CopyMemory( @TGAHeader
, pData
, SizeOf(TGAHeader
) );
185 if ( TGAHeader
.ImageType
<> 2 ) then
187 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
191 if ( TGAHeader
.ColorMapType
<> 0 ) then
193 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
197 if ( TGAHeader
.BPP
< 24 ) then
199 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
203 if (TGAHeader
.ImageInfo
and $c0) <> 0 then
205 e_WriteLog('Error loading texture: interleaved TGA', MSG_WARNING
);
209 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
210 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
211 BPP
:= TGAHeader
.BPP
;
213 ImageSize
:= Width
* Height
* (BPP
div 8);
215 GetMem( Image
, ImageSize
);
216 CopyMemory( Image
, PByte(pData
) + SizeOf(TGAHeader
), ImageSize
);
218 for i
:= 0 to Width
* Height
- 1 do
220 Front
:= PByte(Image
) + i
*(BPP
div 8);
221 Back
:= PByte(Image
) + i
*(BPP
div 8) + 2;
227 //if (TGAHeader.ImageInfo and $20) <> 0 then UpsideDown(Image, Width, Height);
234 CreateTexture(Texture
, Width
, Height
, TFmt
, Image
);
238 if Fmt
<> nil then Fmt
^ := TFmt
;
246 function LoadTextureMemEx( pData
: Pointer; var Texture
: GLTexture
;
247 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
249 TGAHeader
: TTGAHeader
;
250 image
, image2
: Pointer;
251 Width
, Height
: Integer;
264 CopyMemory( @TGAHeader
, pData
, SizeOf(TGAHeader
) );
266 if ( TGAHeader
.ImageType
<> 2 ) then
268 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
272 if ( TGAHeader
.ColorMapType
<> 0 ) then
274 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
278 if ( TGAHeader
.BPP
< 24 ) then
280 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
284 if (TGAHeader
.ImageInfo
and $c0) <> 0 then
286 e_WriteLog('Error loading texture: interleaved TGA', MSG_WARNING
);
290 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
291 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
292 BPP
:= TGAHeader
.BPP
;
294 if fX
> Width
then Exit
;
295 if fY
> Height
then Exit
;
296 if fX
+fWidth
> Width
then Exit
;
297 if fY
+fHeight
> Height
then Exit
;
299 ImageSize
:= Width
* Height
* (BPP
div 8);
300 GetMem( Image2
, ImageSize
);
301 CopyMemory( Image2
, PByte(pData
) + SizeOf(TGAHeader
), ImageSize
);
305 for i
:= 0 to Width
* Height
- 1 do
307 Front
:= PByte(Image2
) + i
* a
;
308 Back
:= PByte(Image2
) + i
* a
+ 2;
314 fY
:= Height
- (fY
+ fHeight
);
316 ImageSize
:= fHeight
* fWidth
* (BPP
div 8);
317 GetMem( Image
, ImageSize
);
319 Base
:= PByte( Image2
) + fY
* Width
* (BPP
div 8) + fX
* (BPP
div 8);
320 a
:= fWidth
* (BPP
div 8);
321 b
:= Width
* (BPP
div 8);
323 for i
:= 0 to fHeight
-1 do
324 CopyMemory( PByte(image
) + a
*i
, Base
+ b
*i
, a
);
326 //if (TGAHeader.ImageInfo and $20) <> 0 then UpsideDown(Image, Width, Height);
333 CreateTexture(Texture
, fWidth
, fHeight
, TFmt
, Image
);
338 if Fmt
<> nil then Fmt
^ := TFmt
;
343 function LoadTexture( Filename
: String; var Texture
: GLTexture
;
344 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
346 TGAHeader
: TTGAHeader
;
350 Width
, Height
: Integer;
364 if not FileExists(Filename
) then
366 e_WriteLog('Texture ' + Filename
+ ' not found', MSG_WARNING
);
370 AssignFile( TGAFile
, Filename
);
372 BlockRead( TGAFile
, TGAHeader
, SizeOf(TGAHeader
) );
374 if ( TGAHeader
.ImageType
<> 2 ) then
376 CloseFile( TGAFile
);
377 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
381 if ( TGAHeader
.ColorMapType
<> 0 ) then
383 CloseFile( TGAFile
);
384 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
388 if ( TGAHeader
.BPP
< 24 ) then
390 CloseFile( TGAFile
);
391 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
395 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
396 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
397 BPP
:= TGAHeader
.BPP
;
399 ImageSize
:= Width
* Height
* (BPP
div 8);
401 GetMem( Image
, ImageSize
);
403 BlockRead( TGAFile
, image
^, ImageSize
, bytesRead
);
404 if ( bytesRead
<> ImageSize
) then
406 CloseFile( TGAFile
);
410 CloseFile( TGAFile
);
412 for i
:= 0 to Width
* Height
- 1 do
414 Front
:= PByte(Image
) + i
* (BPP
div 8);
415 Back
:= PByte(Image
) + i
* (BPP
div 8) + 2;
426 CreateTexture(Texture
, Width
, Height
, TFmt
, Image
);
430 if Fmt
<> nil then Fmt
^ := TFmt
;
438 function LoadTextureEx( Filename
: String; var Texture
: GLTexture
;
439 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
441 TGAHeader
: TTGAHeader
;
443 image
, image2
: Pointer;
444 Width
, Height
: Integer;
457 if not FileExists(Filename
) then
459 e_WriteLog( 'Texture ' + Filename
+ ' not found', MSG_WARNING
);
463 AssignFile( TGAFile
, Filename
);
465 BlockRead( TGAFile
, TGAHeader
, SizeOf(TGAHeader
) );
467 if ( TGAHeader
.ImageType
<> 2 ) then
469 CloseFile( TGAFile
);
470 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
474 if ( TGAHeader
.ColorMapType
<> 0 ) then
476 CloseFile( TGAFile
);
477 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
481 if ( TGAHeader
.BPP
< 24 ) then
483 CloseFile( TGAFile
);
484 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
488 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
489 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
490 BPP
:= TGAHeader
.BPP
;
492 if fX
> Width
then Exit
;
493 if fY
> Height
then Exit
;
494 if fX
+fWidth
> Width
then Exit
;
495 if fY
+fHeight
> Height
then Exit
;
497 ImageSize
:= Width
* Height
* (BPP
div 8);
498 GetMem( Image2
, ImageSize
);
499 BlockRead( TGAFile
, Image2
^, ImageSize
);
501 CloseFile( TGAFile
);
503 for i
:= 0 to Width
* Height
- 1 do
505 Front
:= PByte(Image2
) + i
* (BPP
div 8);
506 Back
:= PByte(Image2
) + i
* (BPP
div 8) + 2;
512 fY
:= Height
- (fY
+ fHeight
);
514 ImageSize
:= fHeight
* fWidth
* (BPP
div 8);
515 GetMem( Image
, ImageSize
);
517 Base
:= PByte(Image2
) + fY
* Width
* (BPP
div 8) + fX
* (BPP
div 8);
519 for i
:= 0 to fHeight
-1 do
521 CopyMemory( PByte(image
) + fWidth
* (BPP
div 8) * i
,
522 Base
+ Width
* (BPP
div 8) * i
, fWidth
* (BPP
div 8) );
530 CreateTexture(Texture
, fWidth
, fHeight
, TFmt
, Image
);
535 if Fmt
<> nil then Fmt
^ := TFmt
;