7 my $SHOWMAP = "head"; # ascii, num, ppm
12 "verbose|v!" => \$SHOWWARN,
13 "map|m=s" => \$SHOWMAP,
14 "color|c" => \$SHOWCOL,
17 use Data::StarCraft::Map;
18 my $map = Data::StarCraft::Map->new->open(\*STDIN);
19 $map->{DEBUG} = 1 if $SHOWWARN;
21 if ($SHOWMAP ne "ppm") {
22 printf("%s size %dx%d, %d player\n",
24 $map->info->{x}, $map->info->{y},
25 scalar grep {$_->{id} == 214} $map->units,
30 if ($SHOWMAP eq "head") {
32 my @str = split /\0/, substr $map->{STR}, 2051;
34 s/([\001-\007])/sprintf '
\e[0;%dm', 30+ord($1)/eg
36 ) : s/[\001-\017]//g, print "* $_\n" for @str;
39 printf "%-4s %d\n", $_, defined $map->{$_} ? length $map->{$_} : 0
42 printf "%s: %s\n", $_, join ",", unpack "C*", $map->{$_}
43 for sort grep { defined $map->{$_} and length $map->{$_} < 32 }
50 # ERA: 0 1 2 3 4 5 6 7
51 my @worlds = qw(badlands space 0 0 jungle 0 0 twilight);
52 return $worlds[$self->era] || "?";
57 '~' => '0 0 3', # water
58 'W' => '3 3 7', # coast/water object
59 'D' => '8 7 5', # D shore
61 'j' => '2 3 0', # jungle
62 'd' => '3 3 0', # dirt
64 'o' => '3 3 2', # rocky
65 'O' => '11 10 6', # object on lower ground
66 'l' => '4 4 2', # ruins
68 'R' => '3 9 3', # raised jungle
70 'x' => '6 9 2', # high jungle
71 'h' => '10 10 4', # high dirt
72 'q' => '12 11 0', # high ruins
73 'i' => '13 9 0', # temple
75 'R' => '2 5 2', # raised jungle
77 'x' => '5 7 3', # high jungle
78 'h' => '7 7 3', # high dirt
79 'q' => '8 8 5', # high ruins
80 'Q' => '15 15 8', # object on higher ground
81 'i' => '10 9 5', # temple
82 'b' => '5 4 3', # asphalt/basilica
83 'a' => '13 11 5', # high basilica
84 'A' => '13 12 10', # bas. sides
99 '$' => '0 13 15', # mineral patch
100 '*' => '4 15 8', # gas geyser
101 '@' => '14 4 3', # start location
102 '#' => '15 12 0', # unknown unit
104 ' ' => '15 15 15', # defined unencountered
105 '?' => '0 0 0', # undefined
106 '!' => '15 0 15', # marked
107 '-' => '0 15 0', # debug
121 'b' => '3 3 2', # asphalt
122 'j' => '5 4 0', # grass
123 'd' => '4 3 1', # dirt
124 'q' => '4 3 2', # dirt ↔ asphalt
125 'o' => '8 8 5', # high grass (also mud?)
127 'O' => '11 10 6', # object on lower ground
128 'l' => '4 3 2', # asphalt↔dirt
130 'h' => '8 7 5', # high dirt
131 'x' => '9 8 5', # high grass ↔ high dirt?
134 'r' => '9 9 9', # structure
152 # high sandy sunken pit
216 # 'b' => '5 4 3', # basilica
217 # 'p' => '3 3 2', # ?
218 # 'r' => '3 9 3', # sunken stuff
221 my %addmapcol = !$SHOWWARN ? () : (
226 #%mapcol = (%mapcol, %{$eramapcol[$map->era]}, %addmapcol);
227 %mapcol = (%mapcol, %{$eramapcol[4]}, %addmapcol);
239 if (defined $mapsep{$SHOWMAP}) {
240 my $MAPCHARSEP = $mapsep{$SHOWMAP};
242 my $tiles = $SHOWMAP eq "num" ? [ map sprintf('%5d', $_), @{$map->tiles} ]
243 : $map->tiles_parsed;
245 if ($SHOWMAP eq "ppm") {
246 printf "P3\n%d %d\n15\n", $map->info->{x}, $map->info->{y};
249 defined $mapcol{$_} or $uncolored{$_}++ for @$tiles, '?';
250 warn "no color for tile '$_'\n" for keys %uncolored;
252 $_ = $mapcol{$_} || $mapcol{'?'} || '0 0 0' for @$tiles;
255 my ($unit, $match, $color) = @_;
256 my $pos = $unit->{x} + $unit->{y} * $map->width;
259 $pos+$map->width, $pos-$map->width,
260 $pos+1+$map->width, $pos+1-$map->width,
262 $tiles->[$delta] =~ s/($match)/$1 + $color/e
263 unless $tiles->[$delta] eq $mapcol{$unit->{chr}};
266 for ($map->units_parsed) {
267 if ($_->{chr} eq '$') {
268 surround($_, qr/\d+$/, 7);
269 } elsif ($_->{chr} eq '*') {
270 surround($_, qr/\d+(?= \d+$)/, 3);
276 while (my @line = splice @$tiles, 0, $map->width) {
277 printf "%s\n", join $MAPCHARSEP, @line;