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