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 platform install ashworld jungle desert ice twilight);
52 return $worlds[$self->era & 7] || "?";
65 if (defined $mapsep{$SHOWMAP}) {
66 my $MAPCHARSEP = $mapsep{$SHOWMAP};
68 my $tiles = $SHOWMAP eq "num" ? [ map sprintf('%5d', $_), @{$map->tiles} ]
69 : $map->tiles;#_parsed;
71 if ($SHOWMAP eq "ppm") {
73 my $img = Imager->new(xsize => $map->width * 4, ysize => $map->width * 4);
75 use Data::StarCraft::Tileset;
76 my $era = world($map);
78 warn 'Tileset '.$map->era.' not recognized; fallback to jungle';
81 my $tileset = Data::StarCraft::Tileset->open("/home/shiar/sc/tileset_$era")
82 or die "No tileset for world $era";
87 # my $tile = $tileset->tileavg($_);
88 # $img->setpixel(x => $x, y => $y, color => $tile->{col});
91 my $tile = $tileset->tile($_);
93 x => $x*4, y => $y*4 + $_, pixels => pack('(CCCx)*',
94 map { @$_ } @{ $tile->{subcol} }[$_*4 .. $_*4 + 3]
99 # my $tile = $tileset->sprite($tileset->{map}->[$_]);
101 # x => $x*32, y => $y*32 + $_, pixels => pack('(CCCx)*',
102 # map { @{ $tileset->{palette}->[$_] } } @$tile[$_*32 .. $_*32+31]
108 if ($x >= $map->width) {
114 $img->write(fd => fileno(STDOUT), type => 'png')
115 or die 'Cannot output image: ', $img->errstr;
119 while (my @line = splice @$tiles, 0, $map->width) {
120 printf "%s\n", join $MAPCHARSEP, @line;
129 old/screptomap somereplay.rep | ./scmap -m=ppm > map.ppm
133 ./scmtomap starcraft/maps/ladder/'(4)Lost Temple.scm'
134 ./scmap -m=ppm < file000001.xxx > map.ppm