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