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