1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
15 {$INCLUDE ../../../shared/a_modes.inc}
33 TGLAtlasNode
= class (TAtlasNode
)
38 constructor Create (base
: TGLAtlas
);
39 destructor Destroy
; override;
41 function GetID (): GLuint
;
43 property base
: TGLAtlas read mBase
;
44 property id
: GLuint read GetID
;
47 TGLAtlas
= class (TAtlas
)
52 constructor Create (ww
, hh
: Integer; id
: GLuint
);
53 destructor Destroy
; override;
55 function CreateNode (): TGLAtlasNode
; override;
56 function Alloc (ww
, hh
: Integer): TGLAtlasNode
; overload
;
58 property id
: GLuint read mID write mID default
0;
66 mTile
: array of TGLAtlasNode
;
69 destructor Destroy
; override;
71 function GetTile (col
, line
: Integer): TGLAtlasNode
;
73 function GetLines (): Integer; inline;
75 property width
: Integer read mWidth
;
76 property height
: Integer read mHeight
;
77 property cols
: Integer read mCols
;
78 property lines
: Integer read GetLines
;
81 TGLMultiTexture
= class
83 mTexture
: array of TGLTexture
;
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 property backAnim
: Boolean read mBackanim
; (* this property must be located at TAnimState? *)
100 procedure r_Textures_Initialize
;
101 procedure r_Textures_Finalize
;
103 function r_Textures_LoadFromFile (const filename
: AnsiString; log
: Boolean = True): TGLTexture
;
104 function r_Textures_LoadMultiFromFile (const filename
: AnsiString; log
: Boolean = True): TGLMultiTexture
;
105 function r_Textures_LoadMultiFromFileAndInfo (const filename
: AnsiString; w
, h
, count
: Integer; backanim
: Boolean; log
: Boolean = True): TGLMultiTexture
;
111 e_log
, e_res
, WADReader
, Config
,
112 Imaging
, ImagingTypes
, ImagingUtility
116 maxTileSize
: Integer;
117 atl
: array of TGLAtlas
;
118 // tex: array of TGLTexture;
120 (* --------- TGLAtlasNode --------- *)
122 constructor TGLAtlasNode
.Create (base
: TGLAtlas
);
129 destructor TGLAtlasNode
.Destroy
;
134 function TGLAtlasNode
.GetID (): GLuint
;
136 result
:= self
.base
.id
139 procedure r_Textures_UpdateNode (n
: TGLAtlasNode
; data
: Pointer; x
, y
, w
, h
: Integer);
143 ASSERT(n
.base
<> nil);
147 ASSERT(n
.l
+ x
+ w
- 1 <= n
.r
);
148 ASSERT(n
.t
+ y
+ h
- 1 <= n
.b
);
150 glBindTexture(GL_TEXTURE_2D
, n
.id
);
151 glTexSubImage2D(GL_TEXTURE_2D
, 0, n
.l
+ x
, n
.t
+ y
, w
, h
, GL_RGBA
, GL_UNSIGNED_BYTE
, data
);
152 glBindTexture(GL_TEXTURE_2D
, 0);
155 (* --------- TGLAtlas --------- *)
157 constructor TGLAtlas
.Create (ww
, hh
: Integer; id
: GLuint
);
161 inherited Create(ww
, hh
);
165 destructor TGLAtlas
.Destroy
;
170 function TGLAtlas
.CreateNode (): TGLAtlasNode
;
172 result
:= TGLAtlasNode
.Create(self
);
175 function TGLAtlas
.Alloc (ww
, hh
: Integer): TGLAtlasNode
;
177 result
:= TGLAtlasNode(inherited Alloc(ww
, hh
));
180 function r_Textures_AllocHWTexture (w
, h
: Integer): GLuint
;
183 glGenTextures(1, @id
);
186 glBindTexture(GL_TEXTURE_2D
, id
);
187 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, GL_NEAREST
);
188 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, GL_NEAREST
);
189 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGBA
, w
, h
, 0, GL_RGBA
, GL_UNSIGNED_BYTE
, nil);
190 glBindTexture(GL_TEXTURE_2D
, 0);
195 function r_Textures_AllocAtlas (): TGLAtlas
;
196 var i
: Integer; id
: GLuint
;
199 id
:= r_Textures_AllocHWTexture(maxTileSize
, maxTileSize
);
203 SetLength(atl
, i
+ 1);
204 atl
[i
] := TGLAtlas
.Create(maxTileSize
, maxTileSize
, id
);
209 function r_Textures_AllocNode (w
, h
: Integer): TGLAtlasNode
;
210 var i
: Integer; n
: TGLAtlasNode
; a
: TGLAtlas
;
216 while (i
>= 0) and (n
= nil) do
218 n
:= atl
[i
].Alloc(w
, h
);
224 a
:= r_Textures_AllocAtlas();
231 (* --------- TGLTexture --------- *)
233 destructor TGLTexture
.Destroy
;
236 if self
.mTile
<> nil then
238 for i
:= 0 to High(self
.mTile
) do
240 if self
.mTile
[i
] <> nil then
242 self
.mTile
[i
].Dealloc
;
243 self
.mTile
[i
] := nil;
251 function TGLTexture
.GetLines (): Integer;
253 ASSERT(self
.mTile
<> nil);
254 result
:= Length(self
.mTile
) div self
.mCols
257 function TGLTexture
.GetTile (col
, line
: Integer): TGLAtlasNode
;
261 ASSERT(col
<= mCols
);
262 ASSERT(self
.mTile
<> nil);
263 i
:= line
* mCols
+ col
;
265 ASSERT(i
< Length(mTile
));
267 ASSERT(result
<> nil)
270 function r_Textures_Alloc (w
, h
: Integer): TGLTexture
;
271 var x
, y
, mw
, mh
, cols
, lines
: Integer; t
: TGLTexture
;
275 cols
:= (w
+ maxTileSize
- 1) div maxTileSize
;
276 lines
:= (h
+ maxTileSize
- 1) div maxTileSize
;
277 t
:= TGLTexture
.Create
;
281 // t.mLines := lines;
282 SetLength(t
.mTile
, cols
* lines
);
283 for y
:= 0 to lines
- 1 do
285 mh
:= Min(maxTileSize
, h
- y
* maxTileSize
);
287 for x
:= 0 to cols
- 1 do
289 mw
:= Min(maxTileSize
, w
- x
* maxTileSize
);
291 t
.mTile
[y
* cols
+ x
] := r_Textures_AllocNode(mw
, mh
);
297 (* --------- TGLMultiTexture --------- *)
299 destructor TGLMultiTexture
.Destroy
;
302 for i
:= 0 to self
.count
- 1 do
303 self
.mTexture
[i
].Free
;
304 self
.mTexture
:= nil;
308 function TGLMultiTexture
.GetWidth (): Integer;
310 result
:= self
.mTexture
[0].width
313 function TGLMultiTexture
.GetHeight (): Integer;
315 result
:= self
.mTexture
[0].height
318 function TGLMultiTexture
.GetCount (): Integer;
320 result
:= Length(self
.mTexture
)
323 function TGLMultiTexture
.GetTexture (i
: Integer): TGLTexture
;
326 ASSERT(i
< self
.count
);
327 result
:= self
.mTexture
[i
];
328 ASSERT(result
<> nil);
331 (* --------- Init / Fin --------- *)
333 function r_Textures_GetMaxHardwareSize (): Integer;
336 glGetIntegerv(GL_MAX_TEXTURE_SIZE
, @size
);
337 if size
< 64 then size
:= 64;
338 //if size > 512 then size := 512;
343 procedure r_Textures_Initialize
;
345 maxTileSize
:= r_Textures_GetMaxHardwareSize();
348 procedure r_Textures_Finalize
;
353 for i
:= 0 to High(atl
) do
355 glDeleteTextures(1, @atl
[i
].id
);
363 function r_Textures_LoadFromImage (var img
: TImageData
): TGLTexture
;
364 var t
: TGLTexture
; n
: TGLAtlasNode
; c
: TDynImageDataArray
; cw
, ch
, i
, j
: LongInt;
366 // e_logwritefln('r_Textures_CreateFromImage: w=%s h=%s', [img.width, img.height]);
368 if SplitImage(img
, c
, maxTileSize
, maxTileSize
, cw
, ch
, False) then
370 t
:= r_Textures_Alloc(img
.width
, img
.height
);
374 ASSERT(ch
= t
.lines
);
375 for j
:= 0 to ch
- 1 do
377 for i
:= 0 to cw
- 1 do
379 n
:= t
.GetTile(i
, j
);
381 r_Textures_UpdateNode(n
, c
[j
* cw
+ i
].bits
, 0, 0, n
.width
, n
.height
)
386 FreeImagesInArray(c
);
390 function r_Textures_LoadFromMemory (data
: Pointer; size
: LongInt): TGLTexture
;
394 if (data
<> nil) and (size
> 0) then
398 if LoadImageFromMemory(data
, size
, img
) then
399 if ConvertImage(img
, TImageFormat
.ifA8R8G8B8
) then
400 if SwapChannels(img
, ChannelRed
, ChannelBlue
) then // wth
401 result
:= r_Textures_LoadFromImage(img
)
408 function r_Textures_LoadFromFile (const filename
: AnsiString; log
: Boolean = True): TGLTexture
;
409 var wad
: TWADFile
; wadName
, resName
: AnsiString; data
: Pointer; size
: Integer;
412 wadName
:= g_ExtractWadName(filename
);
413 wad
:= TWADFile
.Create();
414 if wad
.ReadFile(wadName
) then
416 resName
:= g_ExtractFilePathName(filename
);
417 if wad
.GetResource(resName
, data
, size
, log
) then
419 result
:= r_Textures_LoadFromMemory(data
, size
);
426 function r_Textures_LoadMultiFromImageAndInfo (var img
: TImageData
; w
, h
, c
: Integer; b
: Boolean): TGLMultiTexture
;
427 var t
: TImageData
; a
: array of TGLTexture
; i
: Integer; m
: TGLMultiTexture
;
434 for i
:= 0 to c
- 1 do
437 if NewImage(w
, h
, img
.Format
, t
) then
438 if CopyRect(img
, w
* i
, 0, w
, h
, t
, 0, 0) then
439 a
[i
] := r_Textures_LoadFromImage(t
);
443 m
:= TGLMultiTexture
.Create();
446 ASSERT(m
.mTexture
<> nil);
450 function r_Textures_LoadMultiFromDataAndInfo (data
: Pointer; size
: LongInt; w
, h
, c
: Integer; b
: Boolean): TGLMultiTexture
;
457 if (data
<> nil) and (size
> 0) then
461 if LoadImageFromMemory(data
, size
, img
) then
462 if ConvertImage(img
, TImageFormat
.ifA8R8G8B8
) then
463 if SwapChannels(img
, ChannelRed
, ChannelBlue
) then // wtf
464 result
:= r_Textures_LoadMultiFromImageAndInfo(img
, w
, h
, c
, b
)
471 function r_Textures_LoadMultiFromWad (wad
: TWADFile
): TGLMultiTexture
;
472 var data
: Pointer; size
: LongInt; TexRes
: AnsiString; w
, h
, c
: Integer; b
: Boolean; cfg
: TConfig
; img
: TImageData
;
476 if wad
.GetResource('TEXT/ANIM', data
, size
) then
478 cfg
:= TConfig
.CreateMem(data
, size
);
482 TexRes
:= cfg
.ReadStr('', 'resource', '');
483 w
:= cfg
.ReadInt('', 'framewidth', 0);
484 h
:= cfg
.ReadInt('', 'frameheight', 0);
485 c
:= cfg
.ReadInt('', 'framecount', 0);
486 b
:= cfg
.ReadBool('', 'backanim', false);
487 if (TexRes
<> '') and (w
> 0) and (h
> 0) and (c
> 0) then
489 if wad
.GetResource('TEXTURES/' + TexRes
, data
, size
) then
493 if LoadImageFromMemory(data
, size
, img
) then
494 if ConvertImage(img
, TImageFormat
.ifA8R8G8B8
) then
495 if SwapChannels(img
, ChannelRed
, ChannelBlue
) then // wtf
496 result
:= r_Textures_LoadMultiFromImageAndInfo(img
, w
, h
, c
, b
)
508 function r_Textures_LoadMultiFromMemory (data
: Pointer; size
: LongInt): TGLMultiTexture
;
509 var wad
: TWADFile
; t
: TGLTexture
; m
: TGLMultiTexture
;
512 if (data
<> nil) and (size
> 0) then
514 t
:= r_Textures_LoadFromMemory(data
, size
);
517 m
:= TGLMultiTexture
.Create();
518 SetLength(m
.mTexture
, 1);
520 m
.mBackanim
:= false;
523 else if IsWadData(data
, size
) then
525 wad
:= TWADFile
.Create();
526 if wad
.ReadMemory(data
, size
) then
528 result
:= r_Textures_LoadMultiFromWad(wad
);
535 function r_Textures_LoadMultiFromFile (const filename
: AnsiString; log
: Boolean = True): TGLMultiTexture
;
536 var wad
: TWADFile
; wadName
, resName
: AnsiString; data
: Pointer; size
: Integer; t
: TGLTexture
;
539 wadName
:= g_ExtractWadName(filename
);
540 wad
:= TWADFile
.Create();
541 if wad
.ReadFile(wadName
) then
543 resName
:= g_ExtractFilePathName(filename
);
544 if wad
.GetResource(resName
, data
, size
, log
) then
546 result
:= r_Textures_LoadMultiFromMemory(data
, size
);
553 function r_Textures_LoadMultiFromFileAndInfo (const filename
: AnsiString; w
, h
, count
: Integer; backanim
: Boolean; log
: Boolean = True): TGLMultiTexture
;
554 var wad
: TWADFile
; wadName
, resName
: AnsiString; data
: Pointer; size
: Integer;
560 wadName
:= g_ExtractWadName(filename
);
561 wad
:= TWADFile
.Create();
562 if wad
.ReadFile(wadName
) then
564 resName
:= g_ExtractFilePathName(filename
);
565 if wad
.GetResource(resName
, data
, size
, log
) then
567 result
:= r_Textures_LoadMultiFromDataAndInfo(data
, size
, w
, h
, count
, backanim
);