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