src/game/renders/opengl/r_textures.pas

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