src/game/renders/opengl/r_textures.pas

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