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