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 TEXTUREFILTER
: Integer = GL_NEAREST
;
23 function CreateTexture(var tex
: GLTexture
; Width
, Height
, aFormat
: Word; pData
: Pointer ): Boolean;
25 // Standard set of images loading functions
26 function LoadTexture( Filename
: String; var Texture
: GLTexture
;
27 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
29 function LoadTextureEx( Filename
: String; var Texture
: GLTexture
;
30 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
32 function LoadTextureMem( pData
: Pointer; var Texture
: GLTexture
;
33 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
35 function LoadTextureMemEx( pData
: Pointer; var Texture
: GLTexture
;
36 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
40 uses BinEditor
, g_options
;
43 function AlignP2 (n
: Word): Word;
57 TTGAHeader
= packed record
61 ColorMapSpec
: array[0..4] of Byte;
62 OrigX
: array[0..1] of Byte;
63 OrigY
: array[0..1] of Byte;
64 Width
: array[0..1] of Byte;
65 Height
: array[0..1] of Byte;
70 // This is auxiliary function that creates OpenGL texture from raw image data
71 function CreateTexture (var tex
: GLTexture
; Width
, Height
, aFormat
: Word; pData
: Pointer): Boolean;
79 tex
.glwidth
:= AlignP2(Width
);
80 tex
.glheight
:= AlignP2(Height
);
85 tex
.glheight
:= Height
;
89 if tex
.glwidth
<> tex
.width
then tex
.u
:= (tex
.width
+0.0)/(tex
.glwidth
+0.0);
90 if tex
.glheight
<> tex
.height
then tex
.v
:= (tex
.height
+0.0)/(tex
.glheight
+0.0);
92 if (tex
.glwidth
<> tex
.width
) or (tex
.glheight
<> tex
.height
) then
94 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
);
97 glGenTextures(1, @Texture
);
99 glBindTexture(GL_TEXTURE_2D
, Texture
);
101 // texture blends with object background
102 glTexEnvi( GL_TEXTURE_ENV
, GL_TEXTURE_ENV_MODE
, GL_MODULATE
);
103 // texture does NOT blend with object background
104 //glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
107 Select a filtering type.
108 BiLinear filtering produces very good results with little performance impact
110 GL_NEAREST - Basic texture (grainy looking texture)
111 GL_LINEAR - BiLinear filtering
112 GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
113 GL_LINEAR_MIPMAP_LINEAR - BiLinear Mipmapped texture
116 // for GL_TEXTURE_MAG_FILTER only first two can be used
117 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, TEXTUREFILTER
);
118 // for GL_TEXTURE_MIN_FILTER all of the above can be used
119 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, TEXTUREFILTER
);
121 // create empty texture
122 if aFormat
= GL_RGBA
then
124 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGBA
, tex
.glwidth
, tex
.glheight
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, nil);
125 glTexSubImage2D(GL_TEXTURE_2D
, 0, 0, 0, Width
, Height
, GL_RGBA
, GL_UNSIGNED_BYTE
, pData
);
129 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGB
, tex
.glwidth
, tex
.glheight
, 0, GL_RGB
, GL_UNSIGNED_BYTE
, nil);
130 glTexSubImage2D(GL_TEXTURE_2D
, 0, 0, 0, Width
, Height
, GL_RGB
, GL_UNSIGNED_BYTE
, pData
);
133 // the following is ok too
135 //glTextureSubImage2D(tid, 0, 0, 0, img.width, img.height, GL_RGBA, GL_UNSIGNED_BYTE, img.imageData.bytes.ptr);
138 if (tex.glwidth = tex.glwidth) and (tex.glheight = tex.height) then
140 if aFormat = GL_RGBA then
142 glTexImage2D(GL_TEXTURE_2D, 0, 4, Width, Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, pData);
146 glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData);
151 glBindTexture(GL_TEXTURE_2D
, 0);
156 function LoadTextureMem( pData
: Pointer; var Texture
: GLTexture
;
157 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
159 TGAHeader
: TTGAHeader
;
161 Width
, Height
: Integer;
175 CopyMemory( @TGAHeader
, pData
, SizeOf(TGAHeader
) );
177 if ( TGAHeader
.ImageType
<> 2 ) then
179 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
183 if ( TGAHeader
.ColorMapType
<> 0 ) then
185 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
189 if ( TGAHeader
.BPP
< 24 ) then
191 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
195 if (TGAHeader
.ImageInfo
and $c0) <> 0 then
197 e_WriteLog('Error loading texture: interleaved TGA', MSG_WARNING
);
201 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
202 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
203 BPP
:= TGAHeader
.BPP
;
205 ImageSize
:= Width
* Height
* (BPP
div 8);
207 GetMem( Image
, ImageSize
);
208 CopyMemory( Image
, PByte(pData
) + SizeOf(TGAHeader
), ImageSize
);
210 for i
:= 0 to Width
* Height
- 1 do
212 Front
:= PByte(Image
) + i
*(BPP
div 8);
213 Back
:= PByte(Image
) + i
*(BPP
div 8) + 2;
219 //if (TGAHeader.ImageInfo and $20) <> 0 then UpsideDown(Image, Width, Height);
226 CreateTexture(Texture
, Width
, Height
, TFmt
, Image
);
230 if Fmt
<> nil then Fmt
^ := TFmt
;
238 function LoadTextureMemEx( pData
: Pointer; var Texture
: GLTexture
;
239 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
241 TGAHeader
: TTGAHeader
;
242 image
, image2
: Pointer;
243 Width
, Height
: Integer;
256 CopyMemory( @TGAHeader
, pData
, SizeOf(TGAHeader
) );
258 if ( TGAHeader
.ImageType
<> 2 ) then
260 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
264 if ( TGAHeader
.ColorMapType
<> 0 ) then
266 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
270 if ( TGAHeader
.BPP
< 24 ) then
272 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
276 if (TGAHeader
.ImageInfo
and $c0) <> 0 then
278 e_WriteLog('Error loading texture: interleaved TGA', MSG_WARNING
);
282 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
283 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
284 BPP
:= TGAHeader
.BPP
;
286 if fX
> Width
then Exit
;
287 if fY
> Height
then Exit
;
288 if fX
+fWidth
> Width
then Exit
;
289 if fY
+fHeight
> Height
then Exit
;
291 ImageSize
:= Width
* Height
* (BPP
div 8);
292 GetMem( Image2
, ImageSize
);
293 CopyMemory( Image2
, PByte(pData
) + SizeOf(TGAHeader
), ImageSize
);
297 for i
:= 0 to Width
* Height
- 1 do
299 Front
:= PByte(Image2
) + i
* a
;
300 Back
:= PByte(Image2
) + i
* a
+ 2;
306 fY
:= Height
- (fY
+ fHeight
);
308 ImageSize
:= fHeight
* fWidth
* (BPP
div 8);
309 GetMem( Image
, ImageSize
);
311 Base
:= PByte( Image2
) + fY
* Width
* (BPP
div 8) + fX
* (BPP
div 8);
312 a
:= fWidth
* (BPP
div 8);
313 b
:= Width
* (BPP
div 8);
315 for i
:= 0 to fHeight
-1 do
316 CopyMemory( PByte(image
) + a
*i
, Base
+ b
*i
, a
);
318 //if (TGAHeader.ImageInfo and $20) <> 0 then UpsideDown(Image, Width, Height);
325 CreateTexture(Texture
, fWidth
, fHeight
, TFmt
, Image
);
330 if Fmt
<> nil then Fmt
^ := TFmt
;
335 function LoadTexture( Filename
: String; var Texture
: GLTexture
;
336 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
338 TGAHeader
: TTGAHeader
;
342 Width
, Height
: Integer;
356 if not FileExists(Filename
) then
358 e_WriteLog('Texture ' + Filename
+ ' not found', MSG_WARNING
);
362 AssignFile( TGAFile
, Filename
);
364 BlockRead( TGAFile
, TGAHeader
, SizeOf(TGAHeader
) );
366 if ( TGAHeader
.ImageType
<> 2 ) then
368 CloseFile( TGAFile
);
369 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
373 if ( TGAHeader
.ColorMapType
<> 0 ) then
375 CloseFile( TGAFile
);
376 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
380 if ( TGAHeader
.BPP
< 24 ) then
382 CloseFile( TGAFile
);
383 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
387 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
388 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
389 BPP
:= TGAHeader
.BPP
;
391 ImageSize
:= Width
* Height
* (BPP
div 8);
393 GetMem( Image
, ImageSize
);
395 BlockRead( TGAFile
, image
^, ImageSize
, bytesRead
);
396 if ( bytesRead
<> ImageSize
) then
398 CloseFile( TGAFile
);
402 CloseFile( TGAFile
);
404 for i
:= 0 to Width
* Height
- 1 do
406 Front
:= PByte(Image
) + i
* (BPP
div 8);
407 Back
:= PByte(Image
) + i
* (BPP
div 8) + 2;
418 CreateTexture(Texture
, Width
, Height
, TFmt
, Image
);
422 if Fmt
<> nil then Fmt
^ := TFmt
;
430 function LoadTextureEx( Filename
: String; var Texture
: GLTexture
;
431 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
433 TGAHeader
: TTGAHeader
;
435 image
, image2
: Pointer;
436 Width
, Height
: Integer;
449 if not FileExists(Filename
) then
451 e_WriteLog( 'Texture ' + Filename
+ ' not found', MSG_WARNING
);
455 AssignFile( TGAFile
, Filename
);
457 BlockRead( TGAFile
, TGAHeader
, SizeOf(TGAHeader
) );
459 if ( TGAHeader
.ImageType
<> 2 ) then
461 CloseFile( TGAFile
);
462 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
466 if ( TGAHeader
.ColorMapType
<> 0 ) then
468 CloseFile( TGAFile
);
469 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
473 if ( TGAHeader
.BPP
< 24 ) then
475 CloseFile( TGAFile
);
476 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
480 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
481 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
482 BPP
:= TGAHeader
.BPP
;
484 if fX
> Width
then Exit
;
485 if fY
> Height
then Exit
;
486 if fX
+fWidth
> Width
then Exit
;
487 if fY
+fHeight
> Height
then Exit
;
489 ImageSize
:= Width
* Height
* (BPP
div 8);
490 GetMem( Image2
, ImageSize
);
491 BlockRead( TGAFile
, Image2
^, ImageSize
);
493 CloseFile( TGAFile
);
495 for i
:= 0 to Width
* Height
- 1 do
497 Front
:= PByte(Image2
) + i
* (BPP
div 8);
498 Back
:= PByte(Image2
) + i
* (BPP
div 8) + 2;
504 fY
:= Height
- (fY
+ fHeight
);
506 ImageSize
:= fHeight
* fWidth
* (BPP
div 8);
507 GetMem( Image
, ImageSize
);
509 Base
:= PByte(Image2
) + fY
* Width
* (BPP
div 8) + fX
* (BPP
div 8);
511 for i
:= 0 to fHeight
-1 do
513 CopyMemory( PByte(image
) + fWidth
* (BPP
div 8) * i
,
514 Base
+ Width
* (BPP
div 8) * i
, fWidth
* (BPP
div 8) );
522 CreateTexture(Texture
, fWidth
, fHeight
, TFmt
, Image
);
527 if Fmt
<> nil then Fmt
^ := TFmt
;