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