src/engine/e_textures.pas

   1 unit e_textures;
   2
   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
   5   from it's data. }
   6
   7 interface
   8
   9 uses
  10   Windows, dglOpenGL, SysUtils, e_log;
  11
  12 var
  13   fUseMipmaps: Boolean = False;
  14   TEXTUREFILTER: Integer = GL_NEAREST;
  15
  16 // Standard set of images loading functions
  17 function LoadTexture( Filename: String; var Texture: GLuint;
  18                       var pWidth, pHeight: Word ): Boolean;
  19
  20 function LoadTextureEx( Filename: String; var Texture: GLuint;
  21                         fX, fY, fWidth, fHeight: Word ): Boolean;
  22
  23 function LoadTextureMem( pData: Pointer; var Texture: GLuint;
  24                          var pWidth, pHeight: Word ): Boolean;
  25
  26 function LoadTextureMemEx( pData: Pointer; var Texture: GLuint;
  27                            fX, fY, fWidth, fHeight: Word ): Boolean;
  28
  29 implementation
  30
  31 type
  32   TTGAHeader = packed record
  33     FileType:     Byte;
  34     ColorMapType: Byte;
  35     ImageType:    Byte;
  36     ColorMapSpec: array[0..4] of Byte;
  37     OrigX:        array[0..1] of Byte;
  38     OrigY:        array[0..1] of Byte;
  39     Width:        array[0..1] of Byte;
  40     Height:       array[0..1] of Byte;
  41     BPP:          Byte;
  42     ImageInfo:    Byte;
  43   end;
  44
  45 // This is auxiliary function that creates OpenGL texture from raw image data
  46 function CreateTexture( Width, Height, Format: Word; pData: Pointer ): Integer;
  47 var
  48   Texture: GLuint;
  49 begin
  50   glGenTextures( 1, @Texture );
  51   glBindTexture( GL_TEXTURE_2D, Texture );
  52
  53     {Texture blends with object background}
  54   glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE );
  55     {Texture does NOT blend with object background}
  56  // glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
  57
  58   {
  59     Select a filtering type.
  60     BiLinear filtering produces very good results with little performance impact
  61
  62     GL_NEAREST               - Basic texture (grainy looking texture)
  63     GL_LINEAR                - BiLinear filtering
  64     GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
  65     GL_LINEAR_MIPMAP_LINEAR  - BiLinear Mipmapped texture
  66   }
  67
  68   // for GL_TEXTURE_MAG_FILTER only first two can be used
  69   glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, TEXTUREFILTER );
  70   // for GL_TEXTURE_MIN_FILTER all of the above can be used
  71   glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, TEXTUREFILTER );
  72
  73   if Format = GL_RGBA then
  74   begin
  75     if fUseMipmaps then
  76       gluBuild2DMipmaps( GL_TEXTURE_2D, GL_RGBA, Width, Height, GL_RGBA,
  77                          GL_UNSIGNED_BYTE, pData )
  78     else
  79       glTexImage2D( GL_TEXTURE_2D, 0, 4, Width, Height,
  80                     0, GL_RGBA, GL_UNSIGNED_BYTE, pData );
  81   end else
  82   begin
  83     if fUseMipmaps then
  84       gluBuild2DMipmaps( GL_TEXTURE_2D, 3, Width, Height, GL_RGB,
  85                          GL_UNSIGNED_BYTE, pData )
  86     else
  87       glTexImage2D( GL_TEXTURE_2D, 0, 3, Width, Height,
  88                     0, GL_RGB, GL_UNSIGNED_BYTE, pData );
  89   end;
  90
  91   Result := Texture;
  92 end;
  93
  94 function LoadTextureMem( pData: Pointer; var Texture: GLuint;
  95                          var pWidth, pHeight: Word ): Boolean;
  96 var
  97   TGAHeader:     TTGAHeader;
  98   image:         Pointer;
  99   Width, Height: Integer;
 100   ImageSize:     Integer;
 101   i:             Integer;
 102   Front:         ^Byte;
 103   Back:          ^Byte;
 104   Temp:          Byte;
 105   BPP:           Byte;
 106
 107 begin
 108   Result := False;
 109   pWidth := 0;
 110   pHeight := 0;
 111
 112   CopyMemory( @TGAHeader, pData, SizeOf(TGAHeader) );
 113
 114   if ( TGAHeader.ImageType <> 2 ) then
 115   begin
 116     e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING );
 117     Exit;
 118   end;
 119
 120   if ( TGAHeader.ColorMapType <> 0 ) then
 121   begin
 122     e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING );
 123     Exit;
 124   end;
 125
 126   if ( TGAHeader.BPP < 24 ) then
 127   begin
 128     e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING );
 129     Exit;
 130   end;
 131
 132   Width  := TGAHeader.Width[0]  + TGAHeader.Width[1]  * 256;
 133   Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256;
 134   BPP := TGAHeader.BPP;
 135
 136   ImageSize := Width * Height * (BPP div 8);
 137
 138   GetMem( Image, ImageSize );
 139   CopyMemory( Image, Pointer( Integer(pData) + SizeOf(TGAHeader) ), ImageSize );
 140
 141   for i := 0 to Width * Height - 1 do
 142   begin
 143     Front := Pointer( Integer(Image) + i*(BPP div 8) );
 144     Back  := Pointer( Integer(Image) + i*(BPP div 8) + 2 );
 145     Temp   := Front^;
 146     Front^ := Back^;
 147     Back^  := Temp;
 148   end;
 149
 150   if ( BPP = 24 ) then
 151     Texture := CreateTexture( Width, Height, GL_RGB, Image )
 152   else
 153     Texture := CreateTexture( Width, Height, GL_RGBA, Image );
 154
 155   FreeMem( Image );
 156
 157   pWidth := Width;
 158   pHeight := Height;
 159
 160   Result := True;
 161 end;
 162
 163 function LoadTextureMemEx( pData: Pointer; var Texture: GLuint;
 164                            fX, fY, fWidth, fHeight: Word ): Boolean;
 165 var
 166   TGAHeader:     TTGAHeader;
 167   image, image2: Pointer;
 168   Width, Height: Integer;
 169   ImageSize:     Integer;
 170   i, a, b:       Integer;
 171   Front:         ^Byte;
 172   Back:          ^Byte;
 173   Temp:          Byte;
 174   BPP:           Byte;
 175   Base:          Integer;
 176
 177 begin
 178   Result := False;
 179
 180   CopyMemory( @TGAHeader, pData, SizeOf(TGAHeader) );
 181
 182   if ( TGAHeader.ImageType <> 2 ) then
 183   begin
 184     e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING );
 185     Exit;
 186   end;
 187
 188   if ( TGAHeader.ColorMapType <> 0 ) then
 189   begin
 190     e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING );
 191     Exit;
 192   end;
 193
 194   if ( TGAHeader.BPP < 24 ) then
 195   begin
 196     e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING );
 197     Exit;
 198   end;
 199
 200   Width  := TGAHeader.Width[0]  + TGAHeader.Width[1]  * 256;
 201   Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256;
 202   BPP := TGAHeader.BPP;
 203
 204   if fX > Width then Exit;
 205   if fY > Height then Exit;
 206   if fX+fWidth > Width then Exit;
 207   if fY+fHeight > Height then Exit;
 208
 209   ImageSize := Width * Height * (BPP div 8);
 210   GetMem( Image2, ImageSize );
 211   CopyMemory( Image2, Pointer( Integer(pData) + SizeOf(TGAHeader) ), ImageSize );
 212
 213   a := BPP div 8;
 214
 215   for i := 0 to Width * Height - 1 do
 216   begin
 217     Front := Pointer( Integer(Image2) + i * a );
 218     Back  := Pointer( Integer(Image2) + i * a + 2 );
 219     Temp   := Front^;
 220     Front^ := Back^;
 221     Back^  := Temp;
 222   end;
 223
 224   fY := Height - (fY + fHeight);
 225
 226   ImageSize := fHeight * fWidth * (BPP div 8);
 227   GetMem( Image, ImageSize );
 228
 229   Base := Integer( Image2 ) + fY * Width * (BPP div 8) + fX * (BPP div 8);
 230   a := fWidth * (BPP div 8);
 231   b := Width * (BPP div 8);
 232
 233   for i := 0 to fHeight-1 do
 234     CopyMemory( Pointer( Integer(image) + a*i ), Pointer( Base + b*i ), a );
 235
 236   if ( BPP = 24 ) then
 237     Texture := CreateTexture( fWidth, fHeight, GL_RGB, image )
 238   else
 239     Texture := CreateTexture( fWidth, fHeight, GL_RGBA, image );
 240
 241   FreeMem( Image );
 242   FreeMem( Image2 );
 243
 244   Result := True;
 245 end;
 246
 247 function LoadTexture( Filename: String; var Texture: GLuint;
 248                       var pWidth, pHeight: Word ): Boolean;
 249 var
 250   TGAHeader:     TTGAHeader;
 251   TGAFile:       File;
 252   bytesRead:     Integer;
 253   image:         Pointer;
 254   Width, Height: Integer;
 255   ImageSize:     Integer;
 256   i:             Integer;
 257   Front:         ^Byte;
 258   Back:          ^Byte;
 259   Temp:          Byte;
 260   BPP:           Byte;
 261
 262 begin
 263   Result := False;
 264   pWidth := 0;
 265   pHeight := 0;
 266
 267   if not FileExists(Filename) then
 268   begin
 269     e_WriteLog('Texture ' + Filename + ' not found', MSG_WARNING);
 270     Exit;
 271   end;
 272
 273   AssignFile( TGAFile, Filename );
 274   Reset( TGAFile, 1 );
 275   BlockRead( TGAFile, TGAHeader, SizeOf(TGAHeader) );
 276
 277   if ( TGAHeader.ImageType <> 2 ) then
 278   begin
 279     CloseFile( TGAFile );
 280     e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING );
 281     Exit;
 282   end;
 283
 284   if ( TGAHeader.ColorMapType <> 0 ) then
 285   begin
 286     CloseFile( TGAFile );
 287     e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING );
 288     Exit;
 289   end;
 290
 291   if ( TGAHeader.BPP < 24 ) then
 292   begin
 293     CloseFile( TGAFile );
 294     e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING );
 295     Exit;
 296   end;
 297
 298   Width  := TGAHeader.Width[0]  + TGAHeader.Width[1]  * 256;
 299   Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256;
 300   BPP := TGAHeader.BPP;
 301
 302   ImageSize := Width * Height * (BPP div 8);
 303
 304   GetMem( Image, ImageSize );
 305
 306   BlockRead( TGAFile, image^, ImageSize, bytesRead );
 307   if ( bytesRead <> ImageSize ) then
 308   begin
 309     CloseFile( TGAFile );
 310     Exit;
 311   end;
 312
 313   CloseFile( TGAFile );
 314
 315   for i := 0 to Width * Height - 1 do
 316   begin
 317     Front := Pointer( Integer(Image) + i * (BPP div 8) );
 318     Back  := Pointer( Integer(Image) + i * (BPP div 8) + 2 );
 319     Temp   := Front^;
 320     Front^ := Back^;
 321     Back^  := Temp;
 322   end;
 323
 324   if ( BPP = 24 ) then
 325     Texture := CreateTexture( Width, Height, GL_RGB, Image )
 326   else
 327     Texture := CreateTexture( Width, Height, GL_RGBA, Image );
 328
 329   FreeMem( Image );
 330
 331   pWidth := Width;
 332   pHeight := Height;
 333
 334   Result := True;
 335 end;
 336
 337 function LoadTextureEx( Filename: String; var Texture: GLuint;
 338                         fX, fY, fWidth, fHeight: Word ): Boolean;
 339 var
 340   TGAHeader:     TTGAHeader;
 341   TGAFile:       File;
 342   image, image2: Pointer;
 343   Width, Height: Integer;
 344   ImageSize:     Integer;
 345   i:             Integer;
 346   Front:         ^Byte;
 347   Back:          ^Byte;
 348   Temp:          Byte;
 349   BPP:           Byte;
 350   Base:          Integer;
 351
 352 begin
 353   Result := False;
 354
 355   if not FileExists(Filename) then
 356   begin
 357     e_WriteLog( 'Texture ' + Filename + ' not found', MSG_WARNING );
 358     Exit;
 359   end;
 360
 361   AssignFile( TGAFile, Filename );
 362   Reset( TGAFile, 1 );
 363   BlockRead( TGAFile, TGAHeader, SizeOf(TGAHeader) );
 364
 365   if ( TGAHeader.ImageType <> 2 ) then
 366   begin
 367     CloseFile( TGAFile );
 368     e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING );
 369     Exit;
 370   end;
 371
 372   if ( TGAHeader.ColorMapType <> 0 ) then
 373   begin
 374     CloseFile( TGAFile );
 375     e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING );
 376     Exit;
 377   end;
 378
 379   if ( TGAHeader.BPP < 24 ) then
 380   begin
 381     CloseFile( TGAFile );
 382     e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING );
 383     Exit;
 384   end;
 385
 386   Width  := TGAHeader.Width[0]  + TGAHeader.Width[1]  * 256;
 387   Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256;
 388   BPP := TGAHeader.BPP;
 389
 390   if fX > Width then Exit;
 391   if fY > Height then Exit;
 392   if fX+fWidth > Width then Exit;
 393   if fY+fHeight > Height then Exit;
 394
 395   ImageSize := Width * Height * (BPP div 8);
 396   GetMem( Image2, ImageSize );
 397   BlockRead( TGAFile, Image2^, ImageSize );
 398
 399   CloseFile( TGAFile );
 400
 401   for i := 0 to Width * Height - 1 do
 402   begin
 403     Front := Pointer( Integer(Image2) + i * (BPP div 8) );
 404     Back  := Pointer( Integer(Image2) + i * (BPP div 8) + 2 );
 405     Temp   := Front^;
 406     Front^ := Back^;
 407     Back^  := Temp;
 408   end;
 409
 410   fY := Height - (fY + fHeight);
 411
 412   ImageSize := fHeight * fWidth * (BPP div 8);
 413   GetMem( Image, ImageSize );
 414
 415   Base := Integer(Image2) + fY * Width * (BPP div 8) + fX * (BPP div 8);
 416
 417   for i := 0 to fHeight-1 do
 418   begin
 419     CopyMemory( Pointer( Integer(image) + fWidth * (BPP div 8) * i ),
 420                 Pointer( Base + Width * (BPP div 8) * i), fWidth * (BPP div 8) );
 421   end;
 422
 423   if ( BPP = 24 ) then
 424     Texture := CreateTexture( fWidth, fHeight, GL_RGB, Image )
 425   else
 426     Texture := CreateTexture( fWidth, fHeight, GL_RGBA, Image );
 427
 428   FreeMem( Image );
 429   FreeMem( Image2 );
 430
 431   Result := True;
 432 end;
 433
 434 end.
 435