src/engine/e_textures.pas

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