e7bcbcf99e89db1f8cd72da1bb77423ea1bde9fd
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 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
196 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
197 BPP
:= TGAHeader
.BPP
;
199 ImageSize
:= Width
* Height
* (BPP
div 8);
201 GetMem( Image
, ImageSize
);
202 CopyMemory( Image
, PByte(pData
) + SizeOf(TGAHeader
), ImageSize
);
204 for i
:= 0 to Width
* Height
- 1 do
206 Front
:= PByte(Image
) + i
*(BPP
div 8);
207 Back
:= PByte(Image
) + i
*(BPP
div 8) + 2;
218 CreateTexture(Texture
, Width
, Height
, TFmt
, Image
);
222 if Fmt
<> nil then Fmt
^ := TFmt
;
230 function LoadTextureMemEx( pData
: Pointer; var Texture
: GLTexture
;
231 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
233 TGAHeader
: TTGAHeader
;
234 image
, image2
: Pointer;
235 Width
, Height
: Integer;
248 CopyMemory( @TGAHeader
, pData
, SizeOf(TGAHeader
) );
250 if ( TGAHeader
.ImageType
<> 2 ) then
252 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
256 if ( TGAHeader
.ColorMapType
<> 0 ) then
258 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
262 if ( TGAHeader
.BPP
< 24 ) then
264 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
268 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
269 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
270 BPP
:= TGAHeader
.BPP
;
272 if fX
> Width
then Exit
;
273 if fY
> Height
then Exit
;
274 if fX
+fWidth
> Width
then Exit
;
275 if fY
+fHeight
> Height
then Exit
;
277 ImageSize
:= Width
* Height
* (BPP
div 8);
278 GetMem( Image2
, ImageSize
);
279 CopyMemory( Image2
, PByte(pData
) + SizeOf(TGAHeader
), ImageSize
);
283 for i
:= 0 to Width
* Height
- 1 do
285 Front
:= PByte(Image2
) + i
* a
;
286 Back
:= PByte(Image2
) + i
* a
+ 2;
292 fY
:= Height
- (fY
+ fHeight
);
294 ImageSize
:= fHeight
* fWidth
* (BPP
div 8);
295 GetMem( Image
, ImageSize
);
297 Base
:= PByte( Image2
) + fY
* Width
* (BPP
div 8) + fX
* (BPP
div 8);
298 a
:= fWidth
* (BPP
div 8);
299 b
:= Width
* (BPP
div 8);
301 for i
:= 0 to fHeight
-1 do
302 CopyMemory( PByte(image
) + a
*i
, Base
+ b
*i
, a
);
309 CreateTexture(Texture
, fWidth
, fHeight
, TFmt
, Image
);
314 if Fmt
<> nil then Fmt
^ := TFmt
;
319 function LoadTexture( Filename
: String; var Texture
: GLTexture
;
320 var pWidth
, pHeight
: Word; Fmt
: PWord = nil ): Boolean;
322 TGAHeader
: TTGAHeader
;
326 Width
, Height
: Integer;
340 if not FileExists(Filename
) then
342 e_WriteLog('Texture ' + Filename
+ ' not found', MSG_WARNING
);
346 AssignFile( TGAFile
, Filename
);
348 BlockRead( TGAFile
, TGAHeader
, SizeOf(TGAHeader
) );
350 if ( TGAHeader
.ImageType
<> 2 ) then
352 CloseFile( TGAFile
);
353 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
357 if ( TGAHeader
.ColorMapType
<> 0 ) then
359 CloseFile( TGAFile
);
360 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
364 if ( TGAHeader
.BPP
< 24 ) then
366 CloseFile( TGAFile
);
367 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
371 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
372 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
373 BPP
:= TGAHeader
.BPP
;
375 ImageSize
:= Width
* Height
* (BPP
div 8);
377 GetMem( Image
, ImageSize
);
379 BlockRead( TGAFile
, image
^, ImageSize
, bytesRead
);
380 if ( bytesRead
<> ImageSize
) then
382 CloseFile( TGAFile
);
386 CloseFile( TGAFile
);
388 for i
:= 0 to Width
* Height
- 1 do
390 Front
:= PByte(Image
) + i
* (BPP
div 8);
391 Back
:= PByte(Image
) + i
* (BPP
div 8) + 2;
402 CreateTexture(Texture
, Width
, Height
, TFmt
, Image
);
406 if Fmt
<> nil then Fmt
^ := TFmt
;
414 function LoadTextureEx( Filename
: String; var Texture
: GLTexture
;
415 fX
, fY
, fWidth
, fHeight
: Word; Fmt
: PWord = nil ): Boolean;
417 TGAHeader
: TTGAHeader
;
419 image
, image2
: Pointer;
420 Width
, Height
: Integer;
433 if not FileExists(Filename
) then
435 e_WriteLog( 'Texture ' + Filename
+ ' not found', MSG_WARNING
);
439 AssignFile( TGAFile
, Filename
);
441 BlockRead( TGAFile
, TGAHeader
, SizeOf(TGAHeader
) );
443 if ( TGAHeader
.ImageType
<> 2 ) then
445 CloseFile( TGAFile
);
446 e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING
);
450 if ( TGAHeader
.ColorMapType
<> 0 ) then
452 CloseFile( TGAFile
);
453 e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING
);
457 if ( TGAHeader
.BPP
< 24 ) then
459 CloseFile( TGAFile
);
460 e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING
);
464 Width
:= TGAHeader
.Width
[0] + TGAHeader
.Width
[1] * 256;
465 Height
:= TGAHeader
.Height
[0] + TGAHeader
.Height
[1] * 256;
466 BPP
:= TGAHeader
.BPP
;
468 if fX
> Width
then Exit
;
469 if fY
> Height
then Exit
;
470 if fX
+fWidth
> Width
then Exit
;
471 if fY
+fHeight
> Height
then Exit
;
473 ImageSize
:= Width
* Height
* (BPP
div 8);
474 GetMem( Image2
, ImageSize
);
475 BlockRead( TGAFile
, Image2
^, ImageSize
);
477 CloseFile( TGAFile
);
479 for i
:= 0 to Width
* Height
- 1 do
481 Front
:= PByte(Image2
) + i
* (BPP
div 8);
482 Back
:= PByte(Image2
) + i
* (BPP
div 8) + 2;
488 fY
:= Height
- (fY
+ fHeight
);
490 ImageSize
:= fHeight
* fWidth
* (BPP
div 8);
491 GetMem( Image
, ImageSize
);
493 Base
:= PByte(Image2
) + fY
* Width
* (BPP
div 8) + fX
* (BPP
div 8);
495 for i
:= 0 to fHeight
-1 do
497 CopyMemory( PByte(image
) + fWidth
* (BPP
div 8) * i
,
498 Base
+ Width
* (BPP
div 8) * i
, fWidth
* (BPP
div 8) );
506 CreateTexture(Texture
, fWidth
, fHeight
, TFmt
, Image
);
511 if Fmt
<> nil then Fmt
^ := TFmt
;