src/game/renders/opengl/r_textures.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$INCLUDE ../../../shared/a_modes.inc}
  16 unit r_textures;
  17
  18 interface
  19
  20   uses
  21     {$IFDEF USE_GLES1}
  22       GLES11,
  23     {$ELSE}
  24       GL, GLEXT,
  25     {$ENDIF}
  26     g_base, g_animations,  // TRectHW, TAnimInfo
  27     utils,
  28     r_atlas, r_fonts
  29   ;
  30
  31   type
  32     TGLAtlas = class;
  33
  34     TGLAtlasNode = class (TAtlasNode)
  35       private
  36         mBase: TGLAtlas;
  37
  38       public
  39         constructor Create (base: TGLAtlas);
  40         destructor Destroy; override;
  41
  42         function GetID (): GLuint;
  43
  44         property base: TGLAtlas read mBase;
  45         property id: GLuint read GetID;
  46     end;
  47
  48     TGLAtlas = class (TAtlas)
  49       private
  50         mID: GLuint;
  51
  52       public
  53         constructor Create (ww, hh: Integer; id: GLuint);
  54         destructor Destroy; override;
  55
  56         function CreateNode (): TGLAtlasNode; override;
  57         function Alloc (ww, hh: Integer): TGLAtlasNode; overload;
  58
  59         property id: GLuint read mID write mID default 0;
  60     end;
  61
  62     TGLTexture = class
  63       private
  64         mWidth: Integer;
  65         mHeight: Integer;
  66         mCols: Integer;
  67         mTile: array of TGLAtlasNode;
  68
  69       public
  70         destructor Destroy; override;
  71
  72         function GetTile (col, line: Integer): TGLAtlasNode;
  73
  74         function GetLines (): Integer; inline;
  75
  76         property width: Integer read mWidth;
  77         property height: Integer read mHeight;
  78         property cols: Integer read mCols;
  79         property lines: Integer read GetLines;
  80     end;
  81
  82     TGLMultiTexture = class
  83       private
  84         mTexture: array of TGLTexture;
  85
  86       public
  87         destructor Destroy; override;
  88
  89         function GetWidth (): Integer; inline;
  90         function GetHeight (): Integer; inline;
  91         function GetCount (): Integer; inline;
  92         function GetTexture (i: Integer): TGLTexture; {inline;}
  93
  94         property width: Integer read GetWidth;
  95         property height: Integer read GetHeight;
  96         property count: Integer read GetCount;
  97     end;
  98
  99     TGLTextureArray = array of TGLTexture;
 100
 101     TRectArray = array of TRectWH;
 102
 103     TGLFont = class sealed (TFont)
 104       private
 105         info: TFontInfo;
 106         ch: TGLTextureArray;
 107
 108       public
 109         destructor Destroy; override;
 110         function GetChar (c: AnsiChar): TGLTexture;
 111         function GetWidth (c: AnsiChar): Integer;
 112         function GetMaxWidth (): Integer;
 113         function GetMaxHeight (): Integer;
 114         function GetSpace (): Integer;
 115     end;
 116
 117     TAnimTextInfo = record
 118       name: AnsiString;
 119       w, h: Integer;
 120       anim: TAnimInfo;
 121     end;
 122
 123   procedure r_Textures_Initialize;
 124   procedure r_Textures_Finalize;
 125
 126   function r_Textures_LoadFromFile (const filename: AnsiString; log: Boolean = True): TGLTexture;
 127   function r_Textures_LoadMultiFromFile (const filename: AnsiString; log: Boolean = True): TGLMultiTexture;
 128   function r_Textures_LoadMultiFromFileAndInfo (const filename: AnsiString; w, h, count: Integer; log: Boolean = True): TGLMultiTexture;
 129   function r_Textures_LoadMultiTextFromFile (const filename: AnsiString; var txt: TAnimTextInfo; log: Boolean = True): TGLMultiTexture;
 130
 131   function r_Textures_LoadStreamFromFile (const filename: AnsiString; w, h, count, cw: Integer; st: TGLTextureArray; rs: TRectArray; log: Boolean = True): Boolean;
 132
 133   function r_Textures_LoadFontFromFile (const filename: AnsiString; constref f: TFontInfo; skipch: Integer; log: Boolean = true): TGLFont;
 134
 135 implementation
 136
 137   uses
 138     SysUtils, Classes,
 139     e_log, e_res, WADReader, Config,
 140     Imaging, ImagingTypes, ImagingUtility
 141   ;
 142
 143   var
 144     maxTileSize: Integer;
 145     atl: array of TGLAtlas;
 146
 147   (* --------- TGLAtlasNode --------- *)
 148
 149   constructor TGLAtlasNode.Create (base: TGLAtlas);
 150   begin
 151     ASSERT(base <> nil);
 152     inherited Create();
 153     self.mBase := base;
 154   end;
 155
 156   destructor TGLAtlasNode.Destroy;
 157   begin
 158     inherited;
 159   end;
 160
 161   function TGLAtlasNode.GetID (): GLuint;
 162   begin
 163     result := self.base.id
 164   end;
 165
 166   procedure r_Textures_UpdateNode (n: TGLAtlasNode; data: Pointer; x, y, w, h: Integer);
 167   begin
 168     ASSERT(n <> nil);
 169     // ASSERT(n.leaf);
 170     ASSERT(n.base <> nil);
 171     ASSERT(data <> nil);
 172     ASSERT(x >= 0);
 173     ASSERT(y >= 0);
 174     ASSERT(n.l + x + w - 1 <= n.r);
 175     ASSERT(n.t + y + h - 1 <= n.b);
 176     ASSERT(n.id > 0);
 177     glBindTexture(GL_TEXTURE_2D, n.id);
 178     glTexSubImage2D(GL_TEXTURE_2D, 0, n.l + x, n.t + y, w, h, GL_RGBA, GL_UNSIGNED_BYTE, data);
 179     glBindTexture(GL_TEXTURE_2D, 0);
 180   end;
 181
 182   (* --------- TGLAtlas --------- *)
 183
 184   constructor TGLAtlas.Create (ww, hh: Integer; id: GLuint);
 185   begin
 186     ASSERT(ww > 0);
 187     ASSERT(hh > 0);
 188     inherited Create(ww, hh);
 189     self.mID := id;
 190   end;
 191
 192   destructor TGLAtlas.Destroy;
 193   begin
 194     inherited;
 195   end;
 196
 197   function TGLAtlas.CreateNode (): TGLAtlasNode;
 198   begin
 199     result := TGLAtlasNode.Create(self);
 200   end;
 201
 202   function TGLAtlas.Alloc (ww, hh: Integer): TGLAtlasNode;
 203   begin
 204     result := TGLAtlasNode(inherited Alloc(ww, hh));
 205   end;
 206
 207   function r_Textures_AllocHWTexture (w, h: Integer): GLuint;
 208     var id: GLuint;
 209   begin
 210     glGenTextures(1, @id);
 211     if id <> 0 then
 212     begin
 213       glBindTexture(GL_TEXTURE_2D, id);
 214       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
 215       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
 216       glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
 217       glBindTexture(GL_TEXTURE_2D, 0);
 218     end;
 219     result := id
 220   end;
 221
 222   function r_Textures_AllocAtlas (): TGLAtlas;
 223     var i: Integer; id: GLuint;
 224   begin
 225     result := nil;
 226     id := r_Textures_AllocHWTexture(maxTileSize, maxTileSize);
 227     if id <> 0 then
 228     begin
 229       i := Length(atl);
 230       SetLength(atl, i + 1);
 231       atl[i] := TGLAtlas.Create(maxTileSize, maxTileSize, id);
 232       result := atl[i];
 233     end;
 234   end;
 235
 236   function r_Textures_AllocNode (w, h: Integer): TGLAtlasNode;
 237     var i: Integer; n: TGLAtlasNode; a: TGLAtlas;
 238   begin
 239     n := nil;
 240     if atl <> nil then
 241     begin
 242       i := High(atl);
 243       while (i >= 0) and (n = nil) do
 244       begin
 245         n := atl[i].Alloc(w, h);
 246         Dec(i);
 247       end;
 248     end;
 249     if n = nil then
 250     begin
 251       a := r_Textures_AllocAtlas();
 252       if a <> nil then
 253         n := a.Alloc(w, h);
 254     end;
 255     result := n
 256   end;
 257
 258   (* --------- TGLTexture --------- *)
 259
 260   destructor TGLTexture.Destroy;
 261     var i: Integer;
 262   begin
 263     if self.mTile <> nil then
 264     begin
 265       for i := 0 to High(self.mTile) do
 266       begin
 267         if self.mTile[i] <> nil then
 268         begin
 269           self.mTile[i].Dealloc;
 270           self.mTile[i] := nil;
 271         end;
 272       end;
 273       self.mTile := nil;
 274     end;
 275     inherited;
 276   end;
 277
 278   function TGLTexture.GetLines (): Integer;
 279   begin
 280     ASSERT(self.mTile <> nil);
 281     result := Length(self.mTile) div self.mCols
 282   end;
 283
 284   function TGLTexture.GetTile (col, line: Integer): TGLAtlasNode;
 285     var i: Integer;
 286   begin
 287     ASSERT(col >= 0);
 288     ASSERT(col <= mCols);
 289     ASSERT(self.mTile <> nil);
 290     i := line * mCols + col;
 291     ASSERT(i >= 0);
 292     ASSERT(i < Length(mTile));
 293     result := mTile[i];
 294     ASSERT(result <> nil)
 295   end;
 296
 297   function r_Textures_Alloc (w, h: Integer): TGLTexture;
 298     var x, y, mw, mh, cols, lines: Integer; t: TGLTexture;
 299   begin
 300     ASSERT(w > 0);
 301     ASSERT(h > 0);
 302     cols := (w + maxTileSize - 1) div maxTileSize;
 303     lines := (h + maxTileSize - 1) div maxTileSize;
 304     t := TGLTexture.Create;
 305     t.mWidth := w;
 306     t.mHeight := h;
 307     t.mCols := cols;
 308     // t.mLines := lines;
 309     SetLength(t.mTile, cols * lines);
 310     for y := 0 to lines - 1 do
 311     begin
 312       mh := Min(maxTileSize, h - y * maxTileSize);
 313       ASSERT(mh > 0);
 314       for x := 0 to cols - 1 do
 315       begin
 316         mw := Min(maxTileSize, w - x * maxTileSize);
 317         ASSERT(mw > 0);
 318         t.mTile[y * cols + x] := r_Textures_AllocNode(mw, mh);
 319       end
 320     end;
 321     result := t;
 322   end;
 323
 324   (* --------- TGLMultiTexture --------- *)
 325
 326   destructor TGLMultiTexture.Destroy;
 327     var i: Integer;
 328   begin
 329     for i := 0 to self.count - 1 do
 330       self.mTexture[i].Free;
 331     self.mTexture := nil;
 332     inherited;
 333   end;
 334
 335   function TGLMultiTexture.GetWidth (): Integer;
 336   begin
 337     result := self.mTexture[0].width
 338   end;
 339
 340   function TGLMultiTexture.GetHeight (): Integer;
 341   begin
 342     result := self.mTexture[0].height
 343   end;
 344
 345   function TGLMultiTexture.GetCount (): Integer;
 346   begin
 347     result := Length(self.mTexture)
 348   end;
 349
 350   function TGLMultiTexture.GetTexture (i: Integer): TGLTexture;
 351   begin
 352     ASSERT(i >= 0);
 353     ASSERT(i < self.count);
 354     result := self.mTexture[i];
 355     ASSERT(result <> nil);
 356   end;
 357
 358   (* --------- Init / Fin --------- *)
 359
 360   function r_Textures_GetMaxHardwareSize (): Integer;
 361     var size: GLint = 0;
 362   begin
 363     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @size);
 364     if size < 64 then size := 64;
 365     //if size > 512 then size := 512;
 366     //size := 64; // !!!
 367     result := size;
 368   end;
 369
 370   procedure r_Textures_Initialize;
 371   begin
 372     maxTileSize := r_Textures_GetMaxHardwareSize();
 373   end;
 374
 375   procedure r_Textures_Finalize;
 376     var i: Integer;
 377   begin
 378     if atl <> nil then
 379     begin
 380       for i := 0 to High(atl) do
 381       begin
 382         glDeleteTextures(1, @atl[i].id);
 383         atl[i].id := 0;
 384         atl[i].Free;
 385       end;
 386       atl := nil;
 387     end;
 388   end;
 389
 390   function r_Textures_FixImageData (var img: TImageData): Boolean;
 391   begin
 392     result := false;
 393     if ConvertImage(img, TImageFormat.ifA8R8G8B8) then
 394       if SwapChannels(img, ChannelRed, ChannelBlue) then // wtf
 395         result := true;
 396   end;
 397
 398   function r_Textures_LoadFromImage (var img: TImageData): TGLTexture;
 399     var t: TGLTexture; n: TGLAtlasNode; c: TDynImageDataArray; cw, ch, i, j: LongInt;
 400   begin
 401     result := nil;
 402     if SplitImage(img, c, maxTileSize, maxTileSize, cw, ch, False) then
 403     begin
 404       t := r_Textures_Alloc(img.width, img.height);
 405       if t <> nil then
 406       begin
 407         ASSERT(cw = t.cols);
 408         ASSERT(ch = t.lines);
 409         for j := 0 to ch - 1 do
 410         begin
 411           for i := 0 to cw - 1 do
 412           begin
 413             n := t.GetTile(i, j);
 414             if n <> nil then
 415               r_Textures_UpdateNode(n, c[j * cw + i].bits, 0, 0, n.width, n.height)
 416           end
 417         end;
 418         result := t
 419       end;
 420       FreeImagesInArray(c);
 421     end;
 422   end;
 423
 424   function r_Textures_LoadFromMemory (data: Pointer; size: LongInt): TGLTexture;
 425     var img: TImageData;
 426   begin
 427     result := nil;
 428     if (data <> nil) and (size > 0) then
 429     begin
 430       InitImage(img);
 431       try
 432         if LoadImageFromMemory(data, size, img) then
 433           if r_Textures_FixImageData(img) then
 434             result := r_Textures_LoadFromImage(img)
 435       except
 436       end;
 437       FreeImage(img);
 438     end;
 439   end;
 440
 441   function r_Textures_LoadFromFile (const filename: AnsiString; log: Boolean = True): TGLTexture;
 442     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 443   begin
 444     result := nil;
 445     wadName := g_ExtractWadName(filename);
 446     wad := TWADFile.Create();
 447     if wad.ReadFile(wadName) then
 448     begin
 449       resName := g_ExtractFilePathName(filename);
 450       if wad.GetResource(resName, data, size, log) then
 451       begin
 452         result := r_Textures_LoadFromMemory(data, size);
 453         FreeMem(data);
 454       end;
 455       wad.Free
 456     end
 457   end;
 458
 459   function r_Textures_LoadMultiFromImageAndInfo (var img: TImageData; w, h, c: Integer): TGLMultiTexture;
 460     var t: TImageData; a: array of TGLTexture; i: Integer; m: TGLMultiTexture;
 461   begin
 462     ASSERT(w >= 0);
 463     ASSERT(h >= 0);
 464     ASSERT(c >= 1);
 465     result := nil;
 466     SetLength(a, c);
 467     for i := 0 to c - 1 do
 468     begin
 469       InitImage(t);
 470       if NewImage(w, h, img.Format, t) then
 471         if CopyRect(img, w * i, 0, w, h, t, 0, 0) then
 472           a[i] := r_Textures_LoadFromImage(t);
 473       ASSERT(a[i] <> nil);
 474       FreeImage(t);
 475     end;
 476     m := TGLMultiTexture.Create();
 477     m.mTexture := a;
 478     ASSERT(m.mTexture <> nil);
 479     result := m;
 480   end;
 481
 482   function r_Textures_LoadMultiFromDataAndInfo (data: Pointer; size: LongInt; w, h, c: Integer): TGLMultiTexture;
 483     var img: TImageData;
 484   begin
 485     ASSERT(w > 0);
 486     ASSERT(h > 0);
 487     ASSERT(c >= 1);
 488     result := nil;
 489     if (data <> nil) and (size > 0) then
 490     begin
 491       InitImage(img);
 492       try
 493         if LoadImageFromMemory(data, size, img) then
 494           if r_Textures_FixImageData(img) then
 495             result := r_Textures_LoadMultiFromImageAndInfo(img, w, h, c)
 496       except
 497       end;
 498       FreeImage(img);
 499     end;
 500   end;
 501
 502   function r_Textures_LoadTextFromMemory (data: Pointer; size: LongInt; var txt: TAnimTextInfo): Boolean;
 503     var cfg: TConfig;
 504   begin
 505     result := false;
 506     if data <> nil then
 507     begin
 508       cfg := TConfig.CreateMem(data, size);
 509       if cfg <> nil then
 510       begin
 511         txt.name := cfg.ReadStr('', 'resource', '');
 512         txt.w := MAX(0, cfg.ReadInt('', 'framewidth', 0));
 513         txt.h := MAX(0, cfg.ReadInt('', 'frameheight', 0));
 514         txt.anim.loop := true;
 515         txt.anim.delay := MAX(0, cfg.ReadInt('', 'waitcount', 0));
 516         txt.anim.frames := MAX(0, cfg.ReadInt('', 'framecount', 0));
 517         txt.anim.back := cfg.ReadBool('', 'backanim', false);
 518         cfg.Free;
 519         result := (txt.name <> '') and (txt.w > 0) and (txt.h > 0) and (txt.anim.delay > 0) and (txt.anim.frames > 0);
 520       end;
 521     end;
 522   end;
 523
 524   function r_Textures_LoadMultiFromWad (wad: TWADFile; var txt: TAnimTextInfo): TGLMultiTexture;
 525     var data: Pointer; size: LongInt; img: TImageData;
 526   begin
 527     ASSERT(wad <> nil);
 528     result := nil;
 529     if wad.GetResource('TEXT/ANIM', data, size) then
 530     begin
 531       if r_Textures_LoadTextFromMemory(data, size, txt) then
 532       begin
 533         FreeMem(data);
 534         if wad.GetResource('TEXTURES/' + txt.name, data, size) then
 535         begin
 536           InitImage(img);
 537           try
 538             if LoadImageFromMemory(data, size, img) then
 539               if r_Textures_FixImageData(img) then
 540                 result := r_Textures_LoadMultiFromImageAndInfo(img, txt.w, txt.h, txt.anim.frames);
 541           finally
 542             FreeMem(data);
 543           end;
 544           FreeImage(img);
 545         end;
 546       end
 547       else
 548         FreeMem(data);
 549     end;
 550   end;
 551
 552   function r_Textures_LoadMultiFromMemory (data: Pointer; size: LongInt; var txt: TAnimTextInfo): TGLMultiTexture;
 553     var wad: TWADFile; t: TGLTexture; m: TGLMultiTexture;
 554   begin
 555     result := nil;
 556     if (data <> nil) and (size > 0) then
 557     begin
 558       t := r_Textures_LoadFromMemory(data, size);
 559       if t <> nil then
 560       begin
 561         m := TGLMultiTexture.Create();
 562         SetLength(m.mTexture, 1);
 563         m.mTexture[0] := t;
 564         txt.name := '';
 565         txt.w := m.width;
 566         txt.h := m.height;
 567         txt.anim.loop := true;
 568         txt.anim.delay := 1;
 569         txt.anim.frames := 1;
 570         txt.anim.back := false;
 571         result := m;
 572       end
 573       else if IsWadData(data, size) then
 574       begin
 575         wad := TWADFile.Create();
 576         if wad.ReadMemory(data, size) then
 577         begin
 578           result := r_Textures_LoadMultiFromWad(wad, txt);
 579           wad.Free;
 580         end
 581       end
 582     end
 583   end;
 584
 585   function r_Textures_LoadMultiTextFromFile (const filename: AnsiString; var txt: TAnimTextInfo; log: Boolean = True): TGLMultiTexture;
 586     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 587   begin
 588     result := nil;
 589     wadName := g_ExtractWadName(filename);
 590     wad := TWADFile.Create();
 591     if wad.ReadFile(wadName) then
 592     begin
 593       resName := g_ExtractFilePathName(filename);
 594       if wad.GetResource(resName, data, size, log) then
 595       begin
 596         result := r_Textures_LoadMultiFromMemory(data, size, txt);
 597         FreeMem(data);
 598       end;
 599       wad.Free
 600     end
 601   end;
 602
 603   function r_Textures_LoadMultiFromFile (const filename: AnsiString; log: Boolean = True): TGLMultiTexture;
 604     var txt: TAnimTextInfo;
 605   begin
 606     result := r_Textures_LoadMultiTextFromFile(filename, txt, log);
 607   end;
 608
 609   function r_Textures_LoadMultiFromFileAndInfo (const filename: AnsiString; w, h, count: Integer; log: Boolean = True): TGLMultiTexture;
 610     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 611   begin
 612     ASSERT(w > 0);
 613     ASSERT(h > 0);
 614     ASSERT(count >= 1);
 615     result := nil;
 616     wadName := g_ExtractWadName(filename);
 617     wad := TWADFile.Create();
 618     if wad.ReadFile(wadName) then
 619     begin
 620       resName := g_ExtractFilePathName(filename);
 621       if wad.GetResource(resName, data, size, log) then
 622       begin
 623         result := r_Textures_LoadMultiFromDataAndInfo(data, size, w, h, count);
 624         FreeMem(data);
 625       end;
 626       wad.Free
 627     end
 628   end;
 629
 630   function r_Textures_GetRect (var img: TImageData): TRectWH;
 631     var i, j, w, h: Integer; done: Boolean;
 632
 633     function IsVoid (i, j: Integer): Boolean; inline;
 634     begin
 635       result := GetPixel32(img, i, j).Channels[3] = 0
 636     end;
 637
 638   begin
 639     w := img.Width;
 640     h := img.Height;
 641
 642     (* trace x from right to left *)
 643     done := false; i := 0;
 644     while not done and (i < w) do
 645     begin
 646       j := 0;
 647       while (j < h) and IsVoid(i, j) do inc(j);
 648       done := (j < h) and (IsVoid(i, j) = false);
 649       result.x := i;
 650       inc(i);
 651     end;
 652
 653     (* trace y from up to down *)
 654     done := false; j := 0;
 655     while not done and (j < h) do
 656     begin
 657       i := 0;
 658       while (i < w) and IsVoid(i, j) do inc(i);
 659       done := (i < w) and (IsVoid(i, j) = false);
 660       result.y := j;
 661       inc(j);
 662     end;
 663
 664     (* trace x from right to left *)
 665     done := false; i := w - 1;
 666     while not done and (i >= 0) do
 667     begin
 668       j := 0;
 669       while (j < h) and IsVoid(i, j) do inc(j);
 670       done := (j < h) and (IsVoid(i, j) = false);
 671       result.width := i - result.x + 1;
 672       dec(i);
 673     end;
 674
 675     (* trace y from down to up *)
 676     done := false; j := h - 1;
 677     while not done and (j >= 0) do
 678     begin
 679       i := 0;
 680       while (i < w) and IsVoid(i, j) do inc(i);
 681       done := (i < w) and (IsVoid(i, j) = false);
 682       result.height := j - result.y + 1;
 683       dec(j);
 684     end;
 685   end;
 686
 687   function r_Textures_LoadStreamFromImage (var img: TImageData; w, h, c, cw: Integer; st: TGLTextureArray; rs: TRectArray): Boolean;
 688     var i, x, y: Integer; t: TImageData;
 689   begin
 690     ASSERT(w >= 0);
 691     ASSERT(h >= 0);
 692     ASSERT(c >= 1);
 693     ASSERT(cw >= 1);
 694     ASSERT((st <> nil) and (Length(st) >= c));
 695     ASSERT((rs = nil) or (Length(rs) >= c));
 696     result := true;
 697     for i := 0 to c - 1 do
 698     begin
 699       x := i mod cw;
 700       y := i div cw;
 701       InitImage(t);
 702       st[i] := nil;
 703       if NewImage(w, h, img.Format, t) then
 704       begin
 705         if CopyRect(img, x * w, y * h, w, h, t, 0, 0) then
 706         begin
 707           if rs <> nil then
 708             rs[i] := r_Textures_GetRect(t);
 709           st[i] := r_Textures_LoadFromImage(t);
 710         end;
 711       end;
 712       ASSERT(st[i] <> nil);
 713       FreeImage(t);
 714     end;
 715   end;
 716
 717   function r_Textures_LoadStreamFromMemory (data: Pointer; size: LongInt; w, h, c, cw: Integer; st: TGLTextureArray; rs: TRectArray): Boolean;
 718     var img: TImageData;
 719   begin
 720     ASSERT(w >= 0);
 721     ASSERT(h >= 0);
 722     ASSERT(c >= 1);
 723     ASSERT(cw >= 1);
 724     ASSERT((st <> nil) and (Length(st) >= c));
 725     ASSERT((rs = nil) or (Length(rs) >= c));
 726     result := false;
 727     if (data <> nil) and (size > 0) then
 728     begin
 729       InitImage(img);
 730       try
 731         if LoadImageFromMemory(data, size, img) then
 732         begin
 733           if r_Textures_FixImageData(img) then
 734           begin
 735             result := r_Textures_LoadStreamFromImage(img, w, h, c, cw, st, rs)
 736           end;
 737         end;
 738       except
 739       end;
 740       FreeImage(img);
 741     end;
 742   end;
 743
 744   function r_Textures_LoadStreamFromFile (const filename: AnsiString; w, h, count, cw: Integer; st: TGLTextureArray; rs: TRectArray; log: Boolean = True): Boolean;
 745     var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
 746   begin
 747     ASSERT(w > 0);
 748     ASSERT(h > 0);
 749     ASSERT(count >= 1);
 750     ASSERT(cw >= 1);
 751     ASSERT((st <> nil) and (Length(st) >= count));
 752     ASSERT((rs = nil) or (Length(rs) >= count));
 753     result := false;
 754     wadName := g_ExtractWadName(filename);
 755     wad := TWADFile.Create();
 756     if wad.ReadFile(wadName) then
 757     begin
 758       resName := g_ExtractFilePathName(filename);
 759       if wad.GetResource(resName, data, size, log) then
 760       begin
 761         result := r_Textures_LoadStreamFromMemory(data, size, w, h, count, cw, st, rs);
 762         FreeMem(data);
 763       end;
 764       wad.Free
 765     end;
 766   end;
 767
 768   (* --------- TGLFont --------- *)
 769
 770   function r_Textures_LoadFontFromFile (const filename: AnsiString; constref f: TFontInfo; skipch: Integer; log: Boolean = true): TGLFont;
 771     var i: Integer; st: TGLTextureArray; font: TGLFont; t: TGLTexture;
 772   begin
 773     ASSERT(skipch >= 0);
 774     result := nil;
 775     SetLength(st, 256);
 776     if r_Textures_LoadStreamFromFile(filename, f.w, f.h, 256, 16, st, nil, log) then
 777     begin
 778       if skipch > 0 then
 779       begin
 780         for i := 0 to 255 do
 781         begin
 782           t := st[i];
 783           st[i] := st[(i + skipch) mod 256];
 784           st[(i + skipch) mod 256] := t;
 785         end;
 786       end;
 787       font := TGLFont.Create();
 788       font.info := f;
 789       font.ch := st;
 790       result := font;
 791     end;
 792   end;
 793
 794   destructor TGLFont.Destroy;
 795     var i: Integer;
 796   begin
 797     if self.ch <> nil then
 798       for i := 0 to High(self.ch) do
 799         self.ch[i].Free;
 800     self.ch := nil;
 801   end;
 802
 803   function TGLFont.GetChar (c: AnsiChar): TGLTexture;
 804   begin
 805     result := self.ch[ORD(c)];
 806   end;
 807
 808   function TGLFont.GetWidth (c: AnsiChar): Integer;
 809   begin
 810     result := self.info.ch[c].w;
 811     if result = 0 then
 812       result := self.info.w;
 813     if self.info.kern < 0 then
 814       result := result + self.info.kern;
 815   end;
 816
 817   function TGLFont.GetMaxWidth (): Integer;
 818   begin
 819     result := self.info.w;
 820     if self.info.kern < 0 then
 821       result := result + self.info.kern;
 822   end;
 823
 824   function TGLFont.GetMaxHeight (): Integer;
 825   begin
 826     result := self.info.h;
 827   end;
 828
 829   function TGLFont.GetSpace (): Integer;
 830   begin
 831     result := self.info.kern;
 832   end;
 833
 834 end.