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