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