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