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