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   ImagingTypes, Imaging, ImagingUtility;
  13
  14 type
  15   GLTexture = record
  16     id: GLuint;
  17     width, height: Word; // real
  18     glwidth, glheight: Word; // powerof2
  19     u, v: Single; // usually 1.0
  20   end;
  21
  22 var
  23   e_DummyTextures: Boolean = False;
  24   TEXTUREFILTER: Integer = GL_NEAREST;
  25
  26 function CreateTexture (var tex: GLTexture; Width, Height, aFormat: Word; pData: Pointer): Boolean;
  27
  28 // Standard set of images loading functions
  29 function LoadTexture (Filename: String; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
  30 function LoadTextureEx (Filename: String; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
  31 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
  32 function LoadTextureMemEx (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
  33
  34 // `img` must be valid!
  35 function LoadTextureImg (var img: TImageData; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
  36
  37
  38 implementation
  39
  40 uses
  41   Classes, BinEditor, g_options, utils;
  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 {
  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
  73
  74 // This is auxiliary function that creates OpenGL texture from raw image data
  75 function CreateTexture (var tex: GLTexture; Width, Height, aFormat: Word; pData: Pointer): Boolean;
  76 var
  77   Texture: GLuint;
  78 begin
  79   tex.width := Width;
  80   tex.height := Height;
  81   if glLegacyNPOT then
  82   begin
  83     tex.glwidth := AlignP2(Width);
  84     tex.glheight := AlignP2(Height);
  85   end
  86   else
  87   begin
  88     tex.glwidth := Width;
  89     tex.glheight := Height;
  90   end;
  91   tex.u := 1;
  92   tex.v := 1;
  93   if tex.glwidth <> tex.width then tex.u := (tex.width+0.0)/(tex.glwidth+0.0);
  94   if tex.glheight <> tex.height then tex.v := (tex.height+0.0)/(tex.glheight+0.0);
  95
  96   if (tex.glwidth <> tex.width) or (tex.glheight <> tex.height) then
  97   begin
  98     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);
  99   end;
 100
 101   if e_DummyTextures then
 102   begin
 103     tex.id := GLuint(-1);
 104     Result := True;
 105     Exit;
 106   end;
 107
 108   glGenTextures(1, @Texture);
 109   tex.id := Texture;
 110   glBindTexture(GL_TEXTURE_2D, Texture);
 111
 112   // texture blends with object background
 113   glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
 114   // texture does NOT blend with object background
 115   //glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
 116
 117   {
 118     Select a filtering type.
 119     BiLinear filtering produces very good results with little performance impact
 120
 121     GL_NEAREST               - Basic texture (grainy looking texture)
 122     GL_LINEAR                - BiLinear filtering
 123     GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
 124     GL_LINEAR_MIPMAP_LINEAR  - BiLinear Mipmapped texture
 125   }
 126
 127   // for GL_TEXTURE_MAG_FILTER only first two can be used
 128   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, TEXTUREFILTER);
 129   // for GL_TEXTURE_MIN_FILTER all of the above can be used
 130   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, TEXTUREFILTER);
 131
 132   // create empty texture
 133   if aFormat = GL_RGBA then
 134   begin
 135     glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, tex.glwidth, tex.glheight, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
 136     glTexSubImage2D(GL_TEXTURE_2D, 0,  0, 0, Width, Height, GL_RGBA, GL_UNSIGNED_BYTE, pData);
 137   end
 138   else
 139   begin
 140     glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, tex.glwidth, tex.glheight, 0, GL_RGB, GL_UNSIGNED_BYTE, nil);
 141     glTexSubImage2D(GL_TEXTURE_2D, 0,  0, 0, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
 142   end;
 143
 144   // the following is ok too
 145   //bindTexture(0);
 146   //glTextureSubImage2D(tid, 0,  0, 0, img.width, img.height, GL_RGBA, GL_UNSIGNED_BYTE, img.imageData.bytes.ptr);
 147
 148   {
 149   if (tex.glwidth = tex.glwidth) and (tex.glheight = tex.height) then
 150     // easy case
 151     if aFormat = GL_RGBA then
 152     begin
 153       glTexImage2D(GL_TEXTURE_2D, 0, 4, Width, Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, pData);
 154     end
 155     else
 156     begin
 157       glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData);
 158     end;
 159   end
 160   }
 161
 162   glBindTexture(GL_TEXTURE_2D, 0);
 163
 164   Result := true;
 165 end;
 166
 167 // `img` must be valid!
 168 function LoadTextureImg (var img: TImageData; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 169 var
 170   image, ii: PByte;
 171   width, height: Integer;
 172   imageSize: Integer;
 173   x, y: Integer;
 174   clr: TColor32Rec;
 175 begin
 176   result := false;
 177   pWidth := 0;
 178   pHeight := 0;
 179   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 180
 181   if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
 182   begin
 183     e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
 184     exit;
 185   end;
 186   //ConvertImage(img, ifA8R8G8B8);
 187   width := img.width;
 188   height := img.height;
 189   pWidth := width;
 190   pHeight := height;
 191   imageSize := Width*Height*4;
 192   GetMem(image, imageSize);
 193   try
 194     // it's slow, but i don't care for now
 195     ii := image;
 196     for y := height-1 downto 0 do
 197     begin
 198       for x := 0 to width-1 do
 199       begin
 200         clr := GetPixel32(img, x, y);
 201         ii^ := clr.r; Inc(ii);
 202         ii^ := clr.g; Inc(ii);
 203         ii^ := clr.b; Inc(ii);
 204         ii^ := clr.a; Inc(ii);
 205       end;
 206     end;
 207     CreateTexture(Texture, width, height, GL_RGBA, image);
 208     result := true;
 209   finally
 210     FreeMem(image);
 211   end;
 212 end;
 213
 214
 215 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 216 var
 217   image, ii: PByte;
 218   width, height: Integer;
 219   imageSize: Integer;
 220   img: TImageData;
 221   x, y: Integer;
 222   clr: TColor32Rec;
 223 begin
 224   result := false;
 225   pWidth := 0;
 226   pHeight := 0;
 227   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 228
 229   InitImage(img);
 230   if not LoadImageFromMemory(pData, dataSize, img) then
 231   begin
 232     e_WriteLog('Error loading texture: unknown image format', MSG_WARNING);
 233     exit;
 234   end;
 235   try
 236     result := LoadTextureImg(img, Texture, pWidth, pHeight, Fmt);
 237   finally
 238     FreeImage(img);
 239   end;
 240 end;
 241
 242
 243 function LoadTextureMemEx (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
 244 var
 245   image, ii: PByte;
 246   width, height: Integer;
 247   imageSize: Integer;
 248   img: TImageData;
 249   x, y: Integer;
 250   clr: TColor32Rec;
 251 begin
 252   result := false;
 253   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 254
 255   InitImage(img);
 256   if not LoadImageFromMemory(pData, dataSize, img) then
 257   begin
 258     e_WriteLog('Error loading texture: unknown image format', MSG_WARNING);
 259     exit;
 260   end;
 261   try
 262     if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
 263     begin
 264       e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
 265       exit;
 266     end;
 267     //ConvertImage(img, ifA8R8G8B8);
 268     if fX > img.width then exit;
 269     if fY > img.height then exit;
 270     if fX+fWidth > img.width then exit;
 271     if fY+fHeight > img.height then exit;
 272     imageSize := img.width*img.height*4;
 273     GetMem(image, imageSize);
 274     try
 275       // it's slow, but i don't care for now
 276       ii := image;
 277       for y := fY+fHeight-1 downto 0 do
 278       begin
 279         for x := fX to fX+fWidth-1 do
 280         begin
 281           clr := GetPixel32(img, x, y);
 282           ii^ := clr.r; Inc(ii);
 283           ii^ := clr.g; Inc(ii);
 284           ii^ := clr.b; Inc(ii);
 285           ii^ := clr.a; Inc(ii);
 286         end;
 287       end;
 288       CreateTexture(Texture, fWidth, fHeight, GL_RGBA, image);
 289       result := true;
 290     finally
 291       FreeMem(image);
 292     end;
 293   finally
 294     FreeImage(img);
 295   end;
 296 end;
 297
 298
 299 function LoadTexture (filename: AnsiString; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 300 var
 301   fs: TStream;
 302   img: Pointer;
 303   imageSize: LongInt;
 304 begin
 305   result := False;
 306   pWidth := 0;
 307   pHeight := 0;
 308   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 309   fs := nil;
 310
 311   try
 312     fs := openDiskFileRO(filename);
 313   except
 314     fs := nil;
 315   end;
 316   if fs = nil then
 317   begin
 318     e_WriteLog('Texture "'+filename+'" not found', MSG_WARNING);
 319     exit;
 320   end;
 321
 322   try
 323     imageSize := fs.size;
 324     GetMem(img, imageSize);
 325     try
 326       fs.readBuffer(img^, imageSize);
 327       result := LoadTextureMem(img, imageSize, Texture, pWidth, pHeight, Fmt);
 328     finally
 329       FreeMem(img);
 330     end;
 331   finally
 332     fs.Free();
 333   end;
 334 end;
 335
 336
 337 function LoadTextureEx (filename: AnsiString; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
 338 var
 339   fs: TStream;
 340   img: Pointer;
 341   imageSize: LongInt;
 342 begin
 343   result := False;
 344   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 345   fs := nil;
 346
 347   try
 348     fs := openDiskFileRO(filename);
 349   except
 350     fs := nil;
 351   end;
 352   if fs = nil then
 353   begin
 354     e_WriteLog('Texture "'+filename+'" not found', MSG_WARNING);
 355     exit;
 356   end;
 357
 358   try
 359     imageSize := fs.size;
 360     GetMem(img, imageSize);
 361     try
 362       fs.readBuffer(img^, imageSize);
 363       result := LoadTextureMemEx(img, imageSize, Texture, fX, fY, fWidth, fHeight, Fmt);
 364     finally
 365       FreeMem(img);
 366     end;
 367   finally
 368     fs.Free();
 369   end;
 370 end;
 371
 372 end.