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