#!/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 space 0 0 jungle 0 0 twilight);
	return $worlds[$self->era] || "?";
}

my %mapcol = (
	# jungle world
	'~' => '0 0 3', # water
	'W' => '3 3 7', # coast/water object
	'D' => '8 7 5', # D shore

	'j' => '2 3 0', # jungle
	'd' => '3 3 0', # dirt
	'm' => '3 3 1', # mud
	'o' => '3 3 2', # rocky
	'O' => '11 10 6', # object on lower ground
	'l' => '4 4 2', # ruins

	'R' => '3 9 3',   # raised jungle
	'r' => '8 14 8',
	'x' => '6 9 2',   # high jungle
	'h' => '10 10 4', # high dirt
	'q' => '12 11 0', # high ruins
	'i' => '13 9 0', # temple

	'R' => '2 5 2',   # raised jungle
	'r' => '4 6 4',
	'x' => '5 7 3',   # high jungle
	'h' => '7 7 3', # high dirt
	'q' => '8 8 5', # high ruins
	'Q' => '15 15 8', # object on higher ground
	'i' => '10 9 5', # temple
	'b' => '5 4 3', # asphalt/basilica
	'a' => '13 11 5', # high basilica
	'A' => '13 12 10', # bas. sides

	'/' => '15 15 11',
	'\\' => '13 13 9',
	'=' => '11 12 8',

	'7' => '3 3 1', # D>H
	'6' => '4 4 1',
	'5' => '4 4 2',
	'4' => '5 5 2',
	'3' => '5 5 3',
	'2' => '6 6 3',
	'1' => '7 7 4',

	# common
	'$' => '0 13 15', # mineral patch
	'*' => '4 15 8', # gas geyser
	'@' => '14 4 3', # start location
	'#' => '15 12 0', # unknown unit

	' ' => '15 15 15', # defined unencountered
	'?' => '0 0 0',    # undefined
	'!' => '15 0 15',  # marked
	'-' => '0 15 0',   # debug
);
my @eramapcol = (
	{ # badlands (era 0)
		# d:   dirt
		# o?:  mud 
		# h:   high dirt
		# ~:   water
		# j:   grass
		# x/o: high grass
		# s:   structure
		# b:   asphalt
		# i?:  rocky ground

		'b' => '3 3 2', # asphalt
		'j' => '5 4 0', # grass
		'd' => '4 3 1', # dirt
		'q' => '4 3 2', # dirt ↔ asphalt
		'o' => '8 8 5', # high grass (also mud?)
		'm' => '3 2 14', # ?
		'O' => '11 10 6', # object on lower ground
		'l' => '4 3 2', # asphalt↔dirt

		'h' => '8 7 5', # high dirt
		'x' => '9 8 5', # high grass ↔ high dirt?

		'/' => '15 14 11',
		'r' => '9 9 9', # structure
	},

	{ # space platform
	},

	{ # desert
		#    tar
		#    dirt
		#    dried mud
		#    sand dunes
		#    rocky ground
		#    crags
		#    sandy sunken pit
		#    compound
		#    high dirt
		#    high sand dunes
		#    high crags
		#    high sandy sunken pit
		#    high compound
	},

	{ # ice
		#    ice
		#    snow
		#    moguls
		#    dirt
		#    rocky snow
		#    grass
		#    water
		#    outpost
		#    high snow
		#    high dirt
		#    high grass
		#    high water
		#    high outpost
	},

	{ # jungle (era 4)
		# ~: water
		# d: dirt
		# m: mud
		# j: jungle
		# o: rocky ground
		# l: ruins
		# r: raised jungle
		#    temple
		# h: high dirt
		# x: high jungle
		# q: high ruins
		#    high raised jungle
		# i: high temple
	},

	{ # ash
		#    magma
		# d: dirt
		# l: lava
		# o: shale
		#    broken rock
		#    high dirt
		#    high lava
		#    high shale
	},

	{ # installation
	},

	{ # twilight (era 7)
		#    water
		#    dirt
		#    mud
		#    crushed rock
		#    crevices
		#    flagstones
		#    sunken ground
		#    basilica
		#    high dirt
		#    high crushed rock
		#    high flagstones
		#    high sunken ground
		#    high basilica
#		'b' => '5 4 3', # basilica
#		'p' => '3 3 2', # ?
#		'r' => '3 9 3', # sunken stuff
	},
);
my %addmapcol = !$SHOWWARN ? () : (
	'?' => '15 0 0',
	'm' => '2 2 1',
);

#%mapcol = (%mapcol, %{$eramapcol[$map->era]}, %addmapcol);
%mapcol = (%mapcol, %{$eramapcol[4]}, %addmapcol);

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

my %mapsep = (
	num => ',',
	ppm => '  ',
	ascii => '',
);

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") {
		printf "P3\n%d %d\n15\n", $map->info->{x}, $map->info->{y};
		if ($SHOWWARN) {
			my %uncolored;
			defined $mapcol{$_} or $uncolored{$_}++ for @$tiles, '?';
			warn "no color for tile '$_'\n" for keys %uncolored;
		}
		$_ = $mapcol{$_} || $mapcol{'?'} || '0 0 0' for @$tiles;
		if (0){
			sub surround {
				my ($unit, $match, $color) = @_;
				my $pos = $unit->{x} + $unit->{y} * $map->width;
				for my $delta (
					$pos+1, $pos-1,
					$pos+$map->width, $pos-$map->width,
					$pos+1+$map->width, $pos+1-$map->width,
				) {
					$tiles->[$delta] =~ s/($match)/$1 + $color/e
						unless $tiles->[$delta] eq $mapcol{$unit->{chr}};
				}
			}
			for ($map->units_parsed) {
				if ($_->{chr} eq '$') {
					surround($_, qr/\d+$/, 7);
				} elsif ($_->{chr} eq '*') {
					surround($_, qr/\d+(?= \d+$)/, 3);
				}
			}
		}
	}

	while (my @line = splice @$tiles, 0, $map->width) {
		printf "%s\n", join $MAPCHARSEP, @line;
	}
}