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   Width  := TGAHeader.Width[0]  + TGAHeader.Width[1]  * 256;
 196   Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256;
 197   BPP := TGAHeader.BPP;
 198
 199   ImageSize := Width * Height * (BPP div 8);
 200
 201   GetMem( Image, ImageSize );
 202   CopyMemory( Image, PByte(pData) + SizeOf(TGAHeader), ImageSize );
 203
 204   for i := 0 to Width * Height - 1 do
 205   begin
 206     Front := PByte(Image) + i*(BPP div 8);
 207     Back  := PByte(Image) + i*(BPP div 8) + 2;
 208     Temp   := Front^;
 209     Front^ := Back^;
 210     Back^  := Temp;
 211   end;
 212
 213   if ( BPP = 24 ) then
 214     TFmt := GL_RGB
 215   else
 216     TFmt := GL_RGBA;
 217
 218   CreateTexture(Texture, Width, Height, TFmt, Image );
 219
 220   FreeMem( Image );
 221
 222   if Fmt <> nil then Fmt^ := TFmt;
 223
 224   pWidth := Width;
 225   pHeight := Height;
 226
 227   Result := True;
 228 end;
 229
 230 function LoadTextureMemEx( pData: Pointer; var Texture: GLTexture;
 231                            fX, fY, fWidth, fHeight: Word; Fmt: PWord = nil ): Boolean;
 232 var
 233   TGAHeader:     TTGAHeader;
 234   image, image2: Pointer;
 235   Width, Height: Integer;
 236   ImageSize:     Integer;
 237   i, a, b:       Integer;
 238   Front:         ^Byte;
 239   Back:          ^Byte;
 240   Temp:          Byte;
 241   BPP:           Byte;
 242   Base:          PByte;
 243   TFmt:          Word;
 244
 245 begin
 246   Result := False;
 247
 248   CopyMemory( @TGAHeader, pData, SizeOf(TGAHeader) );
 249
 250   if ( TGAHeader.ImageType <> 2 ) then
 251   begin
 252     e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING );
 253     Exit;
 254   end;
 255
 256   if ( TGAHeader.ColorMapType <> 0 ) then
 257   begin
 258     e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING );
 259     Exit;
 260   end;
 261
 262   if ( TGAHeader.BPP < 24 ) then
 263   begin
 264     e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING );
 265     Exit;
 266   end;
 267
 268   Width  := TGAHeader.Width[0]  + TGAHeader.Width[1]  * 256;
 269   Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256;
 270   BPP := TGAHeader.BPP;
 271
 272   if fX > Width then Exit;
 273   if fY > Height then Exit;
 274   if fX+fWidth > Width then Exit;
 275   if fY+fHeight > Height then Exit;
 276
 277   ImageSize := Width * Height * (BPP div 8);
 278   GetMem( Image2, ImageSize );
 279   CopyMemory( Image2, PByte(pData) + SizeOf(TGAHeader), ImageSize );
 280
 281   a := BPP div 8;
 282
 283   for i := 0 to Width * Height - 1 do
 284   begin
 285     Front := PByte(Image2) + i * a;
 286     Back  := PByte(Image2) + i * a + 2;
 287     Temp   := Front^;
 288     Front^ := Back^;
 289     Back^  := Temp;
 290   end;
 291
 292   fY := Height - (fY + fHeight);
 293
 294   ImageSize := fHeight * fWidth * (BPP div 8);
 295   GetMem( Image, ImageSize );
 296
 297   Base := PByte( Image2 ) + fY * Width * (BPP div 8) + fX * (BPP div 8);
 298   a := fWidth * (BPP div 8);
 299   b := Width * (BPP div 8);
 300
 301   for i := 0 to fHeight-1 do
 302     CopyMemory( PByte(image) + a*i, Base + b*i, a );
 303
 304   if ( BPP = 24 ) then
 305     TFmt := GL_RGB
 306   else
 307     TFmt := GL_RGBA;
 308
 309   CreateTexture(Texture, fWidth, fHeight, TFmt, Image );
 310
 311   FreeMem( Image );
 312   FreeMem( Image2 );
 313
 314   if Fmt <> nil then Fmt^ := TFmt;
 315
 316   Result := True;
 317 end;
 318
 319 function LoadTexture( Filename: String; var Texture: GLTexture;
 320                       var pWidth, pHeight: Word; Fmt: PWord = nil ): Boolean;
 321 var
 322   TGAHeader:     TTGAHeader;
 323   TGAFile:       File;
 324   bytesRead:     Integer;
 325   image:         Pointer;
 326   Width, Height: Integer;
 327   ImageSize:     Integer;
 328   i:             Integer;
 329   Front:         ^Byte;
 330   Back:          ^Byte;
 331   Temp:          Byte;
 332   BPP:           Byte;
 333   TFmt:          Word;
 334
 335 begin
 336   Result := False;
 337   pWidth := 0;
 338   pHeight := 0;
 339
 340   if not FileExists(Filename) then
 341   begin
 342     e_WriteLog('Texture ' + Filename + ' not found', MSG_WARNING);
 343     Exit;
 344   end;
 345
 346   AssignFile( TGAFile, Filename );
 347   Reset( TGAFile, 1 );
 348   BlockRead( TGAFile, TGAHeader, SizeOf(TGAHeader) );
 349
 350   if ( TGAHeader.ImageType <> 2 ) then
 351   begin
 352     CloseFile( TGAFile );
 353     e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING );
 354     Exit;
 355   end;
 356
 357   if ( TGAHeader.ColorMapType <> 0 ) then
 358   begin
 359     CloseFile( TGAFile );
 360     e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING );
 361     Exit;
 362   end;
 363
 364   if ( TGAHeader.BPP < 24 ) then
 365   begin
 366     CloseFile( TGAFile );
 367     e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING );
 368     Exit;
 369   end;
 370
 371   Width  := TGAHeader.Width[0]  + TGAHeader.Width[1]  * 256;
 372   Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256;
 373   BPP := TGAHeader.BPP;
 374
 375   ImageSize := Width * Height * (BPP div 8);
 376
 377   GetMem( Image, ImageSize );
 378
 379   BlockRead( TGAFile, image^, ImageSize, bytesRead );
 380   if ( bytesRead <> ImageSize ) then
 381   begin
 382     CloseFile( TGAFile );
 383     Exit;
 384   end;
 385
 386   CloseFile( TGAFile );
 387
 388   for i := 0 to Width * Height - 1 do
 389   begin
 390     Front := PByte(Image) + i * (BPP div 8);
 391     Back  := PByte(Image) + i * (BPP div 8) + 2;
 392     Temp   := Front^;
 393     Front^ := Back^;
 394     Back^  := Temp;
 395   end;
 396
 397   if ( BPP = 24 ) then
 398     TFmt := GL_RGB
 399   else
 400     TFmt := GL_RGBA;
 401
 402   CreateTexture(Texture, Width, Height, TFmt, Image );
 403
 404   FreeMem( Image );
 405
 406   if Fmt <> nil then Fmt^ := TFmt;
 407
 408   pWidth := Width;
 409   pHeight := Height;
 410
 411   Result := True;
 412 end;
 413
 414 function LoadTextureEx( Filename: String; var Texture: GLTexture;
 415                         fX, fY, fWidth, fHeight: Word; Fmt: PWord = nil ): Boolean;
 416 var
 417   TGAHeader:     TTGAHeader;
 418   TGAFile:       File;
 419   image, image2: Pointer;
 420   Width, Height: Integer;
 421   ImageSize:     Integer;
 422   i:             Integer;
 423   Front:         ^Byte;
 424   Back:          ^Byte;
 425   Temp:          Byte;
 426   BPP:           Byte;
 427   Base:          PByte;
 428   TFmt:          Word;
 429
 430 begin
 431   Result := False;
 432
 433   if not FileExists(Filename) then
 434   begin
 435     e_WriteLog( 'Texture ' + Filename + ' not found', MSG_WARNING );
 436     Exit;
 437   end;
 438
 439   AssignFile( TGAFile, Filename );
 440   Reset( TGAFile, 1 );
 441   BlockRead( TGAFile, TGAHeader, SizeOf(TGAHeader) );
 442
 443   if ( TGAHeader.ImageType <> 2 ) then
 444   begin
 445     CloseFile( TGAFile );
 446     e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING );
 447     Exit;
 448   end;
 449
 450   if ( TGAHeader.ColorMapType <> 0 ) then
 451   begin
 452     CloseFile( TGAFile );
 453     e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING );
 454     Exit;
 455   end;
 456
 457   if ( TGAHeader.BPP < 24 ) then
 458   begin
 459     CloseFile( TGAFile );
 460     e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING );
 461     Exit;
 462   end;
 463
 464   Width  := TGAHeader.Width[0]  + TGAHeader.Width[1]  * 256;
 465   Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256;
 466   BPP := TGAHeader.BPP;
 467
 468   if fX > Width then Exit;
 469   if fY > Height then Exit;
 470   if fX+fWidth > Width then Exit;
 471   if fY+fHeight > Height then Exit;
 472
 473   ImageSize := Width * Height * (BPP div 8);
 474   GetMem( Image2, ImageSize );
 475   BlockRead( TGAFile, Image2^, ImageSize );
 476
 477   CloseFile( TGAFile );
 478
 479   for i := 0 to Width * Height - 1 do
 480   begin
 481     Front := PByte(Image2) + i * (BPP div 8);
 482     Back  := PByte(Image2) + i * (BPP div 8) + 2;
 483     Temp   := Front^;
 484     Front^ := Back^;
 485     Back^  := Temp;
 486   end;
 487
 488   fY := Height - (fY + fHeight);
 489
 490   ImageSize := fHeight * fWidth * (BPP div 8);
 491   GetMem( Image, ImageSize );
 492
 493   Base := PByte(Image2) + fY * Width * (BPP div 8) + fX * (BPP div 8);
 494
 495   for i := 0 to fHeight-1 do
 496   begin
 497     CopyMemory( PByte(image) + fWidth * (BPP div 8) * i,
 498                 Base + Width * (BPP div 8) * i, fWidth * (BPP div 8) );
 499   end;
 500
 501   if ( BPP = 24 ) then
 502     TFmt := GL_RGB
 503   else
 504     TFmt := GL_RGBA;
 505
 506   CreateTexture(Texture, fWidth, fHeight, TFmt, Image );
 507
 508   FreeMem( Image );
 509   FreeMem( Image2 );
 510
 511   if Fmt <> nil then Fmt^ := TFmt;
 512
 513   Result := True;
 514 end;
 515
 516 end.