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 use Inline with => 'Imager';
66 use Inline C => <<'EOS';
67 void blendpixel(Imager img, int offset, Imager::Color color) {
69 float opacity = (float)color->channel[3] / 255;
70 for (ch = 0; ch < img->channels; ++ch) {
71 img->idata[offset * img->channels + ch] *= 1 - opacity;
72 img->idata[offset * img->channels + ch] += color->channel[ch] * opacity;
79 my %UNITINFO = ( # unitid => color|image, width, height
80 176 => [min => [ 47, 195, 255], 2, 1], # minerals
81 188 => [gas => [ 15, 255, 63], 2, 1], # gas
82 214 => [pos => [255, 255, 0], 2, 2], # start pos
84 $UNITINFO{$_} = $UNITINFO{176} for 177, 178;
87 wall => [0, 0, 255, 127],
88 edge => [0, 0, 255, 15],
89 ramp => [0, 255, 0, 47],
90 rock => [255, 0, 0, 255],
92 $_ = Imager::Color->new(@$_) for values %$STYLE;
94 if (defined $mapsep{$SHOWMAP}) {
95 my $MAPCHARSEP = $mapsep{$SHOWMAP};
97 my $tiles = $SHOWMAP eq "num" ? [ map sprintf('%5d', $_), @{$map->tiles} ]
98 : $map->tiles;#_parsed;
100 if ($SHOWMAP eq "ppm") {
102 my $img = Imager->new(xsize => $map->width * 4, ysize => $map->height * 4);
104 use Data::StarCraft::Tileset;
105 my $era = world($map);
107 warn 'Tileset '.$map->era.' not recognized; fallback to jungle';
110 my $tileset = Data::StarCraft::Tileset->open("/home/shiar/sc/tileset_$era")
111 or die "No tileset for world $era";
113 my ($x, $y) = (0, 0);
116 # my $tile = $tileset->tileavg($_);
117 # $img->setpixel(x => $x, y => $y, color => $tile->{col});
120 my $tile = $tileset->tile($_);
122 for (my $offset = 0; $offset < 4*4; $offset++) {
123 for (my $y = 0; $y < 4; $y++) {
124 my $subtype = $tile->{subtype}->[$offset];
127 blendpixel($tile->{sprite}, $offset, $STYLE->{wall});
129 elsif (($subtype & 1) == 0) {
131 blendpixel($tile->{sprite}, $offset, $STYLE->{edge});
133 elsif ($subtype & 16) {
135 my $mask = Imager->new(xsize => 4, ysize => 4, channels => 4);
136 $mask->box(color => $STYLE->{ramp}, filled => 1);
137 $tile->{sprite}->rubthrough(src => $mask);
140 elsif ($tile->{build}) {
142 blendpixel($tile->{sprite}, $offset, $STYLE->{rock});
146 $img->paste(src => $tile->{sprite}, left => $x*4, top => $y*4);
149 # my $tile = $tileset->sprite($tileset->{map}->[$_]);
151 # x => $x*32, y => $y*32 + $_, pixels => pack('(CCCx)*',
152 # map { @{ $tileset->{palette}->[$_] } } @$tile[$_*32 .. $_*32+31]
158 if ($x >= $map->width) {
164 my $overlaymin = Imager->new(
165 xsize => $img->getwidth,
166 ysize => $img->getheight,
169 my $overlaygas = $overlaymin->copy;
170 for my $unit ($map->units) {
171 my $info = $UNITINFO{ $unit->{id} } or next;
172 my ($name, $color, $xsize, $ysize) = @$info or next;
173 if ($name eq 'min') {
174 next if $unit->{amount} <= 8;
176 x => 4 * ($unit->{x} + $xsize/2),
177 y => 4 * ($unit->{y} + $ysize/2),
178 r => 4 * ($unit->{amount} <= 40 ? 2 : 4),
184 elsif ($name eq 'gas') {
186 x => 4 * ($unit->{x} + $xsize/2),
187 y => 4 * ($unit->{y} + $ysize/2),
188 r => 4 * ($unit->{amount} <= 40 ? 2 : 4),
195 $img->compose(src => $overlaymin, opacity => 0.1875);
196 $img->compose(src => $overlaygas, opacity => 0.125);
198 for my $unit ($map->units) {
199 my $info = $UNITINFO{ $unit->{id} }
200 or warn("No unit styling for unit #$unit->{id}"), next;
201 my ($name, $color, $xsize, $ysize, $sprite) = @$info;
203 $img->paste(src => $sprite, x => $unit->{x}, y => $unit->{y});
207 xmin => 4 * $unit->{x},
208 ymin => 4 * $unit->{y},
209 xmax => 4 * ($unit->{x} + ($xsize || 1)),
210 ymax => 4 * ($unit->{y} + ($ysize || 1)),
217 $img->write(fd => fileno(STDOUT), type => 'png')
218 or die 'Cannot output image: ', $img->errstr;
222 while (my @line = splice @$tiles, 0, $map->width) {
223 printf "%s\n", join $MAPCHARSEP, @line;
232 old/screptomap somereplay.rep | ./scmap -m=ppm > map.ppm
236 ./scmtomap starcraft/maps/ladder/'(4)Lost Temple.scm'
237 ./scmap -m=ppm < file000001.xxx > map.ppm