src/engine/e_texture.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, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$INCLUDE ../shared/a_modes.inc}
  16 unit e_texture;
  17
  18 { This unit provides interface to load 24-bit and 32-bit uncompressed images
  19   from Truevision Targa (TGA) graphic files, and create OpenGL textures
  20   from it's data. }
  21
  22 interface
  23
  24 uses
  25   {$INCLUDE ../nogl/noGLuses.inc}
  26   SysUtils, e_log, ImagingTypes, Imaging, ImagingUtility;
  27
  28 type
  29   GLTexture = record
  30     id: GLuint;
  31     width, height: Word; // real
  32     glwidth, glheight: Word; // powerof2
  33     u, v: Single; // usually 1.0
  34     fmt: GLuint;
  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, 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 // This is auxiliary function that creates OpenGL texture from raw image data
  73 function CreateTexture (var tex: GLTexture; Width, Height, aFormat: Word; pData: Pointer): Boolean;
  74 var
  75   Texture: GLuint;
  76   fmt: GLenum;
  77   //buf: PByte;
  78   //f, c: Integer;
  79 begin
  80   tex.width := Width;
  81   tex.height := Height;
  82   tex.glwidth := Width;
  83   tex.glheight := Height;
  84   tex.u := 1;
  85   tex.v := 1;
  86
  87   if glLegacyNPOT then
  88   begin
  89     tex.glwidth := AlignP2(Width);
  90     tex.glheight := AlignP2(Height);
  91     if tex.glwidth <> tex.width then tex.u := (tex.width+0.0)/(tex.glwidth+0.0);
  92     if tex.glheight <> tex.height then tex.v := (tex.height+0.0)/(tex.glheight+0.0);
  93   end;
  94
  95   //if (tex.glwidth <> tex.width) or (tex.glheight <> tex.height) then
  96   //  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);
  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   if (tex.glwidth <> tex.width) or (tex.glheight <> tex.height) then
 110     e_WriteLog(Format('NPOT: %u is %ux%u; gl is %ux%u; u=%f; v=%f', [tex.id, Width, Height, tex.glwidth, tex.glheight, tex.u, tex.v]), TMsgType.Notify);
 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 fmt := GL_RGBA else fmt := GL_RGB; // silly, yeah?
 134   glTexImage2D(GL_TEXTURE_2D, 0, fmt, tex.glwidth, tex.glheight, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
 135
 136   (*
 137   GetMem(buf, tex.glwidth*4*tex.glheight);
 138   try
 139     FillChar(buf^, tex.glwidth*4*tex.glheight, 255);
 140     glTexSubImage2D(GL_TEXTURE_2D, 0,  0, 0, tex.glwidth, tex.glheight, fmt, GL_UNSIGNED_BYTE, buf);
 141     if (tex.glheight = 128) and (tex.height = 80) then
 142     begin
 143       for f := 0 to tex.glheight-1 do
 144       begin
 145         for c := 0 to tex.glwidth-1 do
 146         begin
 147           buf[f*(tex.glwidth*4)+c*4+0] := 255;
 148           buf[f*(tex.glwidth*4)+c*4+1] := 127;
 149           buf[f*(tex.glwidth*4)+c*4+2] := 0;
 150         end;
 151       end;
 152       glTexSubImage2D(GL_TEXTURE_2D, 0,  0, 82, tex.glwidth, {tex.glheight}1, fmt, GL_UNSIGNED_BYTE, buf);
 153     end;
 154   finally
 155     FreeMem(buf);
 156   end;
 157   *)
 158
 159   glTexSubImage2D(GL_TEXTURE_2D, 0,  0, 0, Width, Height, fmt, GL_UNSIGNED_BYTE, pData);
 160   //glTexSubImage2D(GL_TEXTURE_2D, 0,  0, tex.glheight-tex.height, Width, Height, fmt, GL_UNSIGNED_BYTE, pData);
 161
 162   glBindTexture(GL_TEXTURE_2D, 0);
 163
 164   // so driver will really upload the texture (this is *sometimes* required for buggy videodrivers)
 165   glFlush();
 166   glFinish();
 167
 168   Result := true;
 169 end;
 170
 171 // `img` must be valid!
 172 function LoadTextureImg (var img: TImageData; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 173 var
 174   image, ii: PByte;
 175   width, height: Integer;
 176   imageSize: Integer;
 177   x, y: Integer;
 178   clr: TColor32Rec;
 179 begin
 180   result := false;
 181   pWidth := 0;
 182   pHeight := 0;
 183   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 184
 185   if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
 186   begin
 187     e_WriteLog('Error loading texture: invalid image dimensions', TMsgType.Warning);
 188     exit;
 189   end;
 190   //ConvertImage(img, ifA8R8G8B8);
 191   width := img.width;
 192   height := img.height;
 193   pWidth := width;
 194   pHeight := height;
 195   imageSize := Width*Height*4;
 196   GetMem(image, imageSize);
 197   try
 198     // it is slow, but i don't care for now
 199     ii := image;
 200     for y := height-1 downto 0 do
 201     begin
 202       for x := 0 to width-1 do
 203       begin
 204         clr := GetPixel32(img, x, y);
 205         ii^ := clr.r; Inc(ii);
 206         ii^ := clr.g; Inc(ii);
 207         ii^ := clr.b; Inc(ii);
 208         ii^ := clr.a; Inc(ii);
 209       end;
 210     end;
 211     CreateTexture(Texture, width, height, GL_RGBA, image);
 212     result := true;
 213   finally
 214     FreeMem(image);
 215   end;
 216 end;
 217
 218
 219 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 220 var
 221   //image, ii: PByte;
 222   //width, height: Integer;
 223   //imageSize: Integer;
 224   img: TImageData;
 225   //x, y: Integer;
 226   //clr: TColor32Rec;
 227 begin
 228   result := false;
 229   pWidth := 0;
 230   pHeight := 0;
 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', TMsgType.Warning);
 237     exit;
 238   end;
 239   try
 240     result := LoadTextureImg(img, Texture, pWidth, pHeight, Fmt);
 241   finally
 242     FreeImage(img);
 243   end;
 244 end;
 245
 246
 247 function LoadTextureMemEx (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
 248 var
 249   image, ii: PByte;
 250   //width, height: Integer;
 251   imageSize: Integer;
 252   img: TImageData;
 253   x, y: Integer;
 254   clr: TColor32Rec;
 255 begin
 256   result := false;
 257   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 258
 259   InitImage(img);
 260   if not LoadImageFromMemory(pData, dataSize, img) then
 261   begin
 262     e_WriteLog('Error loading texture: unknown image format', TMsgType.Warning);
 263     exit;
 264   end;
 265   try
 266     if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
 267     begin
 268       e_WriteLog('Error loading texture: invalid image dimensions', TMsgType.Warning);
 269       exit;
 270     end;
 271     //ConvertImage(img, ifA8R8G8B8);
 272     if fX > img.width then exit;
 273     if fY > img.height then exit;
 274     if fX+fWidth > img.width then exit;
 275     if fY+fHeight > img.height then exit;
 276     //writeln('fX=', fX, '; fY=', fY, '; fWidth=', fWidth, '; fHeight=', fHeight);
 277     imageSize := img.width*img.height*4;
 278     GetMem(image, imageSize);
 279     try
 280       // it is slow, but i don't care for now
 281       ii := image;
 282       for y := fY+fHeight-1 downto fY do
 283       begin
 284         for x := fX to fX+fWidth-1 do
 285         begin
 286           clr := GetPixel32(img, x, y);
 287           ii^ := clr.r; Inc(ii);
 288           ii^ := clr.g; Inc(ii);
 289           ii^ := clr.b; Inc(ii);
 290           ii^ := clr.a; Inc(ii);
 291         end;
 292       end;
 293       CreateTexture(Texture, fWidth, fHeight, GL_RGBA, image);
 294       result := true;
 295     finally
 296       FreeMem(image);
 297     end;
 298   finally
 299     FreeImage(img);
 300   end;
 301 end;
 302
 303
 304 function LoadTexture (filename: AnsiString; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 305 var
 306   fs: TStream;
 307   img: Pointer;
 308   imageSize: LongInt;
 309 begin
 310   result := False;
 311   pWidth := 0;
 312   pHeight := 0;
 313   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 314   fs := nil;
 315
 316   try
 317     fs := openDiskFileRO(filename);
 318   except
 319     fs := nil;
 320   end;
 321   if fs = nil then
 322   begin
 323     e_WriteLog('Texture "'+filename+'" not found', TMsgType.Warning);
 324     exit;
 325   end;
 326
 327   try
 328     imageSize := fs.size;
 329     GetMem(img, imageSize);
 330     try
 331       fs.readBuffer(img^, imageSize);
 332       result := LoadTextureMem(img, imageSize, Texture, pWidth, pHeight, Fmt);
 333     finally
 334       FreeMem(img);
 335     end;
 336   finally
 337     fs.Free();
 338   end;
 339 end;
 340
 341
 342 function LoadTextureEx (filename: AnsiString; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
 343 var
 344   fs: TStream;
 345   img: Pointer;
 346   imageSize: LongInt;
 347 begin
 348   result := False;
 349   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 350   fs := nil;
 351
 352   try
 353     fs := openDiskFileRO(filename);
 354   except
 355     fs := nil;
 356   end;
 357   if fs = nil then
 358   begin
 359     e_WriteLog('Texture "'+filename+'" not found', TMsgType.Warning);
 360     exit;
 361   end;
 362
 363   try
 364     imageSize := fs.size;
 365     GetMem(img, imageSize);
 366     try
 367       fs.readBuffer(img^, imageSize);
 368       result := LoadTextureMemEx(img, imageSize, Texture, fX, fY, fWidth, fHeight, Fmt);
 369     finally
 370       FreeMem(img);
 371     end;
 372   finally
 373     fs.Free();
 374   end;
 375 end;
 376
 377 end.