0ad/source/tools/dds/DDS.pm
Ykkrosh ed38414b41 Texture converter, DevIL: ABGR DDS support.
Textures: converted ARGB to ABGR.
Misc: warning fixes, etc.

This was SVN commit r3631.
2006-03-14 21:29:19 +00:00

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;