DEADSOFTWARE

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