4 { This unit provides interface to load 24-bit and 32-bit uncompressed images
5 from Truevision Targa (TGA) graphic files, and create OpenGL textures
11 GL
, GLExt
, SysUtils
, e_log
;
16 width
, height
: Word; // real
17 glwidth
, glheight
: Word; // powerof2
18 u
, v
: Single; // usually 1.0
22 e_DummyTextures
: Boolean = False;
23 TEXTUREFILTER
: Integer = GL_NEAREST
;
25 function CreateTexture(var tex
: GLTexture
; Width
, Height
, aFormat
: Word; pData
: Pointer ): Boolean;
27 // Standard set of images loading functions
28 function LoadTexture( Filename
: String; var Texture
: GLTexture
;
29 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
31 function LoadTextureEx( Filename
: String; var Texture
: GLTexture
;
32 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
34 function LoadTextureMem( pData
: Pointer; var Texture
: GLTexture
;
35 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
37 function LoadTextureMemEx( pData
: Pointer; var Texture
: GLTexture
;
38 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
42 uses BinEditor
, g_options
;
45 function AlignP2 (n
: Word): Word;
59 TTGAHeader
= packed record
63 ColorMapSpec
: array[0..4] of Byte;
64 OrigX
: array[0..1] of Byte;
65 OrigY
: array[0..1] of Byte;
66 Width
: array[0..1] of Byte;
67 Height
: array[0..1] of Byte;
72 // This is auxiliary function that creates OpenGL texture from raw image data
73 function CreateTexture (var tex
: GLTexture
; Width
, Height
, aFormat
: Word; pData
: Pointer): Boolean;
81 tex
.glwidth
:= AlignP2(Width
);
82 tex
.glheight
:= AlignP2(Height
);
87 tex
.glheight
:= Height
;
91 if tex
.glwidth
<> tex
.width
then tex
.u
:= (tex
.width
+0.0)/(tex
.glwidth
+0.0);
92 if tex
.glheight
<> tex
.height
then tex
.v
:= (tex
.height
+0.0)/(tex
.glheight
+0.0);
94 if (tex
.glwidth
<> tex
.width
) or (tex
.glheight
<> tex
.height
) then
96 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 // texture blends with object background
111 glTexEnvi( GL_TEXTURE_ENV
, GL_TEXTURE_ENV_MODE
, GL_MODULATE
);
112 // texture does NOT blend with object background
113 //glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
116 Select a filtering type.
117 BiLinear filtering produces very good results with little performance impact
119 GL_NEAREST - Basic texture (grainy looking texture)
120 GL_LINEAR - BiLinear filtering
121 GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
122 GL_LINEAR_MIPMAP_LINEAR - BiLinear Mipmapped texture
125 // for GL_TEXTURE_MAG_FILTER only first two can be used
126 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, TEXTUREFILTER
);
127 // for GL_TEXTURE_MIN_FILTER all of the above can be used
128 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, TEXTUREFILTER
);
130 // create empty texture
131 if aFormat
= GL_RGBA
then
133 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGBA
, tex
.glwidth
, tex
.glheight
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, nil);
134 glTexSubImage2D(GL_TEXTURE_2D
, 0, 0, 0, Width
, Height
, GL_RGBA
, GL_UNSIGNED_BYTE
, pData
);
138 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGB
, tex
.glwidth
, tex
.glheight
, 0, GL_RGB
, GL_UNSIGNED_BYTE
, nil);
139 glTexSubImage2D(GL_TEXTURE_2D
, 0, 0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pData
);
142 // the following is ok too
144 //glTextureSubImage2D(tid, 0, 0, 0, img.width, img.height, GL_RGBA, GL_UNSIGNED_BYTE, img.imageData.bytes.ptr);
147 if (tex.glwidth = tex.glwidth) and (tex.glheight = tex.height) then
149 if aFormat = GL_RGBA then
151 glTexImage2D(GL_TEXTURE_2D, 0, 4, Width, Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, pData);
155 glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData);
160 glBindTexture(GL_TEXTURE_2D
, 0);
165 function LoadTextureMem( pData
: Pointer; var Texture
: GLTexture
;
166 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
168 TGAHeader
: TTGAHeader
;
170 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 if (TGAHeader
.ImageInfo
and $c0) <> 0 then
206 e_WriteLog('Error loading texture: interleaved TGA', MSG_WARNING
);
210 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
211 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
212 BPP
:= TGAHeader
.BPP
;
214 ImageSize
:= Width
* Height
* (BPP
div 8);
216 GetMem( Image
, ImageSize
);
217 CopyMemory( Image
, PByte(pData
) + SizeOf(TGAHeader
), ImageSize
);
219 for i
:= 0 to Width
* Height
- 1 do
221 Front
:= PByte(Image
) + i
*(BPP
div 8);
222 Back
:= PByte(Image
) + i
*(BPP
div 8) + 2;
228 //if (TGAHeader.ImageInfo and $20) <> 0 then UpsideDown(Image, Width, Height);
235 CreateTexture(Texture
, Width
, Height
, TFmt
, Image
);
239 if Fmt
<> nil then Fmt
^ := TFmt
;
247 function LoadTextureMemEx( pData
: Pointer; var Texture
: GLTexture
;
248 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
250 TGAHeader
: TTGAHeader
;
251 image
, image2
: Pointer;
252 Width
, Height
: Integer;
265 CopyMemory( @TGAHeader
, pData
, SizeOf(TGAHeader
) );
267 if ( TGAHeader
.ImageType
<> 2 ) then
269 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
273 if ( TGAHeader
.ColorMapType
<> 0 ) then
275 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
279 if ( TGAHeader
.BPP
< 24 ) then
281 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
285 if (TGAHeader
.ImageInfo
and $c0) <> 0 then
287 e_WriteLog('Error loading texture: interleaved TGA', MSG_WARNING
);
291 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
292 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
293 BPP
:= TGAHeader
.BPP
;
295 if fX
> Width
then Exit
;
296 if fY
> Height
then Exit
;
297 if fX
+fWidth
> Width
then Exit
;
298 if fY
+fHeight
> Height
then Exit
;
300 ImageSize
:= Width
* Height
* (BPP
div 8);
301 GetMem( Image2
, ImageSize
);
302 CopyMemory( Image2
, PByte(pData
) + SizeOf(TGAHeader
), ImageSize
);
306 for i
:= 0 to Width
* Height
- 1 do
308 Front
:= PByte(Image2
) + i
* a
;
309 Back
:= PByte(Image2
) + i
* a
+ 2;
315 fY
:= Height
- (fY
+ fHeight
);
317 ImageSize
:= fHeight
* fWidth
* (BPP
div 8);
318 GetMem( Image
, ImageSize
);
320 Base
:= PByte( Image2
) + fY
* Width
* (BPP
div 8) + fX
* (BPP
div 8);
321 a
:= fWidth
* (BPP
div 8);
322 b
:= Width
* (BPP
div 8);
324 for i
:= 0 to fHeight
-1 do
325 CopyMemory( PByte(image
) + a
*i
, Base
+ b
*i
, a
);
327 //if (TGAHeader.ImageInfo and $20) <> 0 then UpsideDown(Image, Width, Height);
334 CreateTexture(Texture
, fWidth
, fHeight
, TFmt
, Image
);
339 if Fmt
<> nil then Fmt
^ := TFmt
;
344 function LoadTexture( Filename
: String; var Texture
: GLTexture
;
345 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
347 TGAHeader
: TTGAHeader
;
351 Width
, Height
: Integer;
365 if not FileExists(Filename
) then
367 e_WriteLog('Texture ' + Filename
+ ' not found', MSG_WARNING
);
371 AssignFile( TGAFile
, Filename
);
373 BlockRead( TGAFile
, TGAHeader
, SizeOf(TGAHeader
) );
375 if ( TGAHeader
.ImageType
<> 2 ) then
377 CloseFile( TGAFile
);
378 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
382 if ( TGAHeader
.ColorMapType
<> 0 ) then
384 CloseFile( TGAFile
);
385 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
389 if ( TGAHeader
.BPP
< 24 ) then
391 CloseFile( TGAFile
);
392 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
396 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
397 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
398 BPP
:= TGAHeader
.BPP
;
400 ImageSize
:= Width
* Height
* (BPP
div 8);
402 GetMem( Image
, ImageSize
);
404 BlockRead( TGAFile
, image
^, ImageSize
, bytesRead
);
405 if ( bytesRead
<> ImageSize
) then
407 CloseFile( TGAFile
);
411 CloseFile( TGAFile
);
413 for i
:= 0 to Width
* Height
- 1 do
415 Front
:= PByte(Image
) + i
* (BPP
div 8);
416 Back
:= PByte(Image
) + i
* (BPP
div 8) + 2;
427 CreateTexture(Texture
, Width
, Height
, TFmt
, Image
);
431 if Fmt
<> nil then Fmt
^ := TFmt
;
439 function LoadTextureEx( Filename
: String; var Texture
: GLTexture
;
440 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
442 TGAHeader
: TTGAHeader
;
444 image
, image2
: Pointer;
445 Width
, Height
: Integer;
458 if not FileExists(Filename
) then
460 e_WriteLog( 'Texture ' + Filename
+ ' not found', MSG_WARNING
);
464 AssignFile( TGAFile
, Filename
);
466 BlockRead( TGAFile
, TGAHeader
, SizeOf(TGAHeader
) );
468 if ( TGAHeader
.ImageType
<> 2 ) then
470 CloseFile( TGAFile
);
471 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
475 if ( TGAHeader
.ColorMapType
<> 0 ) then
477 CloseFile( TGAFile
);
478 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
482 if ( TGAHeader
.BPP
< 24 ) then
484 CloseFile( TGAFile
);
485 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
489 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
490 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
491 BPP
:= TGAHeader
.BPP
;
493 if fX
> Width
then Exit
;
494 if fY
> Height
then Exit
;
495 if fX
+fWidth
> Width
then Exit
;
496 if fY
+fHeight
> Height
then Exit
;
498 ImageSize
:= Width
* Height
* (BPP
div 8);
499 GetMem( Image2
, ImageSize
);
500 BlockRead( TGAFile
, Image2
^, ImageSize
);
502 CloseFile( TGAFile
);
504 for i
:= 0 to Width
* Height
- 1 do
506 Front
:= PByte(Image2
) + i
* (BPP
div 8);
507 Back
:= PByte(Image2
) + i
* (BPP
div 8) + 2;
513 fY
:= Height
- (fY
+ fHeight
);
515 ImageSize
:= fHeight
* fWidth
* (BPP
div 8);
516 GetMem( Image
, ImageSize
);
518 Base
:= PByte(Image2
) + fY
* Width
* (BPP
div 8) + fX
* (BPP
div 8);
520 for i
:= 0 to fHeight
-1 do
522 CopyMemory( PByte(image
) + fWidth
* (BPP
div 8) * i
,
523 Base
+ Width
* (BPP
div 8) * i
, fWidth
* (BPP
div 8) );
531 CreateTexture(Texture
, fWidth
, fHeight
, TFmt
, Image
);
536 if Fmt
<> nil then Fmt
^ := TFmt
;