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, 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_textures;
  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   GL, GLExt, SysUtils, e_log,
  26   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   e_glLegacyNPOT: 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, BinEditor, 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 begin
  79   tex.width := Width;
  80   tex.height := Height;
  81   tex.glwidth := Width;
  82   tex.glheight := Height;
  83   tex.u := 1;
  84   tex.v := 1;
  85
  86   if e_glLegacyNPOT then
  87   begin
  88     tex.glwidth := AlignP2(Width);
  89     tex.glheight := AlignP2(Height);
  90     if tex.glwidth <> tex.width then tex.u := (tex.width+0.0)/(tex.glwidth+0.0);
  91     if tex.glheight <> tex.height then tex.v := (tex.height+0.0)/(tex.glheight+0.0);
  92   end;
  93
  94   //if (tex.glwidth <> tex.width) or (tex.glheight <> tex.height) then
  95   //  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);
  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   if (tex.glwidth <> tex.width) or (tex.glheight <> tex.height) then
 109     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]), MSG_NOTIFY);
 110
 111   // texture blends with object background
 112   glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
 113   // texture does NOT blend with object background
 114   //glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
 115
 116   {
 117     Select a filtering type.
 118     BiLinear filtering produces very good results with little performance impact
 119
 120     GL_NEAREST               - Basic texture (grainy looking texture)
 121     GL_LINEAR                - BiLinear filtering
 122     GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
 123     GL_LINEAR_MIPMAP_LINEAR  - BiLinear Mipmapped texture
 124   }
 125
 126   // for GL_TEXTURE_MAG_FILTER only first two can be used
 127   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, TEXTUREFILTER);
 128   // for GL_TEXTURE_MIN_FILTER all of the above can be used
 129   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, TEXTUREFILTER);
 130
 131   // create empty texture
 132   if aFormat = GL_RGBA then fmt := GL_RGBA else fmt := GL_RGB; // silly, yeah?
 133   glTexImage2D(GL_TEXTURE_2D, 0, fmt, tex.glwidth, tex.glheight, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
 134
 135   (*
 136   GetMem(buf, tex.glwidth*4*tex.glheight);
 137   try
 138     FillChar(buf^, tex.glwidth*4*tex.glheight, 255);
 139     glTexSubImage2D(GL_TEXTURE_2D, 0,  0, 0, tex.glwidth, tex.glheight, fmt, GL_UNSIGNED_BYTE, buf);
 140     if (tex.glheight = 128) and (tex.height = 80) then
 141     begin
 142       for f := 0 to tex.glheight-1 do
 143       begin
 144         for c := 0 to tex.glwidth-1 do
 145         begin
 146           buf[f*(tex.glwidth*4)+c*4+0] := 255;
 147           buf[f*(tex.glwidth*4)+c*4+1] := 127;
 148           buf[f*(tex.glwidth*4)+c*4+2] := 0;
 149         end;
 150       end;
 151       glTexSubImage2D(GL_TEXTURE_2D, 0,  0, 82, tex.glwidth, {tex.glheight}1, fmt, GL_UNSIGNED_BYTE, buf);
 152     end;
 153   finally
 154     FreeMem(buf);
 155   end;
 156   *)
 157
 158   glTexSubImage2D(GL_TEXTURE_2D, 0,  0, 0, Width, Height, fmt, GL_UNSIGNED_BYTE, pData);
 159   //glTexSubImage2D(GL_TEXTURE_2D, 0,  0, tex.glheight-tex.height, Width, Height, fmt, GL_UNSIGNED_BYTE, pData);
 160
 161   glBindTexture(GL_TEXTURE_2D, 0);
 162
 163   Result := true;
 164 end;
 165
 166 // `img` must be valid!
 167 function LoadTextureImg (var img: TImageData; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 168 var
 169   image, ii: PByte;
 170   width, height: Integer;
 171   imageSize: Integer;
 172   x, y: Integer;
 173   clr: TColor32Rec;
 174 begin
 175   result := false;
 176   pWidth := 0;
 177   pHeight := 0;
 178   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 179
 180   if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
 181   begin
 182     e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
 183     exit;
 184   end;
 185   //ConvertImage(img, ifA8R8G8B8);
 186   width := img.width;
 187   height := img.height;
 188   pWidth := width;
 189   pHeight := height;
 190   imageSize := Width*Height*4;
 191   GetMem(image, imageSize);
 192   try
 193     // it's slow, but i don't care for now
 194     ii := image;
 195     for y := height-1 downto 0 do
 196     begin
 197       for x := 0 to width-1 do
 198       begin
 199         clr := GetPixel32(img, x, y);
 200         ii^ := clr.r; Inc(ii);
 201         ii^ := clr.g; Inc(ii);
 202         ii^ := clr.b; Inc(ii);
 203         ii^ := clr.a; Inc(ii);
 204       end;
 205     end;
 206     CreateTexture(Texture, width, height, GL_RGBA, image);
 207     result := true;
 208   finally
 209     FreeMem(image);
 210   end;
 211 end;
 212
 213
 214 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 215 var
 216   img: TImageData;
 217 begin
 218   result := false;
 219   pWidth := 0;
 220   pHeight := 0;
 221   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 222
 223   InitImage(img);
 224   if not LoadImageFromMemory(pData, dataSize, img) then
 225   begin
 226     e_WriteLog('Error loading texture: unknown image format', MSG_WARNING);
 227     exit;
 228   end;
 229   try
 230     result := LoadTextureImg(img, Texture, pWidth, pHeight, Fmt);
 231   finally
 232     FreeImage(img);
 233   end;
 234 end;
 235
 236
 237 function LoadTextureMemEx (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
 238 var
 239   image, ii: PByte;
 240   imageSize: Integer;
 241   img: TImageData;
 242   x, y: Integer;
 243   clr: TColor32Rec;
 244 begin
 245   result := false;
 246   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 247
 248   InitImage(img);
 249   if not LoadImageFromMemory(pData, dataSize, img) then
 250   begin
 251     e_WriteLog('Error loading texture: unknown image format', MSG_WARNING);
 252     exit;
 253   end;
 254   try
 255     if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
 256     begin
 257       e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
 258       exit;
 259     end;
 260     //ConvertImage(img, ifA8R8G8B8);
 261     if fX > img.width then exit;
 262     if fY > img.height then exit;
 263     if fX+fWidth > img.width then exit;
 264     if fY+fHeight > img.height then exit;
 265     //writeln('fX=', fX, '; fY=', fY, '; fWidth=', fWidth, '; fHeight=', fHeight);
 266     imageSize := img.width*img.height*4;
 267     GetMem(image, imageSize);
 268     try
 269       // it's slow, but i don't care for now
 270       ii := image;
 271       for y := fY+fHeight-1 downto fY do
 272       begin
 273         for x := fX to fX+fWidth-1 do
 274         begin
 275           clr := GetPixel32(img, x, y);
 276           ii^ := clr.r; Inc(ii);
 277           ii^ := clr.g; Inc(ii);
 278           ii^ := clr.b; Inc(ii);
 279           ii^ := clr.a; Inc(ii);
 280         end;
 281       end;
 282       CreateTexture(Texture, fWidth, fHeight, GL_RGBA, image);
 283       result := true;
 284     finally
 285       FreeMem(image);
 286     end;
 287   finally
 288     FreeImage(img);
 289   end;
 290 end;
 291
 292
 293 function LoadTexture (filename: AnsiString; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 294 var
 295   fs: TStream;
 296   img: Pointer;
 297   imageSize: LongInt;
 298 begin
 299   result := False;
 300   pWidth := 0;
 301   pHeight := 0;
 302   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 303   fs := nil;
 304
 305   try
 306     fs := openDiskFileRO(filename);
 307   except
 308     fs := nil;
 309   end;
 310   if fs = nil then
 311   begin
 312     e_WriteLog('Texture "'+filename+'" not found', MSG_WARNING);
 313     exit;
 314   end;
 315
 316   try
 317     imageSize := fs.size;
 318     GetMem(img, imageSize);
 319     try
 320       fs.readBuffer(img^, imageSize);
 321       result := LoadTextureMem(img, imageSize, Texture, pWidth, pHeight, Fmt);
 322     finally
 323       FreeMem(img);
 324     end;
 325   finally
 326     fs.Free();
 327   end;
 328 end;
 329
 330
 331 function LoadTextureEx (filename: AnsiString; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
 332 var
 333   fs: TStream;
 334   img: Pointer;
 335   imageSize: LongInt;
 336 begin
 337   result := False;
 338   if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
 339   fs := nil;
 340
 341   try
 342     fs := openDiskFileRO(filename);
 343   except
 344     fs := nil;
 345   end;
 346   if fs = nil then
 347   begin
 348     e_WriteLog('Texture "'+filename+'" not found', MSG_WARNING);
 349     exit;
 350   end;
 351
 352   try
 353     imageSize := fs.size;
 354     GetMem(img, imageSize);
 355     try
 356       fs.readBuffer(img^, imageSize);
 357       result := LoadTextureMemEx(img, imageSize, Texture, fX, fY, fWidth, fHeight, Fmt);
 358     finally
 359       FreeMem(img);
 360     end;
 361   finally
 362     fs.Free();
 363   end;
 364 end;
 365
 366 end.