DEADSOFTWARE

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