1 package Data::StarCraft::Map;
17 my ($fh, $size, $seek) = @_;
18 seek *$fh, $seek, 0 if $seek;
19 read(*$fh, my $in, $size) eq $size or return undef;
27 while (not eof $file) {
28 local $_ = $self->_read($file, 8)
29 and my ($type, $size) = unpack "a4V", $_
30 or die "Couldn't chunk header\n";
32 #printf STDERR "%s: %s\n", $type, $size;
33 defined $self->{$type} and warn "duplicate map chunk $type\n";
34 $self->{$type} = $self->_read($file, $size);
41 return 'v' . ord $self->{VER};
46 my ($x, $y) = unpack "vv", $self->{DIM};
54 return $_[0]->info->{x};
59 my @map = unpack 'v*', $self->{MTXM};
60 @map == $#map + 1 or warn(sprintf
61 "couldn't parse map: only %d tiles\n", scalar @map
68 my @mapunit = ( # character => width, height, ids
69 '$' => [2,1, 176..178], # minerals
70 '*' => [2,1, 188], # gas
71 '@' => [2,2, 214], # start pos
75 while (my ($char, $matches) = splice @mapunit, 0, 2) {
76 my @charinfo = ($char, splice @$matches, 0, 2);
77 $unitchar{$_} = \@charinfo for @$matches;
82 my $map = $self->tiles or return;
85 tie my %unknown, 'Tie::IxHash';
86 defined $tilechar{$map->[$_]} or warn(sprintf
87 "unknown tile %d at (%d,%d)\n",
88 $map->[$_], $_ % $self->width, $_ / $self->width
89 ), $unknown{$map->[$_]} = $_ for 0 .. $#$map;
90 warn sprintf "unknown: %s\n", join ",", keys %unknown if keys %unknown;
92 $_ = defined $tilechar{$_} ? $tilechar{$_} : '?' for @$map;
94 my ($chr, $width, $height) = defined $unitchar{$_->{id}} ?
95 @{ $unitchar{$_->{id}} } : ('#', 1, 1);
96 for my $x ($_->{x} .. $_->{x} + $width - 1) {
97 for my $y ($_->{y} .. $_->{y} + $height - 1) {
98 $map->[$x + $y * $self->width] = $chr;
108 for (my $i = 0; $i < length $self->{UNIT}; $i += 36) {
109 # d1, d2, x*32, y*32, unitid, bytes1, playerid, bytes2, mineral, bytes3
110 my @pack = unpack "v5x6Cx3vx14", substr $self->{UNIT}, $i, 36;
128 my ($chr, $width, $height) = defined $unitchar{$_->{id}} ?
129 @{ $unitchar{delete $_->{id}} } : ('#', 1, 1);
131 $_->{width} = $width;
141 FF0000 0000FF 209070 88409C E87824 5C2C14 FFFFFF DCDC3C
142 0F930F FCFC8F EFCEBD 547CDC
144 12 => "pale green", "gray", "pale yellow", "cyan",
145 17 => "black", "neon blue",
146 21 => "lavender", "black",
151 for (unpack "C*", $self->{COLR}) {
152 push @players, $colormap[$_] || "? (#$_)";
159 return unpack "v", $self->{ERA};