src/engine/e_textures.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$MODE DELPHI}
  17 unit e_textures;
  18
  19 { This unit provides interface to load 24-bit and 32-bit uncompressed images
  20   from Truevision Targa (TGA) graphic files, and create OpenGL textures
  21   from it's data. }
  22
  23 interface
  24
  25 uses
  26   GL, GLExt, SysUtils, e_log,
  27   ImagingTypes, Imaging, ImagingUtility;
  28
  29 type
  30   GLTexture = record
  31     id: GLuint;
  32     width, height: Word; // real
  33     glwidth, glheight: Word; // powerof2
  34     u, v: Single; // usually 1.0
  35   end;
  36
  37 var
  38   e_DummyTextures: Boolean = False;
  39   TEXTUREFILTER: Integer = GL_NEAREST;
  40
  41 function CreateTexture (var tex: GLTexture; Width, Height, aFormat: Word; pData: Pointer): Boolean;
  42
  43 // Standard set of images loading functions
  44 function LoadTexture (Filename: String; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
  45 function LoadTextureEx (Filename: String; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
  46 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
  47 function LoadTextureMemEx (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
  48
  49 // `img` must be valid!
  50 function LoadTextureImg (var img: TImageData; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
  51
  52
  53 implementation
  54
  55 uses
  56   Classes, BinEditor, g_options, utils;
  57
  58
  59 function AlignP2 (n: Word): Word;
  60 begin
  61   Dec(n);
  62   n := n or (n shr 1);
  63   n := n or (n shr 2);
  64   n := n or (n shr 4);
  65   n := n or (n shr 8);
  66   n := n or (n shr 16);
  67   Inc(n);
  68   Result := n;
  69 end;
  70
  71
  72 {
  73 type
  74   TTGAHeader = packed record
  75     FileType:     Byte;
  76     ColorMapType: Byte;
  77     ImageType:    Byte;
  78     ColorMapSpec: array[0..4] of Byte;
  79     OrigX:        array[0..1] of Byte;
  80     OrigY:        array[0..1] of Byte;
  81     Width:        array[0..1] of Byte;
  82     Height:       array[0..1] of Byte;
  83     BPP:          Byte;
  84     ImageInfo:    Byte;
  85   end;
  86 }
  87
  88
  89 // This is auxiliary function that creates OpenGL texture from raw image data
  90 function CreateTexture (var tex: GLTexture; Width, Height, aFormat: Word; pData: Pointer): Boolean;
  91 var
  92   Texture: GLuint;
  93 begin
  94   tex.width := Width;
  95   tex.height := Height;
  96   if glLegacyNPOT then
  97   begin
  98     tex.glwidth := AlignP2(Width);
  99     tex.glheight := AlignP2(Height);
 100   end
 101   else
 102   begin
 103     tex.glwidth := Width;
 104     tex.glheight := Height;
 105   end;
 106   tex.u := 1;
 107   tex.v := 1;
 108   if tex.glwidth <> tex.width then tex.u := (tex.width+0.0)/(tex.glwidth+0.0);
 109   if tex.glheight <> tex.height then tex.v := (tex.height+0.0)/(tex.glheight+0.0);
 110
 111   if (tex.glwidth <> tex.width) or (tex.glheight <> tex.height) then
 112   begin
 113     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);
 114   end;
 115
 116   if e_DummyTextures then
 117   begin
 118     tex.id := GLuint(-1);
 119     Result := True;
 120     Exit;
 121   end;
 122
 123   glGenTextures(1, @Texture);
 124   tex.id := Texture;
 125   glBindTexture(GL_TEXTURE_2D, Texture);
 126
 127   // texture blends with object background
 128   glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
 129   // texture does NOT blend with object background
 130   //glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
 131
 132   {
 133     Select a filtering type.
 134     BiLinear filtering produces very good results with little performance impact
 135
 136     GL_NEAREST               - Basic texture (grainy looking texture)
 137     GL_LINEAR                - BiLinear filtering
 138     GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
 139     GL_LINEAR_MIPMAP_LINEAR  - BiLinear Mipmapped texture
 140   }
 141
 142   // for GL_TEXTURE_MAG_FILTER only first two can be used
 143   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, TEXTUREFILTER);
 144   // for GL_TEXTURE_MIN_FILTER all of the above can be used
 145   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, TEXTUREFILTER);
 146
 147   // create empty texture
 148   if aFormat = GL_RGBA then
 149   begin
 150     glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, tex.glwidth, tex.glheight, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
 151     glTexSubImage2D(GL_TEXTURE_2D, 0,  0, 0, Width, Height, GL_RGBA, GL_UNSIGNED_BYTE, pData);
 152   end
 153   else
 154   begin
 155     glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, tex.glwidth, tex.glheight, 0, GL_RGB, GL_UNSIGNED_BYTE, nil);
 156     glTexSubImage2D(GL_TEXTURE_2D, 0,  0, 0, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
 157   end;
 158
 159   // the following is ok too
 160   //bindTexture(0);
 161   //glTextureSubImage2D(tid, 0,  0, 0, img.width, img.height, GL_RGBA, GL_UNSIGNED_BYTE, img.imageData.bytes.ptr);
 162
 163   {
 164   if (tex.glwidth = tex.glwidth) and (tex.glheight = tex.height) then
 165     // easy case
 166     if aFormat = GL_RGBA then
 167     begin
 168       glTexImage2D(GL_TEXTURE_2D, 0, 4, Width, Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, pData);
 169     end
 170     else
 171     begin
 172       glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData);
 173     end;
 174   end
 175   }
 176
 177   glBindTexture(GL_TEXTURE_2D, 0);
 178
 179   Result := true;
 180 end;
 181
 182 // `img` must be valid!
 183 function LoadTextureImg (var img: TImageData; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 184 var
 185   image, ii: PByte;
 186   width, height: Integer;
 187   imageSize: Integer;
 188   x, y: Integer;
 189   clr: TColor32Rec;
 190 begin
 191   result := false;
 192   pWidth := 0;
 193   pHeight := 0;
 194   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 195
 196   if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
 197   begin
 198     e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
 199     exit;
 200   end;
 201   //ConvertImage(img, ifA8R8G8B8);
 202   width := img.width;
 203   height := img.height;
 204   pWidth := width;
 205   pHeight := height;
 206   imageSize := Width*Height*4;
 207   GetMem(image, imageSize);
 208   try
 209     // it's slow, but i don't care for now
 210     ii := image;
 211     for y := height-1 downto 0 do
 212     begin
 213       for x := 0 to width-1 do
 214       begin
 215         clr := GetPixel32(img, x, y);
 216         ii^ := clr.r; Inc(ii);
 217         ii^ := clr.g; Inc(ii);
 218         ii^ := clr.b; Inc(ii);
 219         ii^ := clr.a; Inc(ii);
 220       end;
 221     end;
 222     CreateTexture(Texture, width, height, GL_RGBA, image);
 223     result := true;
 224   finally
 225     FreeMem(image);
 226   end;
 227 end;
 228
 229
 230 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 231 var
 232   image, ii: PByte;
 233   width, height: Integer;
 234   imageSize: Integer;
 235   img: TImageData;
 236   x, y: Integer;
 237   clr: TColor32Rec;
 238 begin
 239   result := false;
 240   pWidth := 0;
 241   pHeight := 0;
 242   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 243
 244   InitImage(img);
 245   if not LoadImageFromMemory(pData, dataSize, img) then
 246   begin
 247     e_WriteLog('Error loading texture: unknown image format', MSG_WARNING);
 248     exit;
 249   end;
 250   try
 251     result := LoadTextureImg(img, Texture, pWidth, pHeight, Fmt);
 252   finally
 253     FreeImage(img);
 254   end;
 255 end;
 256
 257
 258 function LoadTextureMemEx (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
 259 var
 260   image, ii: PByte;
 261   width, height: Integer;
 262   imageSize: Integer;
 263   img: TImageData;
 264   x, y: Integer;
 265   clr: TColor32Rec;
 266 begin
 267   result := false;
 268   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 269
 270   InitImage(img);
 271   if not LoadImageFromMemory(pData, dataSize, img) then
 272   begin
 273     e_WriteLog('Error loading texture: unknown image format', MSG_WARNING);
 274     exit;
 275   end;
 276   try
 277     if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
 278     begin
 279       e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
 280       exit;
 281     end;
 282     //ConvertImage(img, ifA8R8G8B8);
 283     if fX > img.width then exit;
 284     if fY > img.height then exit;
 285     if fX+fWidth > img.width then exit;
 286     if fY+fHeight > img.height then exit;
 287     imageSize := img.width*img.height*4;
 288     GetMem(image, imageSize);
 289     try
 290       // it's slow, but i don't care for now
 291       ii := image;
 292       for y := fY+fHeight-1 downto 0 do
 293       begin
 294         for x := fX to fX+fWidth-1 do
 295         begin
 296           clr := GetPixel32(img, x, y);
 297           ii^ := clr.r; Inc(ii);
 298           ii^ := clr.g; Inc(ii);
 299           ii^ := clr.b; Inc(ii);
 300           ii^ := clr.a; Inc(ii);
 301         end;
 302       end;
 303       CreateTexture(Texture, fWidth, fHeight, GL_RGBA, image);
 304       result := true;
 305     finally
 306       FreeMem(image);
 307     end;
 308   finally
 309     FreeImage(img);
 310   end;
 311 end;
 312
 313
 314 function LoadTexture (filename: AnsiString; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 315 var
 316   fs: TStream;
 317   img: Pointer;
 318   imageSize: LongInt;
 319 begin
 320   result := False;
 321   pWidth := 0;
 322   pHeight := 0;
 323   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 324   fs := nil;
 325
 326   try
 327     fs := openDiskFileRO(filename);
 328   except
 329     fs := nil;
 330   end;
 331   if fs = nil then
 332   begin
 333     e_WriteLog('Texture "'+filename+'" not found', MSG_WARNING);
 334     exit;
 335   end;
 336
 337   try
 338     imageSize := fs.size;
 339     GetMem(img, imageSize);
 340     try
 341       fs.readBuffer(img^, imageSize);
 342       result := LoadTextureMem(img, imageSize, Texture, pWidth, pHeight, Fmt);
 343     finally
 344       FreeMem(img);
 345     end;
 346   finally
 347     fs.Free();
 348   end;
 349 end;
 350
 351
 352 function LoadTextureEx (filename: AnsiString; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
 353 var
 354   fs: TStream;
 355   img: Pointer;
 356   imageSize: LongInt;
 357 begin
 358   result := False;
 359   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 360   fs := nil;
 361
 362   try
 363     fs := openDiskFileRO(filename);
 364   except
 365     fs := nil;
 366   end;
 367   if fs = nil then
 368   begin
 369     e_WriteLog('Texture "'+filename+'" not found', MSG_WARNING);
 370     exit;
 371   end;
 372
 373   try
 374     imageSize := fs.size;
 375     GetMem(img, imageSize);
 376     try
 377       fs.readBuffer(img^, imageSize);
 378       result := LoadTextureMemEx(img, imageSize, Texture, fX, fY, fWidth, fHeight, Fmt);
 379     finally
 380       FreeMem(img);
 381     end;
 382   finally
 383     fs.Free();
 384   end;
 385 end;
 386
 387 end.