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