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     g_base, g_animations,  // TRectHW, TAnimInfo
  27     utils,
  28     r_atlas, r_fonts
  29   ;
  30
  31   type
  32     TGLHints = (txNoRepeat);
  33     TGLHintsSet = set of TGLHints;
  34
  35     TGLAtlas = class;
  36
  37     TGLAtlasNode = class (TAtlasNode)
  38       private
  39         mBase: TGLAtlas;
  40
  41       public
  42         constructor Create (base: TGLAtlas);
  43         destructor Destroy; override;
  44
  45         function GetID (): GLuint;
  46
  47         property base: TGLAtlas read mBase;
  48         property id: GLuint read GetID;
  49     end;
  50
  51     TGLAtlas = class (TAtlas)
  52       private
  53         mID: GLuint;
  54
  55       public
  56         constructor Create (ww, hh: Integer; id: GLuint);
  57         destructor Destroy; override;
  58
  59         function CreateNode (): TGLAtlasNode; override;
  60         function Alloc (ww, hh: Integer): TGLAtlasNode; overload;
  61
  62         property id: GLuint read mID write mID default 0;
  63     end;
  64
  65     TGLTexture = class
  66       private
  67         mWidth: Integer;
  68         mHeight: Integer;
  69         mCols: Integer;
  70         mTile: array of TGLAtlasNode;
  71         mHints: TGLHintsSet;
  72
  73       public
  74         destructor Destroy; override;
  75
  76         function GetTile (col, line: Integer): TGLAtlasNode;
  77
  78         function GetLines (): Integer; inline;
  79
  80         property width: Integer read mWidth;
  81         property height: Integer read mHeight;
  82         property cols: Integer read mCols;
  83         property lines: Integer read GetLines;
  84         property hints: TGLHintsSet read mHints;
  85     end;
  86
  87     TGLMultiTexture = class
  88       private
  89         mTexture: array of TGLTexture;
  90
  91       public
  92         destructor Destroy; override;
  93
  94         function GetWidth (): Integer; inline;
  95         function GetHeight (): Integer; inline;
  96         function GetCount (): Integer; inline;
  97         function GetTexture (i: Integer): TGLTexture; {inline;}
  98
  99         property width: Integer read GetWidth;
 100         property height: Integer read GetHeight;
 101         property count: Integer read GetCount;
 102     end;
 103
 104     TGLTextureArray = array of TGLTexture;
 105
 106     TRectArray = array of TRectWH;
 107
 108     TGLFont = class sealed (TFont)
 109       private
 110         info: TFontInfo;
 111         ch: TGLTextureArray;
 112
 113       public
 114         destructor Destroy; override;
 115         function GetChar (c: AnsiChar): TGLTexture;
 116         function GetWidth (c: AnsiChar): Integer;
 117         function GetMaxWidth (): Integer;
 118         function GetMaxHeight (): Integer;
 119         function GetSpace (): Integer;
 120     end;
 121
 122     TAnimTextInfo = record
 123       name: AnsiString;
 124       w, h: Integer;
 125       anim: TAnimInfo;
 126     end;
 127
 128     TConvProc = function (x: Integer): Integer;
 129
 130   procedure r_Textures_Initialize;
 131   procedure r_Textures_Finalize;
 132
 133   function r_Textures_LoadFromFile (const filename: AnsiString; hints: TGLHintsSet; log: Boolean = True): TGLTexture;
 134   function r_Textures_LoadMultiFromFile (const filename: AnsiString; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
 135   function r_Textures_LoadMultiFromFileAndInfo (const filename: AnsiString; w, h, count: Integer; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
 136   function r_Textures_LoadMultiTextFromFile (const filename: AnsiString; var txt: TAnimTextInfo; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
 137
 138   function r_Textures_LoadStreamFromFile (const filename: AnsiString; w, h, count, cw: Integer; st: TGLTextureArray; rs: TRectArray; hints: TGLHintsSet; log: Boolean = True): Boolean;
 139
 140   function r_Textures_LoadFontFromFile (const filename: AnsiString; constref f: TFontInfo; font2enc: TConvProc; log: Boolean = true): TGLFont;
 141
 142   procedure r_Textures_GL_Bind (id: GLuint);
 143
 144 implementation
 145
 146   uses
 147     SysUtils, Classes,
 148     r_common,
 149     e_log, e_res, WADReader, Config,
 150     g_console, // cvar declaration
 151     Imaging, ImagingTypes, ImagingUtility
 152   ;
 153
 154   var
 155     r_GL_MaxTexSize: WORD;
 156     r_GL_RepeatOpt: Boolean;
 157     maxTileSize: Integer;
 158     atl, ratl: array of TGLAtlas;
 159     currentTexture2D: GLuint;
 160
 161   procedure r_Textures_GL_Bind (id: GLuint);
 162   begin
 163     if id <> currentTexture2D then
 164     begin
 165       glBindTexture(GL_TEXTURE_2D, id);
 166       currentTexture2D := id;
 167     end
 168   end;
 169
 170   (* --------- TGLAtlasNode --------- *)
 171
 172   constructor TGLAtlasNode.Create (base: TGLAtlas);
 173   begin
 174     ASSERT(base <> nil);
 175     inherited Create();
 176     self.mBase := base;
 177   end;
 178
 179   destructor TGLAtlasNode.Destroy;
 180   begin
 181     inherited;
 182   end;
 183
 184   function TGLAtlasNode.GetID (): GLuint;
 185   begin
 186     result := self.base.id
 187   end;
 188
 189   procedure r_Textures_UpdateNode (n: TGLAtlasNode; data: Pointer; x, y, w, h: Integer);
 190   begin
 191     ASSERT(n <> nil);
 192     // ASSERT(n.leaf);
 193     ASSERT(n.base <> nil);
 194     ASSERT(data <> nil);
 195     ASSERT(x >= 0);
 196     ASSERT(y >= 0);
 197     ASSERT(n.l + x + w - 1 <= n.r);
 198     ASSERT(n.t + y + h - 1 <= n.b);
 199     ASSERT(n.id > 0);
 200     r_Textures_GL_Bind(n.id);
 201     glTexSubImage2D(GL_TEXTURE_2D, 0, n.l + x, n.t + y, w, h, GL_RGBA, GL_UNSIGNED_BYTE, data);
 202     r_Textures_GL_Bind(0);
 203   end;
 204
 205   (* --------- TGLAtlas --------- *)
 206
 207   constructor TGLAtlas.Create (ww, hh: Integer; id: GLuint);
 208   begin
 209     ASSERT(ww > 0);
 210     ASSERT(hh > 0);
 211     inherited Create(ww, hh);
 212     self.mID := id;
 213   end;
 214
 215   destructor TGLAtlas.Destroy;
 216   begin
 217     inherited;
 218   end;
 219
 220   function TGLAtlas.CreateNode (): TGLAtlasNode;
 221   begin
 222     result := TGLAtlasNode.Create(self);
 223   end;
 224
 225   function TGLAtlas.Alloc (ww, hh: Integer): TGLAtlasNode;
 226   begin
 227     result := TGLAtlasNode(inherited Alloc(ww, hh));
 228   end;
 229
 230   function r_Textures_AllocHWTexture (w, h: Integer): GLuint;
 231     var id: GLuint;
 232   begin
 233     glGenTextures(1, @id);
 234     if id <> 0 then
 235     begin
 236       r_Textures_GL_Bind(id);
 237       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
 238       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
 239       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
 240       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
 241       glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
 242       r_Textures_GL_Bind(0);
 243     end;
 244     result := id
 245   end;
 246
 247   function r_Textures_AllocAtlas (): TGLAtlas;
 248     var i: Integer; id: GLuint;
 249   begin
 250     result := nil;
 251     id := r_Textures_AllocHWTexture(maxTileSize, maxTileSize);
 252     if id <> 0 then
 253     begin
 254       i := Length(atl);
 255       SetLength(atl, i + 1);
 256       atl[i] := TGLAtlas.Create(maxTileSize, maxTileSize, id);
 257       result := atl[i];
 258     end;
 259   end;
 260
 261   function r_Textures_AllocRepeatAtlas (w, h: Integer): TGLAtlas;
 262     var i: Integer; id: GLuint;
 263   begin
 264     result := nil;
 265     id := r_Textures_AllocHWTexture(w, h);
 266     if id <> 0 then
 267     begin
 268       i := Length(ratl);
 269       SetLength(ratl, i + 1);
 270       ratl[i] := TGLAtlas.Create(w, h, id);
 271       result := ratl[i];
 272     end;
 273   end;
 274
 275   function r_Textures_AllocNode (w, h: Integer): TGLAtlasNode;
 276     var i: Integer; n: TGLAtlasNode; a: TGLAtlas;
 277   begin
 278     n := nil;
 279     if atl <> nil then
 280     begin
 281       i := High(atl);
 282       while (i >= 0) and (n = nil) do
 283       begin
 284         n := atl[i].Alloc(w, h);
 285         Dec(i);
 286       end;
 287     end;
 288     if n = nil then
 289     begin
 290       a := r_Textures_AllocAtlas();
 291       if a <> nil then
 292         n := a.Alloc(w, h);
 293     end;
 294     result := n
 295   end;
 296
 297   function r_Textures_AllocRepeatNode (w, h: Integer): TGLAtlasNode;
 298     var i: Integer; n: TGLAtlasNode; a: TGLAtlas;
 299   begin
 300     n := nil; a := nil;
 301     if ratl <> nil then
 302     begin
 303       i := High(ratl);
 304       while (i >= 0) and (ratl[i] <> nil) do DEC(i);
 305       if i >= 0 then a := ratl[i];
 306     end;
 307     if a = nil then a := r_Textures_AllocRepeatAtlas(w, h);
 308     if a <> nil then
 309     begin
 310       n := a.Alloc(w, h);
 311       if n = nil then
 312       begin
 313         i := High(ratl); while (i >= 0) and (ratl[i] <> a) do DEC(i);
 314         if i >= 0 then ratl[i] := nil;
 315         r_Common_FreeAndNil(a);
 316       end;
 317     end;
 318     result := n
 319   end;
 320
 321   (* --------- TGLTexture --------- *)
 322
 323   destructor TGLTexture.Destroy;
 324     var i: Integer; a: TGLAtlas;
 325   begin
 326     if self.mTile <> nil then
 327     begin
 328       if TGLHints.txNoRepeat in self.hints then (* non repeatable texture -> delete tiles only *)
 329       begin
 330         for i := 0 to High(self.mTile) do
 331         begin
 332           if self.mTile[i] <> nil then
 333           begin
 334             self.mTile[i].Dealloc;
 335             self.mTile[i] := nil
 336           end
 337         end
 338       end
 339       else (* repeatable texture -> delete whole atlas *)
 340       begin
 341         a := self.mTile[0].base;
 342         i := High(ratl); while (i >= 0) and (ratl[i] <> a) do DEC(i);
 343         if i >= 0 then ratl[i] := nil;
 344         r_Common_FreeAndNil(a);
 345       end;
 346       SetLength(self.mTile, 0);
 347     end;
 348     inherited;
 349   end;
 350
 351   function TGLTexture.GetLines (): Integer;
 352   begin
 353     ASSERT(self.mTile <> nil);
 354     result := Length(self.mTile) div self.mCols
 355   end;
 356
 357   function TGLTexture.GetTile (col, line: Integer): TGLAtlasNode;
 358     var i: Integer;
 359   begin
 360     ASSERT(col >= 0);
 361     ASSERT(col <= mCols);
 362     ASSERT(self.mTile <> nil);
 363     i := line * mCols + col;
 364     ASSERT(i >= 0);
 365     ASSERT(i < Length(mTile));
 366     result := mTile[i];
 367     ASSERT(result <> nil)
 368   end;
 369
 370   function r_Textures_Alloc (w, h: Integer; hints: TGLHintsSet): TGLTexture;
 371     var x, y, mw, mh, cols, lines: Integer; t: TGLTexture;
 372   begin
 373     ASSERT(w > 0);
 374     ASSERT(h > 0);
 375     if TGLHints.txNoRepeat in hints then
 376     begin
 377       cols := (w + maxTileSize - 1) div maxTileSize;
 378       lines := (h + maxTileSize - 1) div maxTileSize;
 379       t := TGLTexture.Create;
 380       t.mWidth := w;
 381       t.mHeight := h;
 382       t.mCols := cols;
 383       // t.mLines := lines;
 384       t.mHints := hints;
 385       SetLength(t.mTile, cols * lines);
 386       for y := 0 to lines - 1 do
 387       begin
 388         mh := Min(maxTileSize, h - y * maxTileSize);
 389         ASSERT(mh > 0);
 390         for x := 0 to cols - 1 do
 391         begin
 392           mw := Min(maxTileSize, w - x * maxTileSize);
 393           ASSERT(mw > 0);
 394           t.mTile[y * cols + x] := r_Textures_AllocNode(mw, mh);
 395         end
 396       end;
 397     end
 398     else
 399     begin
 400       t := TGLTexture.Create;
 401       t.mWidth := w;
 402       t.mHeight := h;
 403       t.mCols := 1;
 404       // t.mLines := 1
 405       t.mHints := hints;
 406       SetLength(t.mTile, 1);
 407       t.mTile[0] := r_Textures_AllocRepeatNode(w, h);
 408     end;
 409     result := t;
 410   end;
 411
 412   (* --------- TGLMultiTexture --------- *)
 413
 414   destructor TGLMultiTexture.Destroy;
 415     var i: Integer;
 416   begin
 417     for i := 0 to self.count - 1 do
 418       r_Common_FreeAndNil(self.mTexture[i]);
 419     SetLength(self.mTexture, 0);
 420     inherited;
 421   end;
 422
 423   function TGLMultiTexture.GetWidth (): Integer;
 424   begin
 425     result := self.mTexture[0].width
 426   end;
 427
 428   function TGLMultiTexture.GetHeight (): Integer;
 429   begin
 430     result := self.mTexture[0].height
 431   end;
 432
 433   function TGLMultiTexture.GetCount (): Integer;
 434   begin
 435     result := Length(self.mTexture)
 436   end;
 437
 438   function TGLMultiTexture.GetTexture (i: Integer): TGLTexture;
 439   begin
 440     ASSERT(i >= 0);
 441     ASSERT(i < self.count);
 442     result := self.mTexture[i];
 443     ASSERT(result <> nil);
 444   end;
 445
 446   (* --------- Init / Fin --------- *)
 447
 448   function IsPOT (v: LongWord): Boolean;
 449   begin
 450     result := (v <> 0) and ((v and (v - 1)) = 0)
 451   end;
 452
 453   function NextPOT (v: LongWord): LongWord;
 454   begin
 455     DEC(v);
 456     v := v or (v >> 1);
 457     v := v or (v >> 2);
 458     v := v or (v >> 4);
 459     v := v or (v >> 8);
 460     v := v or (v >> 16);
 461     INC(v);
 462     result := v;
 463   end;
 464
 465   function r_Textures_GetMaxHardwareSize (): Integer;
 466     var size: GLint = 0;
 467   begin
 468     if r_GL_MaxTexSize <= 0 then
 469     begin
 470       // auto, max possible reccomended by driver
 471       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @size);
 472       if size < 1 then size := 64;
 473     end
 474     else
 475     begin
 476       // selected by user
 477       if IsPOT(r_GL_MaxTexSize) then
 478         size := r_GL_MaxTexSize
 479       else
 480         size := NextPOT(r_GL_MaxTexSize);
 481     end;
 482     result := size;
 483   end;
 484
 485   procedure r_Textures_Initialize;
 486   begin
 487     currentTexture2D := 0;
 488     maxTileSize := r_Textures_GetMaxHardwareSize();
 489     e_LogWritefln('TEXTURE SIZE: %s', [maxTileSize]);
 490   end;
 491
 492   procedure r_Textures_Finalize;
 493     var i: Integer;
 494   begin
 495     if atl <> nil then
 496     begin
 497       for i := 0 to High(atl) do
 498       begin
 499         glDeleteTextures(1, @atl[i].id);
 500         atl[i].id := 0;
 501         r_Common_FreeAndNil(atl[i]);
 502       end;
 503     end;
 504     SetLength(atl, 0);
 505
 506     if ratl <> nil then
 507     begin
 508       for i := 0 to High(ratl) do
 509       begin
 510         glDeleteTextures(1, @ratl[i].id);
 511         ratl[i].id := 0;
 512         r_Common_FreeAndNil(ratl[i]);
 513       end;
 514     end;
 515     SetLength(ratl, 0);
 516   end;
 517
 518   function r_Textures_FixImageData (var img: TImageData): Boolean;
 519   begin
 520     result := false;
 521     if ConvertImage(img, TImageFormat.ifA8R8G8B8) then
 522       if SwapChannels(img, ChannelRed, ChannelBlue) then // wtf
 523         result := true;
 524   end;
 525
 526   function r_Textures_ValidRepeatTexture (w, h: Integer; hints: TGLHintsSet): Boolean;
 527   begin
 528     result := r_GL_RepeatOpt and
 529               not (TGLHints.txNoRepeat in hints) and
 530               (w <= maxTileSize) and
 531               (h <= maxTileSize) and
 532               IsPOT(w) and
 533               IsPOT(h)
 534   end;
 535
 536   function r_Textures_LoadFromImage (var img: TImageData; hints: TGLHintsSet): TGLTexture; // !!!
 537     var t: TGLTexture; n: TGLAtlasNode; c: TDynImageDataArray; cw, ch, i, j: LongInt;
 538   begin
 539     result := nil;
 540     if r_Textures_ValidRepeatTexture(img.width, img.height, hints) then
 541     begin
 542       t := r_Textures_Alloc(img.width, img.height, hints - [TGLHints.txNoRepeat]);
 543       if t <> nil then
 544       begin
 545         n := t.GetTile(0, 0);
 546         ASSERT(n <> nil);
 547         r_Textures_UpdateNode(n, img.bits, 0, 0, n.width, n.height);
 548         result := t
 549       end
 550     end
 551     else if SplitImage(img, c, maxTileSize, maxTileSize, cw, ch, False) then
 552     begin
 553       t := r_Textures_Alloc(img.width, img.height, hints + [TGLHints.txNoRepeat]);
 554       if t <> nil then
 555       begin
 556         ASSERT(cw = t.cols);
 557         ASSERT(ch = t.lines);
 558         for j := 0 to ch - 1 do
 559         begin
 560           for i := 0 to cw - 1 do
 561           begin
 562             n := t.GetTile(i, j);
 563             if n <> nil then
 564               r_Textures_UpdateNode(n, c[j * cw + i].bits, 0, 0, n.width, n.height)
 565           end
 566         end;
 567         result := t
 568       end;
 569       FreeImagesInArray(c);
 570     end;
 571   end;
 572
 573   function r_Textures_LoadFromMemory (data: Pointer; size: LongInt; hints: TGLHintsSet): TGLTexture;
 574     var img: TImageData;
 575   begin
 576     result := nil;
 577     if (data <> nil) and (size > 0) then
 578     begin
 579       InitImage(img);
 580       try
 581         if LoadImageFromMemory(data, size, img) then
 582           if r_Textures_FixImageData(img) then
 583             result := r_Textures_LoadFromImage(img, hints)
 584       except
 585       end;
 586       FreeImage(img);
 587     end;
 588   end;
 589
 590   function r_Textures_LoadFromFile (const filename: AnsiString; hints: TGLHintsSet; log: Boolean = True): TGLTexture;
 591     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 592   begin
 593     result := nil;
 594     wadName := g_ExtractWadName(filename);
 595     wad := TWADFile.Create();
 596     if wad.ReadFile(wadName) then
 597     begin
 598       resName := g_ExtractFilePathName(filename);
 599       if wad.GetResource(resName, data, size, log) then
 600       begin
 601         result := r_Textures_LoadFromMemory(data, size, hints);
 602         FreeMem(data);
 603       end;
 604       wad.Free
 605     end
 606   end;
 607
 608   function r_Textures_LoadMultiFromImageAndInfo (var img: TImageData; w, h, c: Integer; hints: TGLHintsSet): TGLMultiTexture;
 609     var t: TImageData; a: array of TGLTexture; i: Integer; m: TGLMultiTexture;
 610   begin
 611     ASSERT(w >= 0);
 612     ASSERT(h >= 0);
 613     ASSERT(c >= 1);
 614     result := nil;
 615     SetLength(a, c);
 616     for i := 0 to c - 1 do
 617     begin
 618       InitImage(t);
 619       if NewImage(w, h, img.Format, t) then
 620         if CopyRect(img, w * i, 0, w, h, t, 0, 0) then
 621           a[i] := r_Textures_LoadFromImage(t, hints);
 622       ASSERT(a[i] <> nil);
 623       FreeImage(t);
 624     end;
 625     m := TGLMultiTexture.Create();
 626     m.mTexture := a;
 627     ASSERT(m.mTexture <> nil);
 628     result := m;
 629   end;
 630
 631   function r_Textures_LoadMultiFromDataAndInfo (data: Pointer; size: LongInt; w, h, c: Integer; hints: TGLHintsSet): TGLMultiTexture;
 632     var img: TImageData;
 633   begin
 634     ASSERT(w > 0);
 635     ASSERT(h > 0);
 636     ASSERT(c >= 1);
 637     result := nil;
 638     if (data <> nil) and (size > 0) then
 639     begin
 640       InitImage(img);
 641       try
 642         if LoadImageFromMemory(data, size, img) then
 643           if r_Textures_FixImageData(img) then
 644             result := r_Textures_LoadMultiFromImageAndInfo(img, w, h, c, hints)
 645       except
 646       end;
 647       FreeImage(img);
 648     end;
 649   end;
 650
 651   function r_Textures_LoadTextFromMemory (data: Pointer; size: LongInt; var txt: TAnimTextInfo): Boolean;
 652     var cfg: TConfig;
 653   begin
 654     result := false;
 655     if data <> nil then
 656     begin
 657       cfg := TConfig.CreateMem(data, size);
 658       if cfg <> nil then
 659       begin
 660         txt.name := cfg.ReadStr('', 'resource', '');
 661         txt.w := MAX(0, cfg.ReadInt('', 'framewidth', 0));
 662         txt.h := MAX(0, cfg.ReadInt('', 'frameheight', 0));
 663         txt.anim.loop := true;
 664         txt.anim.delay := MAX(0, cfg.ReadInt('', 'waitcount', 0));
 665         txt.anim.frames := MAX(0, cfg.ReadInt('', 'framecount', 0));
 666         txt.anim.back := cfg.ReadBool('', 'backanim', false);
 667         cfg.Free;
 668         result := (txt.name <> '') and (txt.w > 0) and (txt.h > 0) and (txt.anim.delay > 0) and (txt.anim.frames > 0);
 669       end;
 670     end;
 671   end;
 672
 673   function r_Textures_LoadMultiFromWad (wad: TWADFile; var txt: TAnimTextInfo; hints: TGLHintsSet): TGLMultiTexture;
 674     var data: Pointer; size: LongInt; img: TImageData;
 675   begin
 676     ASSERT(wad <> nil);
 677     result := nil;
 678     if wad.GetResource('TEXT/ANIM', data, size) then
 679     begin
 680       if r_Textures_LoadTextFromMemory(data, size, txt) then
 681       begin
 682         FreeMem(data);
 683         if wad.GetResource('TEXTURES/' + txt.name, data, size) then
 684         begin
 685           InitImage(img);
 686           try
 687             if LoadImageFromMemory(data, size, img) then
 688               if r_Textures_FixImageData(img) then
 689                 result := r_Textures_LoadMultiFromImageAndInfo(img, txt.w, txt.h, txt.anim.frames, hints);
 690           finally
 691             FreeMem(data);
 692           end;
 693           FreeImage(img);
 694         end;
 695       end
 696       else
 697         FreeMem(data);
 698     end;
 699   end;
 700
 701   function r_Textures_LoadMultiFromMemory (data: Pointer; size: LongInt; var txt: TAnimTextInfo; hints: TGLHintsSet): TGLMultiTexture;
 702     var wad: TWADFile; t: TGLTexture; m: TGLMultiTexture;
 703   begin
 704     result := nil;
 705     if (data <> nil) and (size > 0) then
 706     begin
 707       t := r_Textures_LoadFromMemory(data, size, hints);
 708       if t <> nil then
 709       begin
 710         m := TGLMultiTexture.Create();
 711         SetLength(m.mTexture, 1);
 712         m.mTexture[0] := t;
 713         txt.name := '';
 714         txt.w := m.width;
 715         txt.h := m.height;
 716         txt.anim.loop := true;
 717         txt.anim.delay := 1;
 718         txt.anim.frames := 1;
 719         txt.anim.back := false;
 720         result := m;
 721       end
 722       else if IsWadData(data, size) then
 723       begin
 724         wad := TWADFile.Create();
 725         if wad.ReadMemory(data, size) then
 726         begin
 727           result := r_Textures_LoadMultiFromWad(wad, txt, hints);
 728           wad.Free;
 729         end
 730       end
 731     end
 732   end;
 733
 734   function r_Textures_LoadMultiTextFromFile (const filename: AnsiString; var txt: TAnimTextInfo; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
 735     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 736   begin
 737     result := nil;
 738     wadName := g_ExtractWadName(filename);
 739     wad := TWADFile.Create();
 740     if wad.ReadFile(wadName) then
 741     begin
 742       resName := g_ExtractFilePathName(filename);
 743       if wad.GetResource(resName, data, size, log) then
 744       begin
 745         result := r_Textures_LoadMultiFromMemory(data, size, txt, hints);
 746         FreeMem(data);
 747       end;
 748       wad.Free
 749     end
 750   end;
 751
 752   function r_Textures_LoadMultiFromFile (const filename: AnsiString; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
 753     var txt: TAnimTextInfo;
 754   begin
 755     result := r_Textures_LoadMultiTextFromFile(filename, txt, hints, log);
 756   end;
 757
 758   function r_Textures_LoadMultiFromFileAndInfo (const filename: AnsiString; w, h, count: Integer; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
 759     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 760   begin
 761     ASSERT(w > 0);
 762     ASSERT(h > 0);
 763     ASSERT(count >= 1);
 764     result := nil;
 765     wadName := g_ExtractWadName(filename);
 766     wad := TWADFile.Create();
 767     if wad.ReadFile(wadName) then
 768     begin
 769       resName := g_ExtractFilePathName(filename);
 770       if wad.GetResource(resName, data, size, log) then
 771       begin
 772         result := r_Textures_LoadMultiFromDataAndInfo(data, size, w, h, count, hints);
 773         FreeMem(data);
 774       end;
 775       wad.Free
 776     end
 777   end;
 778
 779   function r_Textures_GetRect (var img: TImageData): TRectWH;
 780     var i, j, w, h: Integer; done: Boolean;
 781
 782     function IsVoid (i, j: Integer): Boolean; inline;
 783     begin
 784       result := GetPixel32(img, i, j).Channels[3] = 0
 785     end;
 786
 787   begin
 788     w := img.Width;
 789     h := img.Height;
 790
 791     (* trace x from right to left *)
 792     done := false; i := 0;
 793     while not done and (i < w) do
 794     begin
 795       j := 0;
 796       while (j < h) and IsVoid(i, j) do inc(j);
 797       done := (j < h) and (IsVoid(i, j) = false);
 798       result.x := i;
 799       inc(i);
 800     end;
 801
 802     (* trace y from up to down *)
 803     done := false; j := 0;
 804     while not done and (j < h) do
 805     begin
 806       i := 0;
 807       while (i < w) and IsVoid(i, j) do inc(i);
 808       done := (i < w) and (IsVoid(i, j) = false);
 809       result.y := j;
 810       inc(j);
 811     end;
 812
 813     (* trace x from right to left *)
 814     done := false; i := w - 1;
 815     while not done and (i >= 0) do
 816     begin
 817       j := 0;
 818       while (j < h) and IsVoid(i, j) do inc(j);
 819       done := (j < h) and (IsVoid(i, j) = false);
 820       result.width := i - result.x + 1;
 821       dec(i);
 822     end;
 823
 824     (* trace y from down to up *)
 825     done := false; j := h - 1;
 826     while not done and (j >= 0) do
 827     begin
 828       i := 0;
 829       while (i < w) and IsVoid(i, j) do inc(i);
 830       done := (i < w) and (IsVoid(i, j) = false);
 831       result.height := j - result.y + 1;
 832       dec(j);
 833     end;
 834   end;
 835
 836   function r_Textures_LoadStreamFromImage (var img: TImageData; w, h, c, cw: Integer; st: TGLTextureArray; rs: TRectArray; hints: TGLHintsSet): Boolean;
 837     var i, x, y: Integer; t: TImageData;
 838   begin
 839     ASSERT(w >= 0);
 840     ASSERT(h >= 0);
 841     ASSERT(c >= 1);
 842     ASSERT(cw >= 1);
 843     ASSERT((st <> nil) and (Length(st) >= c));
 844     ASSERT((rs = nil) or (Length(rs) >= c));
 845     result := true;
 846     for i := 0 to c - 1 do
 847     begin
 848       x := i mod cw;
 849       y := i div cw;
 850       InitImage(t);
 851       st[i] := nil;
 852       if NewImage(w, h, img.Format, t) then
 853       begin
 854         if CopyRect(img, x * w, y * h, w, h, t, 0, 0) then
 855         begin
 856           if rs <> nil then
 857             rs[i] := r_Textures_GetRect(t);
 858           st[i] := r_Textures_LoadFromImage(t, hints);
 859         end;
 860       end;
 861       ASSERT(st[i] <> nil);
 862       FreeImage(t);
 863     end;
 864   end;
 865
 866   function r_Textures_LoadStreamFromMemory (data: Pointer; size: LongInt; w, h, c, cw: Integer; st: TGLTextureArray; rs: TRectArray; hints: TGLHintsSet): Boolean;
 867     var img: TImageData;
 868   begin
 869     ASSERT(w >= 0);
 870     ASSERT(h >= 0);
 871     ASSERT(c >= 1);
 872     ASSERT(cw >= 1);
 873     ASSERT((st <> nil) and (Length(st) >= c));
 874     ASSERT((rs = nil) or (Length(rs) >= c));
 875     result := false;
 876     if (data <> nil) and (size > 0) then
 877     begin
 878       InitImage(img);
 879       try
 880         if LoadImageFromMemory(data, size, img) then
 881         begin
 882           if r_Textures_FixImageData(img) then
 883           begin
 884             result := r_Textures_LoadStreamFromImage(img, w, h, c, cw, st, rs, hints)
 885           end;
 886         end;
 887       except
 888       end;
 889       FreeImage(img);
 890     end;
 891   end;
 892
 893   function r_Textures_LoadStreamFromFile (const filename: AnsiString; w, h, count, cw: Integer; st: TGLTextureArray; rs: TRectArray; hints: TGLHintsSet; log: Boolean = True): Boolean;
 894     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 895   begin
 896     ASSERT(w > 0);
 897     ASSERT(h > 0);
 898     ASSERT(count >= 1);
 899     ASSERT(cw >= 1);
 900     ASSERT((st <> nil) and (Length(st) >= count));
 901     ASSERT((rs = nil) or (Length(rs) >= count));
 902     result := false;
 903     wadName := g_ExtractWadName(filename);
 904     wad := TWADFile.Create();
 905     if wad.ReadFile(wadName) then
 906     begin
 907       resName := g_ExtractFilePathName(filename);
 908       if wad.GetResource(resName, data, size, log) then
 909       begin
 910         result := r_Textures_LoadStreamFromMemory(data, size, w, h, count, cw, st, rs, hints);
 911         FreeMem(data);
 912       end;
 913       wad.Free
 914     end;
 915   end;
 916
 917   (* --------- TGLFont --------- *)
 918
 919   function r_Textures_LoadFontFromFile (const filename: AnsiString; constref f: TFontInfo; font2enc: TConvProc; log: Boolean = true): TGLFont;
 920     var i, ch: Integer; st, stch: TGLTextureArray; font: TGLFont;
 921   begin
 922     result := nil;
 923     SetLength(st, 256);
 924     if r_Textures_LoadStreamFromFile(filename, f.w, f.h, 256, 16, st, nil, [TGLHints.txNoRepeat], log) then
 925     begin
 926       font := TGLFont.Create();
 927       font.info := f;
 928       font.ch := st;
 929       if Assigned(font2enc) then
 930       begin
 931         SetLength(stch, 256);
 932         for i := 0 to 255 do
 933         begin
 934           ch := font2enc(i);
 935           ASSERT((ch >= 0) and (ch <= 255));
 936           stch[ch] := st[i];
 937         end;
 938         font.ch := stch;
 939         SetLength(st, 0);
 940       end;
 941       result := font;
 942     end;
 943   end;
 944
 945   destructor TGLFont.Destroy;
 946     var i: Integer;
 947   begin
 948     if self.ch <> nil then
 949       for i := 0 to High(self.ch) do
 950         self.ch[i].Free;
 951     self.ch := nil;
 952   end;
 953
 954   function TGLFont.GetChar (c: AnsiChar): TGLTexture;
 955   begin
 956     result := self.ch[ORD(c)];
 957   end;
 958
 959   function TGLFont.GetWidth (c: AnsiChar): Integer;
 960   begin
 961     result := self.info.ch[c].w;
 962     if result = 0 then
 963       result := self.info.w;
 964     if self.info.kern < 0 then
 965       result := result + self.info.kern;
 966   end;
 967
 968   function TGLFont.GetMaxWidth (): Integer;
 969   begin
 970     result := self.info.w;
 971     if self.info.kern < 0 then
 972       result := result + self.info.kern;
 973   end;
 974
 975   function TGLFont.GetMaxHeight (): Integer;
 976   begin
 977     result := self.info.h;
 978   end;
 979
 980   function TGLFont.GetSpace (): Integer;
 981   begin
 982     result := self.info.kern;
 983   end;
 984
 985 initialization
 986   conRegVar('r_gl_maxtexsize', @r_GL_MaxTexSize, '', '');
 987   conRegVar('r_gl_repeat', @r_GL_RepeatOpt, '', '');
 988   r_GL_MaxTexSize := 0; // default is automatic value
 989   r_GL_RepeatOpt := true;
 990 end.