File Coverage

lib/Games/PMM/Monster.pm

Criterion	Covered	Total	%
statement	46	60	76.6
branch	7	14	50.0
condition	2	2	100.0
subroutine	14	16	87.5
pod	9	12	75.0
total	78	104	75.0

package Games::PMM::Monster;

use strict;
use Games::PMM::Monster::Commands;

my $id;

my %charge_dirs =
(
	north => [qw( y x )],
	south => [qw( y x )],
	east  => [qw( x y )],
	west  => [qw( x y )],
);

my %directions =
(
	north => {
		x     =>  0,
		y     => +1,
		left  => 'west',
		right => 'east',
	},
	south => {
		x     =>  0,
		y     => -1,
		left  => 'east',
		right => 'west',
	},
	west  => {
		x     => -1,
		y     =>  0,
		left  => 'south',
		right => 'north',
	},
	east => {
		x     => +1,
		y     =>  0,
		left  => 'north',
		right => 'south',
	},
);

my %turns =
(
	north =>
	{
		smaller => 'left',
	 	larger  => 'right',
	},
	south =>
	{
		smaller => 'right',
		larger  => 'left',
	},
	east  =>
	{
		smaller => 'right',
		larger  => 'left',
	},
	west  =>
	{
		smaller => 'left',
		larger  => 'right',
	},
);

sub new
{
	my ($class, %args)   = @_;
	$args{commands}   ||= [];

	my $commands = Games::PMM::Monster::Commands->new( @{ $args{commands} } );
	bless
	{
		id       => ++$id,
		index    => 0,
		commands => $commands,
		facing   => 'north',
		seen     => [],
		health   => 3,
	}, $class;
}

sub id
{
	my $self = shift;
	$self->{id};
}

sub health
{
	my $self = shift;
	$self->{health};
}

sub damage
{
	my $self = shift;
	--$self->{health};
}

sub commands
{
	my $self = shift;
	$self->{commands};
}

sub facing
{
	my $self        = shift;
	$self->{facing} = shift if @_;
	$self->{facing};
}

sub seen
{
	my $self      = shift;
	$self->{seen} = shift if @_;
	$self->{seen};
}

sub next_command
{
	my $self     = shift;
	$self->commands->next();
}

sub direction
{
	my ($self, $value) = @_;

	my $facing = $self->facing();
	my $dir    = $directions{ $facing };

	return { map { $_ => $dir->{$_} * $value } qw( x y ) };
}

sub turn
{
	my ($self, $turn_dir) = @_;

	my $facing     = $self->facing();
	my $new_facing = $directions{ $facing }{$turn_dir};
	$self->facing( $new_facing );
}

sub closest
{
	my $self = shift;
	my $closest;

	for my $seen (@{ $self->seen() })
	{
		$closest = $seen unless $closest;
		$closest = $seen if     $seen->{distance} < $closest->{distance};
	}

	return $closest;
}

for my $method (
{
	name     => 'charge',
	forward  => -1,
	backward =>  1,
},
{
	name     => 'retreat',
	forward  =>  1,
	backward => -1,
})
{
	no strict 'refs';
	*{ $method->{name} } = sub
	{
		my ($self, %args) = @_;
		my $facing        = $self->facing();
		my $prefer_axis   = $charge_dirs{ $facing };
		my $pos           = $args{current};

		my %delta =
		(
			x => 0,
			y => 0,
		);

		for my $axis (@$prefer_axis)
		{
			# turning
			if ($pos->{$axis} == $args{$axis})
			{
				$self->turn( $self->get_turn_direction(
					$axis, $facing, $pos->{$axis}, $args{$axis}
				));
				return 'turned';
			}

			$delta{ $axis } = $pos->{$axis} > $args{$axis} ?
				$method->{forward} :
				$method->{backward};
			last;
		}

		return \%delta;
	};
}

sub get_turn_direction
{
	my ($self, $axis, $facing, $current, $dest) = @_;

	return $turns{ $facing }->{ $current < $dest ? 'larger' : 'smaller' };
}

1;
__END__