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; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
  29 function LoadTextureEx (Filename: String; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
  30 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
  31 function LoadTextureMemEx (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
  32
  33 implementation
  34
  35 uses
  36   Classes, BinEditor, g_options, utils,
  37   ImagingTypes, Imaging, ImagingUtility;
  38
  39
  40 function AlignP2 (n: Word): Word;
  41 begin
  42   Dec(n);
  43   n := n or (n shr 1);
  44   n := n or (n shr 2);
  45   n := n or (n shr 4);
  46   n := n or (n shr 8);
  47   n := n or (n shr 16);
  48   Inc(n);
  49   Result := n;
  50 end;
  51
  52
  53 {
  54 type
  55   TTGAHeader = packed record
  56     FileType:     Byte;
  57     ColorMapType: Byte;
  58     ImageType:    Byte;
  59     ColorMapSpec: array[0..4] of Byte;
  60     OrigX:        array[0..1] of Byte;
  61     OrigY:        array[0..1] of Byte;
  62     Width:        array[0..1] of Byte;
  63     Height:       array[0..1] of Byte;
  64     BPP:          Byte;
  65     ImageInfo:    Byte;
  66   end;
  67 }
  68
  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   if e_DummyTextures then
  98   begin
  99     tex.id := GLuint(-1);
 100     Result := True;
 101     Exit;
 102   end;
 103
 104   glGenTextures(1, @Texture);
 105   tex.id := Texture;
 106   glBindTexture(GL_TEXTURE_2D, Texture);
 107
 108   // texture blends with object background
 109   glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
 110   // texture does NOT blend with object background
 111   //glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
 112
 113   {
 114     Select a filtering type.
 115     BiLinear filtering produces very good results with little performance impact
 116
 117     GL_NEAREST               - Basic texture (grainy looking texture)
 118     GL_LINEAR                - BiLinear filtering
 119     GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
 120     GL_LINEAR_MIPMAP_LINEAR  - BiLinear Mipmapped texture
 121   }
 122
 123   // for GL_TEXTURE_MAG_FILTER only first two can be used
 124   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, TEXTUREFILTER);
 125   // for GL_TEXTURE_MIN_FILTER all of the above can be used
 126   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, TEXTUREFILTER);
 127
 128   // create empty texture
 129   if aFormat = GL_RGBA then
 130   begin
 131     glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, tex.glwidth, tex.glheight, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
 132     glTexSubImage2D(GL_TEXTURE_2D, 0,  0, 0, Width, Height, GL_RGBA, GL_UNSIGNED_BYTE, pData);
 133   end
 134   else
 135   begin
 136     glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, tex.glwidth, tex.glheight, 0, GL_RGB, GL_UNSIGNED_BYTE, nil);
 137     glTexSubImage2D(GL_TEXTURE_2D, 0,  0, 0, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
 138   end;
 139
 140   // the following is ok too
 141   //bindTexture(0);
 142   //glTextureSubImage2D(tid, 0,  0, 0, img.width, img.height, GL_RGBA, GL_UNSIGNED_BYTE, img.imageData.bytes.ptr);
 143
 144   {
 145   if (tex.glwidth = tex.glwidth) and (tex.glheight = tex.height) then
 146     // easy case
 147     if aFormat = GL_RGBA then
 148     begin
 149       glTexImage2D(GL_TEXTURE_2D, 0, 4, Width, Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, pData);
 150     end
 151     else
 152     begin
 153       glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData);
 154     end;
 155   end
 156   }
 157
 158   glBindTexture(GL_TEXTURE_2D, 0);
 159
 160   Result := true;
 161 end;
 162
 163 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 164 var
 165   image, ii: PByte;
 166   width, height: Integer;
 167   imageSize: Integer;
 168   img: TImageData;
 169   x, y: Integer;
 170   clr: TColor32Rec;
 171 begin
 172   result := false;
 173   pWidth := 0;
 174   pHeight := 0;
 175   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 176
 177   InitImage(img);
 178   if not LoadImageFromMemory(pData, dataSize, img) then
 179   begin
 180     e_WriteLog('Error loading texture: unknown image format', MSG_WARNING);
 181     exit;
 182   end;
 183   try
 184     if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
 185     begin
 186       e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
 187       exit;
 188     end;
 189     //ConvertImage(img, ifA8R8G8B8);
 190     width := img.width;
 191     height := img.height;
 192     pWidth := width;
 193     pHeight := height;
 194     imageSize := Width*Height*32;
 195     GetMem(image, imageSize);
 196     try
 197       // it's slow, but i don't care for now
 198       ii := image;
 199       for y := height-1 downto 0 do
 200       begin
 201         for x := 0 to width-1 do
 202         begin
 203           clr := GetPixel32(img, x, y);
 204           ii^ := clr.r; Inc(ii);
 205           ii^ := clr.g; Inc(ii);
 206           ii^ := clr.b; Inc(ii);
 207           ii^ := clr.a; Inc(ii);
 208         end;
 209       end;
 210       CreateTexture(Texture, width, height, GL_RGBA, image);
 211       result := true;
 212     finally
 213       FreeMem(image);
 214     end;
 215   finally
 216     FreeImage(img);
 217   end;
 218 end;
 219
 220
 221 function LoadTextureMemEx (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
 222 var
 223   image, ii: PByte;
 224   width, height: Integer;
 225   imageSize: Integer;
 226   img: TImageData;
 227   x, y: Integer;
 228   clr: TColor32Rec;
 229 begin
 230   result := false;
 231   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 232
 233   InitImage(img);
 234   if not LoadImageFromMemory(pData, dataSize, img) then
 235   begin
 236     e_WriteLog('Error loading texture: unknown image format', MSG_WARNING);
 237     exit;
 238   end;
 239   try
 240     if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
 241     begin
 242       e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
 243       exit;
 244     end;
 245     //ConvertImage(img, ifA8R8G8B8);
 246     if fX > img.width then exit;
 247     if fY > img.height then exit;
 248     if fX+fWidth > img.width then exit;
 249     if fY+fHeight > img.height then exit;
 250     imageSize := img.width*img.height*32;
 251     GetMem(image, imageSize);
 252     try
 253       // it's slow, but i don't care for now
 254       ii := image;
 255       for y := fY+fHeight-1 downto 0 do
 256       begin
 257         for x := fX to fX+fWidth-1 do
 258         begin
 259           clr := GetPixel32(img, x, y);
 260           ii^ := clr.r; Inc(ii);
 261           ii^ := clr.g; Inc(ii);
 262           ii^ := clr.b; Inc(ii);
 263           ii^ := clr.a; Inc(ii);
 264         end;
 265       end;
 266       CreateTexture(Texture, fWidth, fHeight, GL_RGBA, image);
 267       result := true;
 268     finally
 269       FreeMem(image);
 270     end;
 271   finally
 272     FreeImage(img);
 273   end;
 274 end;
 275
 276
 277 function LoadTexture (filename: AnsiString; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 278 var
 279   fs: TStream;
 280   img: Pointer;
 281   imageSize: LongInt;
 282 begin
 283   result := False;
 284   pWidth := 0;
 285   pHeight := 0;
 286   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 287   fs := nil;
 288
 289   try
 290     fs := openDiskFileRO(filename);
 291   except
 292     fs := nil;
 293   end;
 294   if fs = nil then
 295   begin
 296     e_WriteLog('Texture "'+filename+'" not found', MSG_WARNING);
 297     exit;
 298   end;
 299
 300   try
 301     imageSize := fs.size;
 302     GetMem(img, imageSize);
 303     try
 304       fs.readBuffer(img^, imageSize);
 305       result := LoadTextureMem(img, imageSize, Texture, pWidth, pHeight, Fmt);
 306     finally
 307       FreeMem(img);
 308     end;
 309   finally
 310     fs.Free();
 311   end;
 312 end;
 313
 314
 315 function LoadTextureEx (filename: AnsiString; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
 316 var
 317   fs: TStream;
 318   img: Pointer;
 319   imageSize: LongInt;
 320 begin
 321   result := False;
 322   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 323   fs := nil;
 324
 325   try
 326     fs := openDiskFileRO(filename);
 327   except
 328     fs := nil;
 329   end;
 330   if fs = nil then
 331   begin
 332     e_WriteLog('Texture "'+filename+'" not found', MSG_WARNING);
 333     exit;
 334   end;
 335
 336   try
 337     imageSize := fs.size;
 338     GetMem(img, imageSize);
 339     try
 340       fs.readBuffer(img^, imageSize);
 341       result := LoadTextureMemEx(img, imageSize, Texture, fX, fY, fWidth, fHeight, Fmt);
 342     finally
 343       FreeMem(img);
 344     end;
 345   finally
 346     fs.Free();
 347   end;
 348 end;
 349
 350 end.