DEADSOFTWARE

gl: implement load screen
[d2df-sdl.git] / 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;
18 interface
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 ;
31 type
32 TGLAtlas = class;
34 TGLAtlasNode = class (TAtlasNode)
35 private
36 mBase: TGLAtlas;
38 public
39 constructor Create (base: TGLAtlas);
40 destructor Destroy; override;
42 function GetID (): GLuint;
44 property base: TGLAtlas read mBase;
45 property id: GLuint read GetID;
46 end;
48 TGLAtlas = class (TAtlas)
49 private
50 mID: GLuint;
52 public
53 constructor Create (ww, hh: Integer; id: GLuint);
54 destructor Destroy; override;
56 function CreateNode (): TGLAtlasNode; override;
57 function Alloc (ww, hh: Integer): TGLAtlasNode; overload;
59 property id: GLuint read mID write mID default 0;
60 end;
62 TGLTexture = class
63 private
64 mWidth: Integer;
65 mHeight: Integer;
66 mCols: Integer;
67 mTile: array of TGLAtlasNode;
69 public
70 destructor Destroy; override;
72 function GetTile (col, line: Integer): TGLAtlasNode;
74 function GetLines (): Integer; inline;
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;
82 TGLMultiTexture = class
83 private
84 mTexture: array of TGLTexture;
86 public
87 destructor Destroy; override;
89 function GetWidth (): Integer; inline;
90 function GetHeight (): Integer; inline;
91 function GetCount (): Integer; inline;
92 function GetTexture (i: Integer): TGLTexture; {inline;}
94 property width: Integer read GetWidth;
95 property height: Integer read GetHeight;
96 property count: Integer read GetCount;
97 end;
99 TGLTextureArray = array of TGLTexture;
101 TRectArray = array of TRectWH;
103 TGLFont = class sealed (TFont)
104 private
105 info: TFontInfo;
106 ch: TGLTextureArray;
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;
117 TAnimTextInfo = record
118 name: AnsiString;
119 w, h: Integer;
120 anim: TAnimInfo;
121 end;
123 procedure r_Textures_Initialize;
124 procedure r_Textures_Finalize;
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;
131 function r_Textures_LoadStreamFromFile (const filename: AnsiString; w, h, count, cw: Integer; st: TGLTextureArray; rs: TRectArray; log: Boolean = True): Boolean;
133 function r_Textures_LoadFontFromFile (const filename: AnsiString; constref f: TFontInfo; skipch: Integer; log: Boolean = true): TGLFont;
135 implementation
137 uses
138 SysUtils, Classes,
139 e_log, e_res, WADReader, Config,
140 g_console, // cvar declaration
141 Imaging, ImagingTypes, ImagingUtility
144 var
145 r_GL_MaxTexSize: WORD;
146 maxTileSize: Integer;
147 atl: array of TGLAtlas;
149 (* --------- TGLAtlasNode --------- *)
151 constructor TGLAtlasNode.Create (base: TGLAtlas);
152 begin
153 ASSERT(base <> nil);
154 inherited Create();
155 self.mBase := base;
156 end;
158 destructor TGLAtlasNode.Destroy;
159 begin
160 inherited;
161 end;
163 function TGLAtlasNode.GetID (): GLuint;
164 begin
165 result := self.base.id
166 end;
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;
184 (* --------- TGLAtlas --------- *)
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;
194 destructor TGLAtlas.Destroy;
195 begin
196 inherited;
197 end;
199 function TGLAtlas.CreateNode (): TGLAtlasNode;
200 begin
201 result := TGLAtlasNode.Create(self);
202 end;
204 function TGLAtlas.Alloc (ww, hh: Integer): TGLAtlasNode;
205 begin
206 result := TGLAtlasNode(inherited Alloc(ww, hh));
207 end;
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;
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;
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;
260 (* --------- TGLTexture --------- *)
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;
280 function TGLTexture.GetLines (): Integer;
281 begin
282 ASSERT(self.mTile <> nil);
283 result := Length(self.mTile) div self.mCols
284 end;
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;
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;
326 (* --------- TGLMultiTexture --------- *)
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;
337 function TGLMultiTexture.GetWidth (): Integer;
338 begin
339 result := self.mTexture[0].width
340 end;
342 function TGLMultiTexture.GetHeight (): Integer;
343 begin
344 result := self.mTexture[0].height
345 end;
347 function TGLMultiTexture.GetCount (): Integer;
348 begin
349 result := Length(self.mTexture)
350 end;
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;
360 (* --------- Init / Fin --------- *)
362 function IsPOT (v: LongWord): Boolean;
363 begin
364 result := (v <> 0) and ((v and (v - 1)) = 0)
365 end;
367 function NextPOT (v: LongWord): LongWord;
368 begin
369 DEC(v);
370 v := v or (v >> 1);
371 v := v or (v >> 2);
372 v := v or (v >> 4);
373 v := v or (v >> 8);
374 v := v or (v >> 16);
375 INC(v);
376 result := v;
377 end;
379 function r_Textures_GetMaxHardwareSize (): Integer;
380 var size: GLint = 0;
381 begin
382 if r_GL_MaxTexSize <= 0 then
383 begin
384 // auto, max possible reccomended by driver
385 glGetIntegerv(GL_MAX_TEXTURE_SIZE, @size);
386 if size < 1 then size := 64;
387 end
388 else
389 begin
390 // selected by user
391 if IsPOT(r_GL_MaxTexSize) then
392 size := r_GL_MaxTexSize
393 else
394 size := NextPOT(r_GL_MaxTexSize);
395 end;
396 result := size;
397 end;
399 procedure r_Textures_Initialize;
400 begin
401 maxTileSize := r_Textures_GetMaxHardwareSize();
402 e_LogWritefln('TEXTURE SIZE: %s', [maxTileSize]);
403 end;
405 procedure r_Textures_Finalize;
406 var i: Integer;
407 begin
408 if atl <> nil then
409 begin
410 for i := 0 to High(atl) do
411 begin
412 glDeleteTextures(1, @atl[i].id);
413 atl[i].id := 0;
414 atl[i].Free;
415 end;
416 atl := nil;
417 end;
418 end;
420 function r_Textures_FixImageData (var img: TImageData): Boolean;
421 begin
422 result := false;
423 if ConvertImage(img, TImageFormat.ifA8R8G8B8) then
424 if SwapChannels(img, ChannelRed, ChannelBlue) then // wtf
425 result := true;
426 end;
428 function r_Textures_LoadFromImage (var img: TImageData): TGLTexture;
429 var t: TGLTexture; n: TGLAtlasNode; c: TDynImageDataArray; cw, ch, i, j: LongInt;
430 begin
431 result := nil;
432 if SplitImage(img, c, maxTileSize, maxTileSize, cw, ch, False) then
433 begin
434 t := r_Textures_Alloc(img.width, img.height);
435 if t <> nil then
436 begin
437 ASSERT(cw = t.cols);
438 ASSERT(ch = t.lines);
439 for j := 0 to ch - 1 do
440 begin
441 for i := 0 to cw - 1 do
442 begin
443 n := t.GetTile(i, j);
444 if n <> nil then
445 r_Textures_UpdateNode(n, c[j * cw + i].bits, 0, 0, n.width, n.height)
446 end
447 end;
448 result := t
449 end;
450 FreeImagesInArray(c);
451 end;
452 end;
454 function r_Textures_LoadFromMemory (data: Pointer; size: LongInt): TGLTexture;
455 var img: TImageData;
456 begin
457 result := nil;
458 if (data <> nil) and (size > 0) then
459 begin
460 InitImage(img);
461 try
462 if LoadImageFromMemory(data, size, img) then
463 if r_Textures_FixImageData(img) then
464 result := r_Textures_LoadFromImage(img)
465 except
466 end;
467 FreeImage(img);
468 end;
469 end;
471 function r_Textures_LoadFromFile (const filename: AnsiString; log: Boolean = True): TGLTexture;
472 var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
473 begin
474 result := nil;
475 wadName := g_ExtractWadName(filename);
476 wad := TWADFile.Create();
477 if wad.ReadFile(wadName) then
478 begin
479 resName := g_ExtractFilePathName(filename);
480 if wad.GetResource(resName, data, size, log) then
481 begin
482 result := r_Textures_LoadFromMemory(data, size);
483 FreeMem(data);
484 end;
485 wad.Free
486 end
487 end;
489 function r_Textures_LoadMultiFromImageAndInfo (var img: TImageData; w, h, c: Integer): TGLMultiTexture;
490 var t: TImageData; a: array of TGLTexture; i: Integer; m: TGLMultiTexture;
491 begin
492 ASSERT(w >= 0);
493 ASSERT(h >= 0);
494 ASSERT(c >= 1);
495 result := nil;
496 SetLength(a, c);
497 for i := 0 to c - 1 do
498 begin
499 InitImage(t);
500 if NewImage(w, h, img.Format, t) then
501 if CopyRect(img, w * i, 0, w, h, t, 0, 0) then
502 a[i] := r_Textures_LoadFromImage(t);
503 ASSERT(a[i] <> nil);
504 FreeImage(t);
505 end;
506 m := TGLMultiTexture.Create();
507 m.mTexture := a;
508 ASSERT(m.mTexture <> nil);
509 result := m;
510 end;
512 function r_Textures_LoadMultiFromDataAndInfo (data: Pointer; size: LongInt; w, h, c: Integer): TGLMultiTexture;
513 var img: TImageData;
514 begin
515 ASSERT(w > 0);
516 ASSERT(h > 0);
517 ASSERT(c >= 1);
518 result := nil;
519 if (data <> nil) and (size > 0) then
520 begin
521 InitImage(img);
522 try
523 if LoadImageFromMemory(data, size, img) then
524 if r_Textures_FixImageData(img) then
525 result := r_Textures_LoadMultiFromImageAndInfo(img, w, h, c)
526 except
527 end;
528 FreeImage(img);
529 end;
530 end;
532 function r_Textures_LoadTextFromMemory (data: Pointer; size: LongInt; var txt: TAnimTextInfo): Boolean;
533 var cfg: TConfig;
534 begin
535 result := false;
536 if data <> nil then
537 begin
538 cfg := TConfig.CreateMem(data, size);
539 if cfg <> nil then
540 begin
541 txt.name := cfg.ReadStr('', 'resource', '');
542 txt.w := MAX(0, cfg.ReadInt('', 'framewidth', 0));
543 txt.h := MAX(0, cfg.ReadInt('', 'frameheight', 0));
544 txt.anim.loop := true;
545 txt.anim.delay := MAX(0, cfg.ReadInt('', 'waitcount', 0));
546 txt.anim.frames := MAX(0, cfg.ReadInt('', 'framecount', 0));
547 txt.anim.back := cfg.ReadBool('', 'backanim', false);
548 cfg.Free;
549 result := (txt.name <> '') and (txt.w > 0) and (txt.h > 0) and (txt.anim.delay > 0) and (txt.anim.frames > 0);
550 end;
551 end;
552 end;
554 function r_Textures_LoadMultiFromWad (wad: TWADFile; var txt: TAnimTextInfo): TGLMultiTexture;
555 var data: Pointer; size: LongInt; img: TImageData;
556 begin
557 ASSERT(wad <> nil);
558 result := nil;
559 if wad.GetResource('TEXT/ANIM', data, size) then
560 begin
561 if r_Textures_LoadTextFromMemory(data, size, txt) then
562 begin
563 FreeMem(data);
564 if wad.GetResource('TEXTURES/' + txt.name, data, size) then
565 begin
566 InitImage(img);
567 try
568 if LoadImageFromMemory(data, size, img) then
569 if r_Textures_FixImageData(img) then
570 result := r_Textures_LoadMultiFromImageAndInfo(img, txt.w, txt.h, txt.anim.frames);
571 finally
572 FreeMem(data);
573 end;
574 FreeImage(img);
575 end;
576 end
577 else
578 FreeMem(data);
579 end;
580 end;
582 function r_Textures_LoadMultiFromMemory (data: Pointer; size: LongInt; var txt: TAnimTextInfo): TGLMultiTexture;
583 var wad: TWADFile; t: TGLTexture; m: TGLMultiTexture;
584 begin
585 result := nil;
586 if (data <> nil) and (size > 0) then
587 begin
588 t := r_Textures_LoadFromMemory(data, size);
589 if t <> nil then
590 begin
591 m := TGLMultiTexture.Create();
592 SetLength(m.mTexture, 1);
593 m.mTexture[0] := t;
594 txt.name := '';
595 txt.w := m.width;
596 txt.h := m.height;
597 txt.anim.loop := true;
598 txt.anim.delay := 1;
599 txt.anim.frames := 1;
600 txt.anim.back := false;
601 result := m;
602 end
603 else if IsWadData(data, size) then
604 begin
605 wad := TWADFile.Create();
606 if wad.ReadMemory(data, size) then
607 begin
608 result := r_Textures_LoadMultiFromWad(wad, txt);
609 wad.Free;
610 end
611 end
612 end
613 end;
615 function r_Textures_LoadMultiTextFromFile (const filename: AnsiString; var txt: TAnimTextInfo; log: Boolean = True): TGLMultiTexture;
616 var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
617 begin
618 result := nil;
619 wadName := g_ExtractWadName(filename);
620 wad := TWADFile.Create();
621 if wad.ReadFile(wadName) then
622 begin
623 resName := g_ExtractFilePathName(filename);
624 if wad.GetResource(resName, data, size, log) then
625 begin
626 result := r_Textures_LoadMultiFromMemory(data, size, txt);
627 FreeMem(data);
628 end;
629 wad.Free
630 end
631 end;
633 function r_Textures_LoadMultiFromFile (const filename: AnsiString; log: Boolean = True): TGLMultiTexture;
634 var txt: TAnimTextInfo;
635 begin
636 result := r_Textures_LoadMultiTextFromFile(filename, txt, log);
637 end;
639 function r_Textures_LoadMultiFromFileAndInfo (const filename: AnsiString; w, h, count: Integer; log: Boolean = True): TGLMultiTexture;
640 var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
641 begin
642 ASSERT(w > 0);
643 ASSERT(h > 0);
644 ASSERT(count >= 1);
645 result := nil;
646 wadName := g_ExtractWadName(filename);
647 wad := TWADFile.Create();
648 if wad.ReadFile(wadName) then
649 begin
650 resName := g_ExtractFilePathName(filename);
651 if wad.GetResource(resName, data, size, log) then
652 begin
653 result := r_Textures_LoadMultiFromDataAndInfo(data, size, w, h, count);
654 FreeMem(data);
655 end;
656 wad.Free
657 end
658 end;
660 function r_Textures_GetRect (var img: TImageData): TRectWH;
661 var i, j, w, h: Integer; done: Boolean;
663 function IsVoid (i, j: Integer): Boolean; inline;
664 begin
665 result := GetPixel32(img, i, j).Channels[3] = 0
666 end;
668 begin
669 w := img.Width;
670 h := img.Height;
672 (* trace x from right to left *)
673 done := false; i := 0;
674 while not done and (i < w) do
675 begin
676 j := 0;
677 while (j < h) and IsVoid(i, j) do inc(j);
678 done := (j < h) and (IsVoid(i, j) = false);
679 result.x := i;
680 inc(i);
681 end;
683 (* trace y from up to down *)
684 done := false; j := 0;
685 while not done and (j < h) do
686 begin
687 i := 0;
688 while (i < w) and IsVoid(i, j) do inc(i);
689 done := (i < w) and (IsVoid(i, j) = false);
690 result.y := j;
691 inc(j);
692 end;
694 (* trace x from right to left *)
695 done := false; i := w - 1;
696 while not done and (i >= 0) do
697 begin
698 j := 0;
699 while (j < h) and IsVoid(i, j) do inc(j);
700 done := (j < h) and (IsVoid(i, j) = false);
701 result.width := i - result.x + 1;
702 dec(i);
703 end;
705 (* trace y from down to up *)
706 done := false; j := h - 1;
707 while not done and (j >= 0) do
708 begin
709 i := 0;
710 while (i < w) and IsVoid(i, j) do inc(i);
711 done := (i < w) and (IsVoid(i, j) = false);
712 result.height := j - result.y + 1;
713 dec(j);
714 end;
715 end;
717 function r_Textures_LoadStreamFromImage (var img: TImageData; w, h, c, cw: Integer; st: TGLTextureArray; rs: TRectArray): Boolean;
718 var i, x, y: Integer; t: 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 := true;
727 for i := 0 to c - 1 do
728 begin
729 x := i mod cw;
730 y := i div cw;
731 InitImage(t);
732 st[i] := nil;
733 if NewImage(w, h, img.Format, t) then
734 begin
735 if CopyRect(img, x * w, y * h, w, h, t, 0, 0) then
736 begin
737 if rs <> nil then
738 rs[i] := r_Textures_GetRect(t);
739 st[i] := r_Textures_LoadFromImage(t);
740 end;
741 end;
742 ASSERT(st[i] <> nil);
743 FreeImage(t);
744 end;
745 end;
747 function r_Textures_LoadStreamFromMemory (data: Pointer; size: LongInt; w, h, c, cw: Integer; st: TGLTextureArray; rs: TRectArray): Boolean;
748 var img: TImageData;
749 begin
750 ASSERT(w >= 0);
751 ASSERT(h >= 0);
752 ASSERT(c >= 1);
753 ASSERT(cw >= 1);
754 ASSERT((st <> nil) and (Length(st) >= c));
755 ASSERT((rs = nil) or (Length(rs) >= c));
756 result := false;
757 if (data <> nil) and (size > 0) then
758 begin
759 InitImage(img);
760 try
761 if LoadImageFromMemory(data, size, img) then
762 begin
763 if r_Textures_FixImageData(img) then
764 begin
765 result := r_Textures_LoadStreamFromImage(img, w, h, c, cw, st, rs)
766 end;
767 end;
768 except
769 end;
770 FreeImage(img);
771 end;
772 end;
774 function r_Textures_LoadStreamFromFile (const filename: AnsiString; w, h, count, cw: Integer; st: TGLTextureArray; rs: TRectArray; log: Boolean = True): Boolean;
775 var wad: TWADFile; wadName, resName: AnsiString; data: Pointer; size: Integer;
776 begin
777 ASSERT(w > 0);
778 ASSERT(h > 0);
779 ASSERT(count >= 1);
780 ASSERT(cw >= 1);
781 ASSERT((st <> nil) and (Length(st) >= count));
782 ASSERT((rs = nil) or (Length(rs) >= count));
783 result := false;
784 wadName := g_ExtractWadName(filename);
785 wad := TWADFile.Create();
786 if wad.ReadFile(wadName) then
787 begin
788 resName := g_ExtractFilePathName(filename);
789 if wad.GetResource(resName, data, size, log) then
790 begin
791 result := r_Textures_LoadStreamFromMemory(data, size, w, h, count, cw, st, rs);
792 FreeMem(data);
793 end;
794 wad.Free
795 end;
796 end;
798 (* --------- TGLFont --------- *)
800 function r_Textures_LoadFontFromFile (const filename: AnsiString; constref f: TFontInfo; skipch: Integer; log: Boolean = true): TGLFont;
801 var i: Integer; st: TGLTextureArray; font: TGLFont; t: TGLTexture;
802 begin
803 ASSERT(skipch >= 0);
804 result := nil;
805 SetLength(st, 256);
806 if r_Textures_LoadStreamFromFile(filename, f.w, f.h, 256, 16, st, nil, log) then
807 begin
808 if skipch > 0 then
809 begin
810 for i := 0 to 255 do
811 begin
812 t := st[i];
813 st[i] := st[(i + skipch) mod 256];
814 st[(i + skipch) mod 256] := t;
815 end;
816 end;
817 font := TGLFont.Create();
818 font.info := f;
819 font.ch := st;
820 result := font;
821 end;
822 end;
824 destructor TGLFont.Destroy;
825 var i: Integer;
826 begin
827 if self.ch <> nil then
828 for i := 0 to High(self.ch) do
829 self.ch[i].Free;
830 self.ch := nil;
831 end;
833 function TGLFont.GetChar (c: AnsiChar): TGLTexture;
834 begin
835 result := self.ch[ORD(c)];
836 end;
838 function TGLFont.GetWidth (c: AnsiChar): Integer;
839 begin
840 result := self.info.ch[c].w;
841 if result = 0 then
842 result := self.info.w;
843 if self.info.kern < 0 then
844 result := result + self.info.kern;
845 end;
847 function TGLFont.GetMaxWidth (): Integer;
848 begin
849 result := self.info.w;
850 if self.info.kern < 0 then
851 result := result + self.info.kern;
852 end;
854 function TGLFont.GetMaxHeight (): Integer;
855 begin
856 result := self.info.h;
857 end;
859 function TGLFont.GetSpace (): Integer;
860 begin
861 result := self.info.kern;
862 end;
864 initialization
865 conRegVar('r_gl_maxtexsize', @r_GL_MaxTexSize, '', '');
866 r_GL_MaxTexSize := 0; // default is automatic value
867 end.