#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

my $SHOWWARN = 0;
my $SHOWMAP = "head"; # ascii, num, ppm
my $SHOWCOL = 0;

use Getopt::Long;
GetOptions(
	"verbose|v!" => \$SHOWWARN,
	"map|m=s" => \$SHOWMAP,
	"color|c" => \$SHOWCOL,
);

use Data::StarCraft::Map;
my $map = Data::StarCraft::Map->new->open(\*STDIN);
$map->{DEBUG} = 1 if $SHOWWARN;

if ($SHOWMAP ne "ppm") {
	printf("%s size %dx%d, %d player\n",
		$map->version,
		$map->info->{x}, $map->info->{y},
		scalar grep {$_->{id} == 214} $map->units,
	);
	print "\n";
}

if ($SHOWMAP eq "head") {
	if ($map->{STR}) {
		my @str = split /\0/, substr $map->{STR}, 2051;
		$SHOWCOL ? (
			s/([\001-\007])/sprintf '[0;%dm', 30+ord($1)/eg
			and $_ .= ""
		) : s/[\001-\017]//g, print "* $_\n" for @str;
		print "\n";
	}
	printf "%-4s %d\n", $_, defined $map->{$_} ? length $map->{$_} : 0
		for sort keys %$map;
	print "\n";
	printf "%s: %s\n", $_, join ",", unpack "C*", $map->{$_}
		for sort grep { defined $map->{$_} and length $map->{$_} < 32 }
			keys %$map;
	print "\n";
}

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 & 7] || "?";
}

#        MTXM TILE
# ?      ?    yes
# v205 = yes  no

my %mapsep = (
	num => ',',
	ppm => '  ',
	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};

	my $tiles = $SHOWMAP eq "num" ? [ map sprintf('%5d', $_), @{$map->tiles} ]
		: $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 '?') {
			warn 'Tileset '.$map->era.' not recognized; fallback to jungle';
			$era = 'jungle';
		}
		my $tileset = Data::StarCraft::Tileset->open("/home/shiar/sc/tileset_$era")
			or die "No tileset for world $era";

		my ($x, $y) = (0, 0);
		for (@$tiles) {
			# 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,
				);
			}
		}

		$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