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         if atl[i] <> nil then
 496         begin
 497           glDeleteTextures(1, @atl[i].id);
 498           atl[i].id := 0;
 499           r_Common_FreeAndNil(atl[i]);
 500         end;
 501       end;
 502     end;
 503     SetLength(atl, 0);
 504
 505     if ratl <> nil then
 506     begin
 507       for i := 0 to High(ratl) do
 508       begin
 509         if ratl[i] <> nil then
 510         begin
 511           glDeleteTextures(1, @ratl[i].id);
 512           ratl[i].id := 0;
 513           r_Common_FreeAndNil(ratl[i]);
 514         end;
 515       end;
 516     end;
 517     SetLength(ratl, 0);
 518   end;
 519
 520   function r_Textures_FixImageData (var img: TImageData): Boolean;
 521   begin
 522     result := false;
 523     if ConvertImage(img, TImageFormat.ifA8R8G8B8) then
 524       if SwapChannels(img, ChannelRed, ChannelBlue) then // wtf
 525         result := true;
 526   end;
 527
 528   function r_Textures_ValidRepeatTexture (w, h: Integer; hints: TGLHintsSet): Boolean;
 529   begin
 530     result := r_GL_RepeatOpt and
 531               not (TGLHints.txNoRepeat in hints) and
 532               (w <= maxTileSize) and
 533               (h <= maxTileSize) and
 534               IsPOT(w) and
 535               IsPOT(h)
 536   end;
 537
 538   function r_Textures_LoadFromImage (var img: TImageData; hints: TGLHintsSet): TGLTexture; // !!!
 539     var t: TGLTexture; n: TGLAtlasNode; c: TDynImageDataArray; cw, ch, i, j: LongInt;
 540   begin
 541     result := nil;
 542     if r_Textures_ValidRepeatTexture(img.width, img.height, hints) then
 543     begin
 544       t := r_Textures_Alloc(img.width, img.height, hints - [TGLHints.txNoRepeat]);
 545       if t <> nil then
 546       begin
 547         n := t.GetTile(0, 0);
 548         ASSERT(n <> nil);
 549         r_Textures_UpdateNode(n, img.bits, 0, 0, n.width, n.height);
 550         result := t
 551       end
 552     end
 553     else if SplitImage(img, c, maxTileSize, maxTileSize, cw, ch, False) then
 554     begin
 555       t := r_Textures_Alloc(img.width, img.height, hints + [TGLHints.txNoRepeat]);
 556       if t <> nil then
 557       begin
 558         ASSERT(cw = t.cols);
 559         ASSERT(ch = t.lines);
 560         for j := 0 to ch - 1 do
 561         begin
 562           for i := 0 to cw - 1 do
 563           begin
 564             n := t.GetTile(i, j);
 565             if n <> nil then
 566               r_Textures_UpdateNode(n, c[j * cw + i].bits, 0, 0, n.width, n.height)
 567           end
 568         end;
 569         result := t
 570       end;
 571       FreeImagesInArray(c);
 572     end;
 573   end;
 574
 575   function r_Textures_LoadFromMemory (data: Pointer; size: LongInt; hints: TGLHintsSet): TGLTexture;
 576     var img: TImageData;
 577   begin
 578     result := nil;
 579     if (data <> nil) and (size > 0) then
 580     begin
 581       InitImage(img);
 582       try
 583         if LoadImageFromMemory(data, size, img) then
 584           if r_Textures_FixImageData(img) then
 585             result := r_Textures_LoadFromImage(img, hints)
 586       except
 587       end;
 588       FreeImage(img);
 589     end;
 590   end;
 591
 592   function r_Textures_LoadFromFile (const filename: AnsiString; hints: TGLHintsSet; log: Boolean = True): TGLTexture;
 593     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 594   begin
 595     result := nil;
 596     wadName := g_ExtractWadName(filename);
 597     wad := TWADFile.Create();
 598     if wad.ReadFile(wadName) then
 599     begin
 600       resName := g_ExtractFilePathName(filename);
 601       if wad.GetResource(resName, data, size, log) then
 602       begin
 603         result := r_Textures_LoadFromMemory(data, size, hints);
 604         FreeMem(data);
 605       end;
 606       wad.Free
 607     end
 608   end;
 609
 610   function r_Textures_LoadMultiFromImageAndInfo (var img: TImageData; w, h, c: Integer; hints: TGLHintsSet): TGLMultiTexture;
 611     var t: TImageData; a: array of TGLTexture; i: Integer; m: TGLMultiTexture;
 612   begin
 613     ASSERT(w >= 0);
 614     ASSERT(h >= 0);
 615     ASSERT(c >= 1);
 616     result := nil;
 617     SetLength(a, c);
 618     for i := 0 to c - 1 do
 619     begin
 620       InitImage(t);
 621       if NewImage(w, h, img.Format, t) then
 622         if CopyRect(img, w * i, 0, w, h, t, 0, 0) then
 623           a[i] := r_Textures_LoadFromImage(t, hints);
 624       ASSERT(a[i] <> nil);
 625       FreeImage(t);
 626     end;
 627     m := TGLMultiTexture.Create();
 628     m.mTexture := a;
 629     ASSERT(m.mTexture <> nil);
 630     result := m;
 631   end;
 632
 633   function r_Textures_LoadMultiFromDataAndInfo (data: Pointer; size: LongInt; w, h, c: Integer; hints: TGLHintsSet): TGLMultiTexture;
 634     var img: TImageData;
 635   begin
 636     ASSERT(w > 0);
 637     ASSERT(h > 0);
 638     ASSERT(c >= 1);
 639     result := nil;
 640     if (data <> nil) and (size > 0) then
 641     begin
 642       InitImage(img);
 643       try
 644         if LoadImageFromMemory(data, size, img) then
 645           if r_Textures_FixImageData(img) then
 646             result := r_Textures_LoadMultiFromImageAndInfo(img, w, h, c, hints)
 647       except
 648       end;
 649       FreeImage(img);
 650     end;
 651   end;
 652
 653   function r_Textures_LoadTextFromMemory (data: Pointer; size: LongInt; var text: TAnimTextInfo): Boolean;
 654     var cfg: TConfig;
 655   begin
 656     result := false;
 657     if data <> nil then
 658     begin
 659       cfg := TConfig.CreateMem(data, size);
 660       if cfg <> nil then
 661       begin
 662         text.name := cfg.ReadStr('', 'resource', '');
 663         text.w := cfg.ReadInt('', 'framewidth', 0);
 664         text.h := cfg.ReadInt('', 'frameheight', 0);
 665         text.anim.loop := true;
 666         text.anim.delay := cfg.ReadInt('', 'waitcount', 0);
 667         text.anim.frames := cfg.ReadInt('', 'framecount', 0);
 668         text.anim.back := cfg.ReadBool('', 'backanim', false);
 669         if text.w <= 0 then e_LogWritefln('Warning: bad animation width %s for %s', [text.w, text.name]);
 670         if text.h <= 0 then e_LogWritefln('Warning: bad animation height %s for %s', [text.h, text.name]);
 671         if text.anim.delay <= 0 then e_LogWritefln('Warning: bad animation delay %s for %s', [text.anim.delay, text.name]);
 672         if text.anim.frames <= 0 then e_LogWritefln('Warning: bad animation frame count %s for %s', [text.anim.frames, text.name]);
 673         text.w := MAX(0, text.w);
 674         text.h := MAX(0, text.h);
 675         text.anim.delay := MAX(1, text.anim.delay);
 676         text.anim.frames := MAX(1, text.anim.frames);
 677         cfg.Free;
 678         result := (text.name <> '') and (text.w > 0) and (text.h > 0) and (text.anim.delay > 0) and (text.anim.frames > 0);
 679       end;
 680     end;
 681   end;
 682
 683   function r_Textures_LoadMultiFromWad (wad: TWADFile; var txt: TAnimTextInfo; hints: TGLHintsSet): TGLMultiTexture;
 684     var data: Pointer; size: LongInt; img: TImageData;
 685   begin
 686     ASSERT(wad <> nil);
 687     result := nil;
 688     if wad.GetResource('TEXT/ANIM', data, size) then
 689     begin
 690       if r_Textures_LoadTextFromMemory(data, size, txt) then
 691       begin
 692         FreeMem(data);
 693         if wad.GetResource('TEXTURES/' + txt.name, data, size) then
 694         begin
 695           InitImage(img);
 696           try
 697             if LoadImageFromMemory(data, size, img) then
 698               if r_Textures_FixImageData(img) then
 699                 result := r_Textures_LoadMultiFromImageAndInfo(img, txt.w, txt.h, txt.anim.frames, hints);
 700           finally
 701             FreeMem(data);
 702           end;
 703           FreeImage(img);
 704         end;
 705       end
 706       else
 707         FreeMem(data);
 708     end;
 709   end;
 710
 711   function r_Textures_LoadMultiFromMemory (data: Pointer; size: LongInt; var txt: TAnimTextInfo; hints: TGLHintsSet): TGLMultiTexture;
 712     var wad: TWADFile; t: TGLTexture; m: TGLMultiTexture;
 713   begin
 714     result := nil;
 715     if (data <> nil) and (size > 0) then
 716     begin
 717       t := r_Textures_LoadFromMemory(data, size, hints);
 718       if t <> nil then
 719       begin
 720         m := TGLMultiTexture.Create();
 721         SetLength(m.mTexture, 1);
 722         m.mTexture[0] := t;
 723         txt.name := '';
 724         txt.w := m.width;
 725         txt.h := m.height;
 726         txt.anim.loop := true;
 727         txt.anim.delay := 1;
 728         txt.anim.frames := 1;
 729         txt.anim.back := false;
 730         result := m;
 731       end
 732       else if IsWadData(data, size) then
 733       begin
 734         wad := TWADFile.Create();
 735         if wad.ReadMemory(data, size) then
 736         begin
 737           result := r_Textures_LoadMultiFromWad(wad, txt, hints);
 738           wad.Free;
 739         end
 740       end
 741     end
 742   end;
 743
 744   function r_Textures_LoadMultiTextFromFile (const filename: AnsiString; var txt: TAnimTextInfo; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
 745     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 746   begin
 747     result := nil;
 748     wadName := g_ExtractWadName(filename);
 749     wad := TWADFile.Create();
 750     if wad.ReadFile(wadName) then
 751     begin
 752       resName := g_ExtractFilePathName(filename);
 753       if wad.GetResource(resName, data, size, log) then
 754       begin
 755         result := r_Textures_LoadMultiFromMemory(data, size, txt, hints);
 756         FreeMem(data);
 757       end;
 758       wad.Free
 759     end
 760   end;
 761
 762   function r_Textures_LoadMultiFromFile (const filename: AnsiString; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
 763     var txt: TAnimTextInfo;
 764   begin
 765     result := r_Textures_LoadMultiTextFromFile(filename, txt, hints, log);
 766   end;
 767
 768   function r_Textures_LoadMultiFromFileAndInfo (const filename: AnsiString; w, h, count: Integer; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
 769     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 770   begin
 771     ASSERT(w > 0);
 772     ASSERT(h > 0);
 773     ASSERT(count >= 1);
 774     result := nil;
 775     wadName := g_ExtractWadName(filename);
 776     wad := TWADFile.Create();
 777     if wad.ReadFile(wadName) then
 778     begin
 779       resName := g_ExtractFilePathName(filename);
 780       if wad.GetResource(resName, data, size, log) then
 781       begin
 782         result := r_Textures_LoadMultiFromDataAndInfo(data, size, w, h, count, hints);
 783         FreeMem(data);
 784       end;
 785       wad.Free
 786     end
 787   end;
 788
 789   function r_Textures_GetRect (var img: TImageData): TRectWH;
 790     var i, j, w, h: Integer; done: Boolean;
 791
 792     function IsVoid (i, j: Integer): Boolean; inline;
 793     begin
 794       result := GetPixel32(img, i, j).Channels[3] = 0
 795     end;
 796
 797   begin
 798     w := img.Width;
 799     h := img.Height;
 800
 801     (* trace x from right to left *)
 802     done := false; i := 0;
 803     while not done and (i < w) do
 804     begin
 805       j := 0;
 806       while (j < h) and IsVoid(i, j) do inc(j);
 807       done := (j < h) and (IsVoid(i, j) = false);
 808       result.x := i;
 809       inc(i);
 810     end;
 811
 812     (* trace y from up to down *)
 813     done := false; j := 0;
 814     while not done and (j < h) do
 815     begin
 816       i := 0;
 817       while (i < w) and IsVoid(i, j) do inc(i);
 818       done := (i < w) and (IsVoid(i, j) = false);
 819       result.y := j;
 820       inc(j);
 821     end;
 822
 823     (* trace x from right to left *)
 824     done := false; i := w - 1;
 825     while not done and (i >= 0) do
 826     begin
 827       j := 0;
 828       while (j < h) and IsVoid(i, j) do inc(j);
 829       done := (j < h) and (IsVoid(i, j) = false);
 830       result.width := i - result.x + 1;
 831       dec(i);
 832     end;
 833
 834     (* trace y from down to up *)
 835     done := false; j := h - 1;
 836     while not done and (j >= 0) do
 837     begin
 838       i := 0;
 839       while (i < w) and IsVoid(i, j) do inc(i);
 840       done := (i < w) and (IsVoid(i, j) = false);
 841       result.height := j - result.y + 1;
 842       dec(j);
 843     end;
 844   end;
 845
 846   function r_Textures_LoadStreamFromImage (var img: TImageData; w, h, c, cw: Integer; st: TGLTextureArray; rs: TRectArray; hints: TGLHintsSet): Boolean;
 847     var i, x, y: Integer; t: TImageData;
 848   begin
 849     ASSERT(w >= 0);
 850     ASSERT(h >= 0);
 851     ASSERT(c >= 1);
 852     ASSERT(cw >= 1);
 853     ASSERT((st <> nil) and (Length(st) >= c));
 854     ASSERT((rs = nil) or (Length(rs) >= c));
 855     result := true;
 856     for i := 0 to c - 1 do
 857     begin
 858       x := i mod cw;
 859       y := i div cw;
 860       InitImage(t);
 861       st[i] := nil;
 862       if NewImage(w, h, img.Format, t) then
 863       begin
 864         if CopyRect(img, x * w, y * h, w, h, t, 0, 0) then
 865         begin
 866           if rs <> nil then
 867             rs[i] := r_Textures_GetRect(t);
 868           st[i] := r_Textures_LoadFromImage(t, hints);
 869         end;
 870       end;
 871       ASSERT(st[i] <> nil);
 872       FreeImage(t);
 873     end;
 874   end;
 875
 876   function r_Textures_LoadStreamFromMemory (data: Pointer; size: LongInt; w, h, c, cw: Integer; st: TGLTextureArray; rs: TRectArray; hints: TGLHintsSet): Boolean;
 877     var img: TImageData;
 878   begin
 879     ASSERT(w >= 0);
 880     ASSERT(h >= 0);
 881     ASSERT(c >= 1);
 882     ASSERT(cw >= 1);
 883     ASSERT((st <> nil) and (Length(st) >= c));
 884     ASSERT((rs = nil) or (Length(rs) >= c));
 885     result := false;
 886     if (data <> nil) and (size > 0) then
 887     begin
 888       InitImage(img);
 889       try
 890         if LoadImageFromMemory(data, size, img) then
 891         begin
 892           if r_Textures_FixImageData(img) then
 893           begin
 894             result := r_Textures_LoadStreamFromImage(img, w, h, c, cw, st, rs, hints)
 895           end;
 896         end;
 897       except
 898       end;
 899       FreeImage(img);
 900     end;
 901   end;
 902
 903   function r_Textures_LoadStreamFromFile (const filename: AnsiString; w, h, count, cw: Integer; st: TGLTextureArray; rs: TRectArray; hints: TGLHintsSet; log: Boolean = True): Boolean;
 904     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 905   begin
 906     ASSERT(w > 0);
 907     ASSERT(h > 0);
 908     ASSERT(count >= 1);
 909     ASSERT(cw >= 1);
 910     ASSERT((st <> nil) and (Length(st) >= count));
 911     ASSERT((rs = nil) or (Length(rs) >= count));
 912     result := false;
 913     wadName := g_ExtractWadName(filename);
 914     wad := TWADFile.Create();
 915     if wad.ReadFile(wadName) then
 916     begin
 917       resName := g_ExtractFilePathName(filename);
 918       if wad.GetResource(resName, data, size, log) then
 919       begin
 920         result := r_Textures_LoadStreamFromMemory(data, size, w, h, count, cw, st, rs, hints);
 921         FreeMem(data);
 922       end;
 923       wad.Free
 924     end;
 925   end;
 926
 927   (* --------- TGLFont --------- *)
 928
 929   function r_Textures_LoadFontFromFile (const filename: AnsiString; constref f: TFontInfo; font2enc: TConvProc; log: Boolean = true): TGLFont;
 930     var i, ch: Integer; st, stch: TGLTextureArray; font: TGLFont;
 931   begin
 932     result := nil;
 933     SetLength(st, 256);
 934     if r_Textures_LoadStreamFromFile(filename, f.w, f.h, 256, 16, st, nil, [TGLHints.txNoRepeat], log) then
 935     begin
 936       font := TGLFont.Create();
 937       font.info := f;
 938       font.ch := st;
 939       if Assigned(font2enc) then
 940       begin
 941         SetLength(stch, 256);
 942         for i := 0 to 255 do
 943         begin
 944           ch := font2enc(i);
 945           ASSERT((ch >= 0) and (ch <= 255));
 946           stch[ch] := st[i];
 947         end;
 948         font.ch := stch;
 949         SetLength(st, 0);
 950       end;
 951       result := font;
 952     end;
 953   end;
 954
 955   destructor TGLFont.Destroy;
 956     var i: Integer;
 957   begin
 958     if self.ch <> nil then
 959       for i := 0 to High(self.ch) do
 960         self.ch[i].Free;
 961     self.ch := nil;
 962   end;
 963
 964   function TGLFont.GetChar (c: AnsiChar): TGLTexture;
 965   begin
 966     result := self.ch[ORD(c)];
 967   end;
 968
 969   function TGLFont.GetWidth (c: AnsiChar): Integer;
 970   begin
 971     result := self.info.ch[c].w;
 972     if result = 0 then
 973       result := self.info.w;
 974     if self.info.kern < 0 then
 975       result := result + self.info.kern;
 976   end;
 977
 978   function TGLFont.GetMaxWidth (): Integer;
 979   begin
 980     result := self.info.w;
 981     if self.info.kern < 0 then
 982       result := result + self.info.kern;
 983   end;
 984
 985   function TGLFont.GetMaxHeight (): Integer;
 986   begin
 987     result := self.info.h;
 988   end;
 989
 990   function TGLFont.GetSpace (): Integer;
 991   begin
 992     result := self.info.kern;
 993   end;
 994
 995 initialization
 996   conRegVar('r_gl_maxtexsize', @r_GL_MaxTexSize, '', '');
 997   conRegVar('r_gl_repeat', @r_GL_RepeatOpt, '', '');
 998   r_GL_MaxTexSize := 0; // default is automatic value
 999   r_GL_RepeatOpt := true;
1000 end.