package Data::StarCraft::Map;

use strict;
use warnings;
use Data::Dumper;

our $VERSION = "0.10";
our $DEBUG = 0;

sub new {
	my ($class) = @_;
	bless {}, $class;
}

sub _read {
	my $self = shift;
	my ($fh, $size, $seek) = @_;
	seek *$fh, $seek, 0 if $seek;
	read(*$fh, my $in, $size) eq $size or return undef;
	return $in;
}

sub open {
	my $self = shift;
	my ($file) = @_;

	while (not eof $file) {
		local $_ = $self->_read($file, 8)
			and my ($type, $size) = unpack "a4V", $_
			or die "Couldn't chunk header\n";
		$type =~ s/ +$//;
#printf STDERR "%s: %s\n", $type, $size;
		defined $self->{$type} and warn "duplicate map chunk $type\n";
		$self->{$type} = $self->_read($file, $size);
	}
	return $self;
}

sub version {
	my $self = shift;
	return 'v' . ord $self->{VER};
}

sub info {
	my $self = shift;
	my ($x, $y) = unpack "vv", $self->{DIM};
	return {
		x => $x,
		y => $y,
	};
}

sub width {
	return $_[0]->info->{x};
}

sub tiles {
	my $self = shift;
	my @map = unpack 'v*', $self->{MTXM};
	@map == $#map + 1 or warn(sprintf
		"couldn't parse map: only %d tiles\n", scalar @map
	), return;
	return \@map;
}

our %tilechar;

my @mapunit = ( # character => width, height, ids
	'$' => [2,1, 176..178], # minerals
	'*' => [2,1, 188], # gas
	'@' => [2,2, 214], # start pos
);

our %unitchar;
while (my ($char, $matches) = splice @mapunit, 0, 2) {
	my @charinfo = ($char, splice @$matches, 0, 2);
	$unitchar{$_} = \@charinfo for @$matches;
}

sub tiles_parsed {
	my $self = shift;
	my $map = $self->tiles or return;
	if ($self->{DEBUG}) {
		use Tie::IxHash;
		tie my %unknown, 'Tie::IxHash';
		defined $tilechar{$map->[$_]} or warn(sprintf
			"unknown tile %d at (%d,%d)\n",
			$map->[$_], $_ % $self->width, $_ / $self->width
		), $unknown{$map->[$_]} = $_ for 0 .. $#$map;
		warn sprintf "unknown: %s\n", join ",", keys %unknown if keys %unknown;
	}
	$_ = defined $tilechar{$_} ? $tilechar{$_} : '?' for @$map;
	for ($self->units) {
		my ($chr, $width, $height) = defined $unitchar{$_->{id}} ?
			@{ $unitchar{$_->{id}} } : ('#', 1, 1);
		for my $x ($_->{x} .. $_->{x} + $width - 1) {
			for my $y ($_->{y} .. $_->{y} + $height - 1) {
				$map->[$x + $y * $self->width] = $chr;
			}
		}
	}
	return $map;
}

sub units {
	my $self = shift;
	my @units;
	for (my $i = 0; $i < length $self->{UNIT}; $i += 36) {
		# d1, d2, x*32, y*32, unitid, bytes1, playerid, bytes2, mineral, bytes3
		my @pack = unpack "v5x6Cx3vx14", substr $self->{UNIT}, $i, 36;
		push @units, {
			id => $pack[4],
			player => $pack[5],
			amount => $pack[6],
			x => $pack[2] >> 5,
			y => $pack[3] >> 5,
#			d1 => $pack[0],
#			d2 => $pack[1],
		};
	}
	return @units;
}

sub units_parsed {
	my $self = shift;
	my @units;
	for ($self->units) {
		my ($chr, $width, $height) = defined $unitchar{$_->{id}} ?
			@{ $unitchar{delete $_->{id}} } : ('#', 1, 1);
		$_->{chr} = $chr;
		$_->{width} = $width;
		push @units, $_;
	}
	return @units;
}

sub colors {
	my $self = shift;
	my @colormap = (
		qw(
			FF0000 0000FF 209070 88409C E87824 5C2C14 FFFFFF DCDC3C
			0F930F FCFC8F EFCEBD 547CDC
		),
		12 => "pale green", "gray", "pale yellow", "cyan",
		17 => "black", "neon blue",
		21 => "lavender", "black",
		30 => "sky blue",
		33 => "purple",
	);
	my @players;
	for (unpack "C*", $self->{COLR}) {
		push @players, $colormap[$_] || "? (#$_)";
	}
	return \@players;
}

sub era {
	my $self = shift;
	return unpack "v", $self->{ERA};
}

1;

