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