Ykkrosh
ed38414b41
Textures: converted ARGB to ABGR. Misc: warning fixes, etc. This was SVN commit r3631.
133 lines
2.8 KiB
Perl
133 lines
2.8 KiB
Perl
use strict;
|
|
use warnings;
|
|
|
|
package DDS;
|
|
|
|
sub new
|
|
{
|
|
my $proto = shift;
|
|
my $class = ref($proto) || $proto;
|
|
|
|
my $fh;
|
|
if (ref $_[0])
|
|
{
|
|
$fh = $_[0];
|
|
}
|
|
else
|
|
{
|
|
open $fh, '<', $_[0] or die "Cannot open $_[0]";
|
|
binmode $fh;
|
|
}
|
|
|
|
my %dds;
|
|
$dds{dwMagic} = pack L => read_DWORD($fh);
|
|
for (qw(Size Flags Height Width PitchOrLinearSize Depth MipMapCount))
|
|
{
|
|
$dds{"dw$_"} = read_DWORD($fh);
|
|
}
|
|
read_DWORD($fh) for 1..11; # dwReserved1
|
|
|
|
$dds{dwFlags} = expand_flags($dds{dwFlags}, 'sd');
|
|
|
|
$dds{ddpfPixelFormat} = read_DDPIXELFORMAT($fh);
|
|
$dds{ddsCaps} = read_DDCAPS2($fh);
|
|
|
|
read_DWORD($fh);# dwReserved2
|
|
|
|
bless \%dds, $class;
|
|
}
|
|
|
|
sub getType
|
|
{
|
|
my ($self) = @_;
|
|
if (grep $_ eq 'DDPF_RGB', @{$self->{ddpfPixelFormat}{dwFlags}})
|
|
{
|
|
return pack N => (
|
|
((unpack L => 'RRRR') & $self->{ddpfPixelFormat}{dwRBitMask}) |
|
|
((unpack L => 'GGGG') & $self->{ddpfPixelFormat}{dwGBitMask}) |
|
|
((unpack L => 'BBBB') & $self->{ddpfPixelFormat}{dwBBitMask}) |
|
|
((unpack L => 'AAAA') & $self->{ddpfPixelFormat}{dwRGBAlphaBitMask})
|
|
);
|
|
}
|
|
elsif (grep $_ eq 'DDPF_FOURCC', @{$self->{ddpfPixelFormat}{dwFlags}})
|
|
{
|
|
return $self->{ddpfPixelFormat}{dwFourCC}
|
|
}
|
|
else
|
|
{
|
|
die "Unknown type";
|
|
}
|
|
}
|
|
|
|
|
|
sub read_DWORD
|
|
{
|
|
die "Failed to read DWORD" unless (read $_[0], my $b, 4) == 4;
|
|
return unpack L => $b;
|
|
}
|
|
|
|
sub read_DDPIXELFORMAT
|
|
{
|
|
my $r = { map +("dw$_" => read_DWORD($_[0])),
|
|
qw(Size Flags FourCC RGBBitCount RBitMask GBitMask BBitMask RGBAlphaBitMask) };
|
|
|
|
$r->{dwFourCC} = pack L => $r->{dwFourCC};
|
|
$r->{dwFlags} = expand_flags($r->{dwFlags}, 'pf');
|
|
|
|
return $r;
|
|
}
|
|
|
|
sub read_DDCAPS2
|
|
{
|
|
my $r = { map +("dw$_" => read_DWORD($_[0])),
|
|
qw(Caps1 Caps2) };
|
|
|
|
$r->{dwCaps1} = expand_flags($r->{dwCaps1}, 'cap1');
|
|
$r->{dwCaps2} = expand_flags($r->{dwCaps2}, 'cap2');
|
|
|
|
return $r;
|
|
}
|
|
|
|
|
|
|
|
my %flag_names = (
|
|
sd => {
|
|
DDSD_CAPS => 0x00000001,
|
|
DDSD_HEIGHT => 0x00000002,
|
|
DDSD_WIDTH => 0x00000004,
|
|
DDSD_PITCH => 0x00000008,
|
|
DDSD_PIXELFORMAT => 0x00001000,
|
|
DDSD_MIPMAPCOUNT => 0x00020000,
|
|
DDSD_LINEARSIZE => 0x00080000,
|
|
DDSD_DEPTH => 0x00800000,
|
|
},
|
|
pf => {
|
|
DDPF_ALPHAPIXELS => 0x00000001,
|
|
DDPF_FOURCC => 0x00000004,
|
|
DDPF_RGB => 0x00000040,
|
|
},
|
|
cap1 => {
|
|
DDSCAPS_COMPLEX => 0x00000008,
|
|
DDSCAPS_TEXTURE => 0x00001000,
|
|
DDSCAPS_MIPMAP => 0x00400000,
|
|
},
|
|
cap2 => {
|
|
DDSCAPS2_CUBEMAP => 0x00000200,
|
|
DDSCAPS2_CUBEMAP_POSITIVEX => 0x00000400,
|
|
DDSCAPS2_CUBEMAP_NEGATIVEX => 0x00000800,
|
|
DDSCAPS2_CUBEMAP_POSITIVEY => 0x00001000,
|
|
DDSCAPS2_CUBEMAP_NEGATIVEY => 0x00002000,
|
|
DDSCAPS2_CUBEMAP_POSITIVEZ => 0x00004000,
|
|
DDSCAPS2_CUBEMAP_NEGATIVEZ => 0x00008000,
|
|
DDSCAPS2_VOLUME => 0x00200000,
|
|
},
|
|
);
|
|
|
|
sub expand_flags
|
|
{
|
|
my ($n, $name) = @_;
|
|
return [ grep $flag_names{$name}{$_} & $n, keys %{$flag_names{$name}} ];
|
|
}
|
|
|
|
1;
|