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