X-Git-Url: http://git.shiar.net/perl/schtarr.git/blobdiff_plain/e503c5e7b17c8da4dcb3dec44abb228cbe334a45..HEAD:/scmap

diff --git a/scmap b/scmap
index 5167e01..33f7f8b 100755
--- a/scmap
+++ b/scmap
@@ -49,7 +49,7 @@ sub world {
 	my $self = shift;
 	# ERA:          0        1        2       3        4      5      6   7
 	my @worlds = qw(badlands platform install ashworld jungle desert ice twilight);
-	return $worlds[$self->era] || "?";
+	return $worlds[$self->era & 7] || "?";
 }
 
 #        MTXM TILE
@@ -62,6 +62,35 @@ my %mapsep = (
 	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};
 
@@ -69,6 +98,9 @@ if (defined $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 '?') {
@@ -78,27 +110,119 @@ if (defined $mapsep{$SHOWMAP}) {
 		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;
 			}
-			$_ = join ' ', @rgb;
 		}
+
+		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,
+				);
+			}
+		}
+
+		$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