src/game/renders/opengl/r_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 r_textures;
  17
  18 interface
  19
  20   uses
  21     {$IFDEF USE_GLES1}
  22       GLES11,
  23     {$ELSE}
  24       GL, GLEXT,
  25     {$ENDIF}
  26     r_atlas,
  27     utils    // SSArray
  28   ;
  29
  30   type
  31     TGLAtlas = class;
  32
  33     TGLAtlasNode = class (TAtlasNode)
  34       private
  35         mBase: TGLAtlas;
  36
  37       public
  38         constructor Create (base: TGLAtlas);
  39         destructor Destroy; override;
  40
  41         function GetID (): GLuint;
  42
  43         property base: TGLAtlas read mBase;
  44         property id: GLuint read GetID;
  45     end;
  46
  47     TGLAtlas = class (TAtlas)
  48       private
  49         mID: GLuint;
  50
  51       public
  52         constructor Create (ww, hh: Integer; id: GLuint);
  53         destructor Destroy; override;
  54
  55         function CreateNode (): TGLAtlasNode; override;
  56         function Alloc (ww, hh: Integer): TGLAtlasNode; overload;
  57
  58         property id: GLuint read mID write mID default 0;
  59     end;
  60
  61     TGLTexture = class
  62       private
  63         mWidth: Integer;
  64         mHeight: Integer;
  65         mCols: Integer;
  66         mTile: array of TGLAtlasNode;
  67
  68       public
  69         destructor Destroy; override;
  70
  71         function GetTile (col, line: Integer): TGLAtlasNode;
  72
  73         function GetLines (): Integer; inline;
  74
  75         property width: Integer read mWidth;
  76         property height: Integer read mHeight;
  77         property cols: Integer read mCols;
  78         property lines: Integer read GetLines;
  79     end;
  80
  81     TGLMultiTexture = class
  82       private
  83         mTexture: array of TGLTexture;
  84         mBackanim: Boolean;
  85
  86       public
  87         destructor Destroy; override;
  88
  89         function GetWidth (): Integer; inline;
  90         function GetHeight (): Integer; inline;
  91         function GetCount (): Integer; inline;
  92         function GetTexture (i: Integer): TGLTexture; {inline;}
  93
  94         property width: Integer read GetWidth;
  95         property height: Integer read GetHeight;
  96         property count: Integer read GetCount;
  97         property backAnim: Boolean read mBackanim; (* this property must be located at TAnimState? *)
  98     end;
  99
 100   procedure r_Textures_Initialize;
 101   procedure r_Textures_Finalize;
 102
 103   function r_Textures_LoadFromFile (const filename: AnsiString; log: Boolean = True): TGLTexture;
 104   function r_Textures_LoadMultiFromFile (const filename: AnsiString; log: Boolean = True): TGLMultiTexture;
 105   function r_Textures_LoadMultiFromFileAndInfo (const filename: AnsiString; w, h, count: Integer; backanim: Boolean; log: Boolean = True): TGLMultiTexture;
 106
 107 implementation
 108
 109   uses
 110     SysUtils, Classes,
 111     e_log, e_res, WADReader, Config,
 112     Imaging, ImagingTypes, ImagingUtility
 113   ;
 114
 115   var
 116     maxTileSize: Integer;
 117     atl: array of TGLAtlas;
 118 //    tex: array of TGLTexture;
 119
 120   (* --------- TGLAtlasNode --------- *)
 121
 122   constructor TGLAtlasNode.Create (base: TGLAtlas);
 123   begin
 124     ASSERT(base <> nil);
 125     inherited Create();
 126     self.mBase := base;
 127   end;
 128
 129   destructor TGLAtlasNode.Destroy;
 130   begin
 131     inherited;
 132   end;
 133
 134   function TGLAtlasNode.GetID (): GLuint;
 135   begin
 136     result := self.base.id
 137   end;
 138
 139   procedure r_Textures_UpdateNode (n: TGLAtlasNode; data: Pointer; x, y, w, h: Integer);
 140   begin
 141     ASSERT(n <> nil);
 142     // ASSERT(n.leaf);
 143     ASSERT(n.base <> nil);
 144     ASSERT(data <> nil);
 145     ASSERT(x >= 0);
 146     ASSERT(y >= 0);
 147     ASSERT(n.l + x + w - 1 <= n.r);
 148     ASSERT(n.t + y + h - 1 <= n.b);
 149     ASSERT(n.id > 0);
 150     glBindTexture(GL_TEXTURE_2D, n.id);
 151     glTexSubImage2D(GL_TEXTURE_2D, 0, n.l + x, n.t + y, w, h, GL_RGBA, GL_UNSIGNED_BYTE, data);
 152     glBindTexture(GL_TEXTURE_2D, 0);
 153   end;
 154
 155   (* --------- TGLAtlas --------- *)
 156
 157   constructor TGLAtlas.Create (ww, hh: Integer; id: GLuint);
 158   begin
 159     ASSERT(ww > 0);
 160     ASSERT(hh > 0);
 161     inherited Create(ww, hh);
 162     self.mID := id;
 163   end;
 164
 165   destructor TGLAtlas.Destroy;
 166   begin
 167     inherited;
 168   end;
 169
 170   function TGLAtlas.CreateNode (): TGLAtlasNode;
 171   begin
 172     result := TGLAtlasNode.Create(self);
 173   end;
 174
 175   function TGLAtlas.Alloc (ww, hh: Integer): TGLAtlasNode;
 176   begin
 177     result := TGLAtlasNode(inherited Alloc(ww, hh));
 178   end;
 179
 180   function r_Textures_AllocHWTexture (w, h: Integer): GLuint;
 181     var id: GLuint;
 182   begin
 183     glGenTextures(1, @id);
 184     if id <> 0 then
 185     begin
 186       glBindTexture(GL_TEXTURE_2D, id);
 187       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
 188       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
 189       glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
 190       glBindTexture(GL_TEXTURE_2D, 0);
 191     end;
 192     result := id
 193   end;
 194
 195   function r_Textures_AllocAtlas (): TGLAtlas;
 196     var i: Integer; id: GLuint;
 197   begin
 198     result := nil;
 199     id := r_Textures_AllocHWTexture(maxTileSize, maxTileSize);
 200     if id <> 0 then
 201     begin
 202       i := Length(atl);
 203       SetLength(atl, i + 1);
 204       atl[i] := TGLAtlas.Create(maxTileSize, maxTileSize, id);
 205       result := atl[i];
 206     end;
 207   end;
 208
 209   function r_Textures_AllocNode (w, h: Integer): TGLAtlasNode;
 210     var i: Integer; n: TGLAtlasNode; a: TGLAtlas;
 211   begin
 212     n := nil;
 213     if atl <> nil then
 214     begin
 215       i := High(atl);
 216       while (i >= 0) and (n = nil) do
 217       begin
 218         n := atl[i].Alloc(w, h);
 219         Dec(i);
 220       end;
 221     end;
 222     if n = nil then
 223     begin
 224       a := r_Textures_AllocAtlas();
 225       if a <> nil then
 226         n := a.Alloc(w, h);
 227     end;
 228     result := n
 229   end;
 230
 231   (* --------- TGLTexture --------- *)
 232
 233   destructor TGLTexture.Destroy;
 234     var i: Integer;
 235   begin
 236     if self.mTile <> nil then
 237     begin
 238       for i := 0 to High(self.mTile) do
 239       begin
 240         if self.mTile[i] <> nil then
 241         begin
 242           self.mTile[i].Dealloc;
 243           self.mTile[i] := nil;
 244         end;
 245       end;
 246       self.mTile := nil;
 247     end;
 248     inherited;
 249   end;
 250
 251   function TGLTexture.GetLines (): Integer;
 252   begin
 253     ASSERT(self.mTile <> nil);
 254     result := Length(self.mTile) div self.mCols
 255   end;
 256
 257   function TGLTexture.GetTile (col, line: Integer): TGLAtlasNode;
 258     var i: Integer;
 259   begin
 260     ASSERT(col >= 0);
 261     ASSERT(col <= mCols);
 262     ASSERT(self.mTile <> nil);
 263     i := line * mCols + col;
 264     ASSERT(i >= 0);
 265     ASSERT(i < Length(mTile));
 266     result := mTile[i];
 267     ASSERT(result <> nil)
 268   end;
 269
 270   function r_Textures_Alloc (w, h: Integer): TGLTexture;
 271     var x, y, mw, mh, cols, lines: Integer; t: TGLTexture;
 272   begin
 273     ASSERT(w > 0);
 274     ASSERT(h > 0);
 275     cols := (w + maxTileSize - 1) div maxTileSize;
 276     lines := (h + maxTileSize - 1) div maxTileSize;
 277     t := TGLTexture.Create;
 278     t.mWidth := w;
 279     t.mHeight := h;
 280     t.mCols := cols;
 281     // t.mLines := lines;
 282     SetLength(t.mTile, cols * lines);
 283     for y := 0 to lines - 1 do
 284     begin
 285       mh := Min(maxTileSize, h - y * maxTileSize);
 286       ASSERT(mh > 0);
 287       for x := 0 to cols - 1 do
 288       begin
 289         mw := Min(maxTileSize, w - x * maxTileSize);
 290         ASSERT(mw > 0);
 291         t.mTile[y * cols + x] := r_Textures_AllocNode(mw, mh);
 292       end
 293     end;
 294     result := t;
 295   end;
 296
 297   (* --------- TGLMultiTexture --------- *)
 298
 299   destructor TGLMultiTexture.Destroy;
 300     var i: Integer;
 301   begin
 302     for i := 0 to self.count - 1 do
 303       self.mTexture[i].Free;
 304     self.mTexture := nil;
 305     inherited;
 306   end;
 307
 308   function TGLMultiTexture.GetWidth (): Integer;
 309   begin
 310     result := self.mTexture[0].width
 311   end;
 312
 313   function TGLMultiTexture.GetHeight (): Integer;
 314   begin
 315     result := self.mTexture[0].height
 316   end;
 317
 318   function TGLMultiTexture.GetCount (): Integer;
 319   begin
 320     result := Length(self.mTexture)
 321   end;
 322
 323   function TGLMultiTexture.GetTexture (i: Integer): TGLTexture;
 324   begin
 325     ASSERT(i >= 0);
 326     ASSERT(i < self.count);
 327     result := self.mTexture[i];
 328     ASSERT(result <> nil);
 329   end;
 330
 331   (* --------- Init / Fin --------- *)
 332
 333   function r_Textures_GetMaxHardwareSize (): Integer;
 334     var size: GLint = 0;
 335   begin
 336     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @size);
 337     if size < 64 then size := 64;
 338     //if size > 512 then size := 512;
 339     //size := 64; // !!!
 340     result := size;
 341   end;
 342
 343   procedure r_Textures_Initialize;
 344   begin
 345     maxTileSize := r_Textures_GetMaxHardwareSize();
 346   end;
 347
 348   procedure r_Textures_Finalize;
 349     var i: Integer;
 350   begin
 351     if atl <> nil then
 352     begin
 353       for i := 0 to High(atl) do
 354       begin
 355         glDeleteTextures(1, @atl[i].id);
 356         atl[i].id := 0;
 357         atl[i].Free;
 358       end;
 359       atl := nil;
 360     end;
 361   end;
 362
 363   function r_Textures_LoadFromImage (var img: TImageData): TGLTexture;
 364     var t: TGLTexture; n: TGLAtlasNode; c: TDynImageDataArray; cw, ch, i, j: LongInt;
 365   begin
 366     // e_logwritefln('r_Textures_CreateFromImage: w=%s h=%s', [img.width, img.height]);
 367     result := nil;
 368     if SplitImage(img, c, maxTileSize, maxTileSize, cw, ch, False) then
 369     begin
 370       t := r_Textures_Alloc(img.width, img.height);
 371       if t <> nil then
 372       begin
 373         ASSERT(cw = t.cols);
 374         ASSERT(ch = t.lines);
 375         for j := 0 to ch - 1 do
 376         begin
 377           for i := 0 to cw - 1 do
 378           begin
 379             n := t.GetTile(i, j);
 380             if n <> nil then
 381               r_Textures_UpdateNode(n, c[j * cw + i].bits, 0, 0, n.width, n.height)
 382           end
 383         end;
 384         result := t
 385       end;
 386       FreeImagesInArray(c);
 387     end;
 388   end;
 389
 390   function r_Textures_LoadFromMemory (data: Pointer; size: LongInt): TGLTexture;
 391     var img: TImageData;
 392   begin
 393     result := nil;
 394     if (data <> nil) and (size > 0) then
 395     begin
 396       InitImage(img);
 397       try
 398         if LoadImageFromMemory(data, size, img) then
 399           if ConvertImage(img, TImageFormat.ifA8R8G8B8) then
 400             if SwapChannels(img, ChannelRed, ChannelBlue) then // wth
 401               result := r_Textures_LoadFromImage(img)
 402       except
 403       end;
 404       FreeImage(img);
 405     end;
 406   end;
 407
 408   function r_Textures_LoadFromFile (const filename: AnsiString; log: Boolean = True): TGLTexture;
 409     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 410   begin
 411     result := nil;
 412     wadName := g_ExtractWadName(filename);
 413     wad := TWADFile.Create();
 414     if wad.ReadFile(wadName) then
 415     begin
 416       resName := g_ExtractFilePathName(filename);
 417       if wad.GetResource(resName, data, size, log) then
 418       begin
 419         result := r_Textures_LoadFromMemory(data, size);
 420         FreeMem(data);
 421       end;
 422       wad.Free
 423     end
 424   end;
 425
 426   function r_Textures_LoadMultiFromImageAndInfo (var img: TImageData; w, h, c: Integer; b: Boolean): TGLMultiTexture;
 427     var t: TImageData; a: array of TGLTexture; i: Integer; m: TGLMultiTexture;
 428   begin
 429     ASSERT(w >= 0);
 430     ASSERT(h >= 0);
 431     ASSERT(c >= 1);
 432     result := nil;
 433     SetLength(a, c);
 434     for i := 0 to c - 1 do
 435     begin
 436       InitImage(t);
 437       if NewImage(w, h, img.Format, t) then
 438         if CopyRect(img, w * i, 0, w, h, t, 0, 0) then
 439           a[i] := r_Textures_LoadFromImage(t);
 440       ASSERT(a[i] <> nil);
 441       FreeImage(t);
 442     end;
 443     m := TGLMultiTexture.Create();
 444     m.mTexture := a;
 445     m.mBackanim := b;
 446     ASSERT(m.mTexture <> nil);
 447     result := m;
 448   end;
 449
 450   function r_Textures_LoadMultiFromDataAndInfo (data: Pointer; size: LongInt; w, h, c: Integer; b: Boolean): TGLMultiTexture;
 451     var img: TImageData;
 452   begin
 453     ASSERT(w > 0);
 454     ASSERT(h > 0);
 455     ASSERT(c >= 1);
 456     result := nil;
 457     if (data <> nil) and (size > 0) then
 458     begin
 459       InitImage(img);
 460       try
 461         if LoadImageFromMemory(data, size, img) then
 462           if ConvertImage(img, TImageFormat.ifA8R8G8B8) then
 463             if SwapChannels(img, ChannelRed, ChannelBlue) then // wtf
 464               result := r_Textures_LoadMultiFromImageAndInfo(img, w, h, c, b)
 465       except
 466       end;
 467       FreeImage(img);
 468     end;
 469   end;
 470
 471   function r_Textures_LoadMultiFromWad (wad: TWADFile): TGLMultiTexture;
 472     var data: Pointer; size: LongInt; TexRes: AnsiString; w, h, c: Integer; b: Boolean; cfg: TConfig; img: TImageData;
 473   begin
 474     ASSERT(wad <> nil);
 475     result := nil;
 476     if wad.GetResource('TEXT/ANIM', data, size) then
 477     begin
 478       cfg := TConfig.CreateMem(data, size);
 479       FreeMem(data);
 480       if cfg <> nil then
 481       begin
 482         TexRes := cfg.ReadStr('', 'resource', '');
 483         w := cfg.ReadInt('', 'framewidth', 0);
 484         h := cfg.ReadInt('', 'frameheight', 0);
 485         c := cfg.ReadInt('', 'framecount', 0);
 486         b := cfg.ReadBool('', 'backanim', false);
 487         if (TexRes <> '') and (w > 0) and (h > 0) and (c > 0) then
 488         begin
 489           if wad.GetResource('TEXTURES/' + TexRes, data, size) then
 490           begin
 491             InitImage(img);
 492             try
 493               if LoadImageFromMemory(data, size, img) then
 494                 if ConvertImage(img, TImageFormat.ifA8R8G8B8) then
 495                   if SwapChannels(img, ChannelRed, ChannelBlue) then // wtf
 496                     result := r_Textures_LoadMultiFromImageAndInfo(img, w, h, c, b)
 497             finally
 498               FreeMem(data);
 499             end;
 500             FreeImage(img);
 501           end
 502         end;
 503         cfg.Free;
 504       end
 505     end;
 506   end;
 507
 508   function r_Textures_LoadMultiFromMemory (data: Pointer; size: LongInt): TGLMultiTexture;
 509     var wad: TWADFile; t: TGLTexture; m: TGLMultiTexture;
 510   begin
 511     result := nil;
 512     if (data <> nil) and (size > 0) then
 513     begin
 514       t := r_Textures_LoadFromMemory(data, size);
 515       if t <> nil then
 516       begin
 517         m := TGLMultiTexture.Create();
 518         SetLength(m.mTexture, 1);
 519         m.mTexture[0] := t;
 520         m.mBackanim := false;
 521         result := m;
 522       end
 523       else if IsWadData(data, size) then
 524       begin
 525         wad := TWADFile.Create();
 526         if wad.ReadMemory(data, size) then
 527         begin
 528           result := r_Textures_LoadMultiFromWad(wad);
 529           wad.Free;
 530         end
 531       end
 532     end
 533   end;
 534
 535   function r_Textures_LoadMultiFromFile (const filename: AnsiString; log: Boolean = True): TGLMultiTexture;
 536     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer; t: TGLTexture;
 537   begin
 538     result := nil;
 539     wadName := g_ExtractWadName(filename);
 540     wad := TWADFile.Create();
 541     if wad.ReadFile(wadName) then
 542     begin
 543       resName := g_ExtractFilePathName(filename);
 544       if wad.GetResource(resName, data, size, log) then
 545       begin
 546         result := r_Textures_LoadMultiFromMemory(data, size);
 547         FreeMem(data);
 548       end;
 549       wad.Free
 550     end
 551   end;
 552
 553   function r_Textures_LoadMultiFromFileAndInfo (const filename: AnsiString; w, h, count: Integer; backanim: Boolean; log: Boolean = True): TGLMultiTexture;
 554     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 555   begin
 556     ASSERT(w > 0);
 557     ASSERT(h > 0);
 558     ASSERT(count >= 1);
 559     result := nil;
 560     wadName := g_ExtractWadName(filename);
 561     wad := TWADFile.Create();
 562     if wad.ReadFile(wadName) then
 563     begin
 564       resName := g_ExtractFilePathName(filename);
 565       if wad.GetResource(resName, data, size, log) then
 566       begin
 567         result := r_Textures_LoadMultiFromDataAndInfo(data, size, w, h, count, backanim);
 568         FreeMem(data);
 569       end;
 570       wad.Free
 571     end
 572   end;
 573
 574 end.