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