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