XXX: handle multiple MTXM chunks correctly (tileset obfuscation for example in BlitzX...
authorMischa POSLAWSKY <perl@shiar.org>
Thu, 12 Feb 2009 05:07:55 +0000 (06:07 +0100)
committerMischa POSLAWSKY <perl@shiar.org>
Thu, 12 Feb 2009 05:07:55 +0000 (06:07 +0100)
Data-StarCraft/lib/Data/StarCraft/Map.pm
scmap

index cb5dc0f007c116c329915c0e7d40f64d93b50bbc..e51674c91d253464a511d1b3513d7af20fca5f95 100644 (file)
@@ -30,8 +30,16 @@ sub open {
                        or die "Couldn't chunk header\n";
                $type =~ s/ +$//;
 #printf STDERR "%s: %s\n", $type, $size;
-               defined $self->{$type} and warn "duplicate map chunk $type\n";
-               $self->{$type} = $self->_read($file, $size);
+               if (defined $self->{$type}) {
+                       # redefinitions (partially) override earlier data from start
+                       warn "duplicate map chunk $type\n";
+                       my $prepend = $self->_read($file, $size);
+                       substr($self->{$type}, 0, length($prepend)) = $prepend;
+                       next;
+               }
+               else {
+                       $self->{$type} = $self->_read($file, $size);
+               }
        }
        return $self;
 }
@@ -54,12 +62,19 @@ sub width {
        return $_[0]->info->{x};
 }
 
+sub height {
+       return $_[0]->info->{y};
+}
+
 sub tiles {
        my $self = shift;
        my @map = unpack 'v*', $self->{MTXM};
        @map == $#map + 1 or warn(sprintf
-               "couldn't parse map: only %d tiles\n", scalar @map
+               "Couldn't parse map: only %d tiles\n", scalar @map
        ), return;
+       warn sprintf("Only %d tiles in MTXM, but expecting %dx%d",
+               scalar @map, $self->width, $self->height
+       ) if scalar @map != $self->width * $self->height;
        return \@map;
 }
 
diff --git a/scmap b/scmap
index 2787355bd25d81bd784a4aa8e3bc3492320405a9..f636b25742250bf6d5fd8c921cc9bff38eac451e 100755 (executable)
--- a/scmap
+++ b/scmap
@@ -70,7 +70,7 @@ if (defined $mapsep{$SHOWMAP}) {
 
        if ($SHOWMAP eq "ppm") {
                use Imager;
-               my $img = Imager->new(xsize => $map->width * 4, ysize => $map->width * 4);
+               my $img = Imager->new(xsize => $map->width * 4, ysize => $map->height * 4);
 
                use Data::StarCraft::Tileset;
                my $era = world($map);