sub world {
my $self = shift;
- # ERA: 0 1 2 3 4 5 6 7
- my @worlds = qw(badlands space 0 0 jungle 0 0 twilight);
- return $worlds[$self->era] || "?";
+ # ERA: 0 1 2 3 4 5 6 7
+ my @worlds = qw(badlands platform install ashworld jungle desert ice twilight);
+ return $worlds[$self->era & 7] || "?";
}
# MTXM TILE
ascii => '',
);
+use Inline with => 'Imager';
+use Inline C => <<'EOS';
+void blendpixel(Imager img, int offset, Imager::Color color) {
+ int ch;
+ float opacity = (float)color->channel[3] / 255;
+ for (ch = 0; ch < img->channels; ++ch) {
+ img->idata[offset * img->channels + ch] *= 1 - opacity;
+ img->idata[offset * img->channels + ch] += color->channel[ch] * opacity;
+ }
+ return;
+}
+
+EOS
+
+my %UNITINFO = ( # unitid => color|image, width, height
+ 176 => [min => [ 47, 195, 255], 2, 1], # minerals
+ 188 => [gas => [ 15, 255, 63], 2, 1], # gas
+ 214 => [pos => [255, 255, 0], 2, 2], # start pos
+);
+$UNITINFO{$_} = $UNITINFO{176} for 177, 178;
+
+my $STYLE = {
+ wall => [0, 0, 255, 127],
+ edge => [0, 0, 255, 15],
+ ramp => [0, 255, 0, 47],
+ rock => [255, 0, 0, 255],
+};
+$_ = Imager::Color->new(@$_) for values %$STYLE;
+
if (defined $mapsep{$SHOWMAP}) {
my $MAPCHARSEP = $mapsep{$SHOWMAP};
: $map->tiles;#_parsed;
if ($SHOWMAP eq "ppm") {
+ use Imager;
+ my $img = Imager->new(xsize => $map->width * 4, ysize => $map->height * 4);
+
use Data::StarCraft::Tileset;
my $era = world($map);
if ($era eq '?') {
my $tileset = Data::StarCraft::Tileset->open("/home/shiar/sc/tileset_$era")
or die "No tileset for world $era";
- printf "P3\n%d %d\n255\n", $map->info->{x}, $map->info->{y};
+ my ($x, $y) = (0, 0);
for (@$tiles) {
- my $tile = $tileset->tileavg($_);
- my $div = 1;#$tile->{walk} > 1 ? 1 : 1.8;
- my @rgb = map {int($_ / $div)} @{ $tile->{col} };
- if (($tile->{walk} & 1) == 0 and $tile->{walk} < 10) {
-# $rgb[2] += 128;
- $rgb[0] *= 3;
- $rgb[1] *= 3;
- $rgb[2] *= 3;
- } elsif ($tile->{build}) {
- $rgb[0] += 48;
-# $rgb[$_] = int($rgb[$_] / 1.5) for 0..2;
+ # 128x128 ~ 6s
+# my $tile = $tileset->tileavg($_);
+# $img->setpixel(x => $x, y => $y, color => $tile->{col});
+
+ # 512x512 ~ 7s
+ my $tile = $tileset->tile($_);
+BLENDTILE:
+ for (my $offset = 0; $offset < 4*4; $offset++) {
+ for (my $y = 0; $y < 4; $y++) {
+ my $subtype = $tile->{subtype}->[$offset];
+ if ($subtype & 8) {
+ # obstructions
+ blendpixel($tile->{sprite}, $offset, $STYLE->{wall});
+ }
+ elsif (($subtype & 1) == 0) {
+ # unwalkable
+ blendpixel($tile->{sprite}, $offset, $STYLE->{edge});
+ }
+ elsif ($subtype & 16) {
+ # ramps
+ my $mask = Imager->new(xsize => 4, ysize => 4, channels => 4);
+ $mask->box(color => $STYLE->{ramp}, filled => 1);
+ $tile->{sprite}->rubthrough(src => $mask);
+ last BLENDTILE;
+ }
+ elsif ($tile->{build}) {
+ # unbuildable
+ blendpixel($tile->{sprite}, $offset, $STYLE->{rock});
+ }
+ }
+ }
+ $img->paste(src => $tile->{sprite}, left => $x*4, top => $y*4);
+
+ # 4096x4096 ~ 75s
+# my $tile = $tileset->sprite($tileset->{map}->[$_]);
+# $img->setscanline(
+# x => $x*32, y => $y*32 + $_, pixels => pack('(CCCx)*',
+# map { @{ $tileset->{palette}->[$_] } } @$tile[$_*32 .. $_*32+31]
+# ),
+# ) for 0..31;
+ }
+ continue {
+ $x++;
+ if ($x >= $map->width) {
+ $y++;
+ $x = 0;
+ }
+ }
+
+ my $overlaymin = Imager->new(
+ xsize => $img->getwidth,
+ ysize => $img->getheight,
+ channels => 4,
+ );
+ my $overlaygas = $overlaymin->copy;
+ for my $unit ($map->units) {
+ my $info = $UNITINFO{ $unit->{id} } or next;
+ my ($name, $color, $xsize, $ysize) = @$info or next;
+ if ($name eq 'min') {
+ next if $unit->{amount} <= 8;
+ $overlaymin->circle(
+ x => 4 * ($unit->{x} + $xsize/2),
+ y => 4 * ($unit->{y} + $ysize/2),
+ r => 4 * ($unit->{amount} <= 40 ? 2 : 4),
+ color => $color,
+ filled => 1,
+ aa => 1,
+ );
+ }
+ elsif ($name eq 'gas') {
+ $overlaygas->circle(
+ x => 4 * ($unit->{x} + $xsize/2),
+ y => 4 * ($unit->{y} + $ysize/2),
+ r => 4 * ($unit->{amount} <= 40 ? 2 : 4),
+ color => $color,
+ filled => 1,
+ aa => 1,
+ );
+ }
+ }
+ $img->compose(src => $overlaymin, opacity => 0.1875);
+ $img->compose(src => $overlaygas, opacity => 0.125);
+
+ for my $unit ($map->units) {
+ my $info = $UNITINFO{ $unit->{id} }
+ or warn("No unit styling for unit #$unit->{id}"), next;
+ my ($name, $color, $xsize, $ysize, $sprite) = @$info;
+ if ($sprite) {
+ $img->paste(src => $sprite, x => $unit->{x}, y => $unit->{y});
+ }
+ else {
+ $img->box(
+ xmin => 4 * $unit->{x},
+ ymin => 4 * $unit->{y},
+ xmax => 4 * ($unit->{x} + ($xsize || 1)),
+ ymax => 4 * ($unit->{y} + ($ysize || 1)),
+ color => $color,
+ filled => 1,
+ );
}
- $_ = join ' ', @rgb;
}
+
+ $img->write(fd => fileno(STDOUT), type => 'png')
+ or die 'Cannot output image: ', $img->errstr;
}
+=cut
while (my @line = splice @$tiles, 0, $map->width) {
printf "%s\n", join $MAPCHARSEP, @line;
}
+=cut
}
+=head1 scmap
+
+From replay:
+
+ old/screptomap somereplay.rep | ./scmap -m=ppm > map.ppm
+
+From map:
+
+ ./scmtomap starcraft/maps/ladder/'(4)Lost Temple.scm'
+ ./scmap -m=ppm < file000001.xxx > map.ppm
+
+=cut
git.shiar.nl / perl / schtarr.git / blobdiff