File Coverage

lib/Games/PMM/Actions.pm

Criterion	Covered	Total	%
statement	39	40	97.5
branch	8	10	80.0
condition	9	12	75.0
subroutine	10	10	100.0
pod	6	7	85.7
total	72	79	91.1

package Games::PMM::Actions;

use strict;

sub new
{
	my $self = shift;
	bless {}, $self;
}

sub action_forward
{
	my ($self, $arena, $monster) = @_;
	$arena->forward( $monster );
}

sub action_reverse
{
	my ($self, $arena, $monster) = @_;
	$arena->reverse( $monster );
}

sub action_turn
{
	my ($self, $arena, $monster, $direction) = @_;
	$monster->turn( $direction );
}

sub action_scan
{
	my ($self, $arena, $monster) = @_;
	my @scanned = $arena->scan( $monster );
	$monster->seen( \@scanned );
}

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

for my $method (
	{ name => 'charge',  direction =>  1 },
	{ name => 'retreat', direction => -1 },
)
{
	no strict 'refs';
	my ($type, $dir) = @$method{qw( name direction )};

	*{ 'action_' . $type } = sub
	{
		my ($self, $arena, $monster) = @_;

		if (my $direction = $self->should_turn( $monster, $arena, $type ))
		{
			return $monster->turn( $direction );
		}

		my $closest     = $monster->closest();
		my $facing      = $monster->facing();
		my $pos         = $arena->get_position( $monster );
		my ($ax1, $ax2) = @{ $move_axis{ $facing } };

		my $move        = ($pos->{ $ax1 } < $closest->{ $ax1 } ? $dir : -$dir);
		$arena->move_monster( $monster, $ax1 => $move, $ax2 => 0 );
	};
}

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

sub should_turn
{
	my ($self, $monster, $arena, $type) = @_;

	my $facing      = $monster->facing();
	my $closest     = $monster->closest();
	my $pos         = $arena->get_position( $monster );
	my $axis        = $move_axis{ $facing };
	my $turn_dir    = $turns{ $facing };
	my ($ax1, $ax2) = @$axis;
	my $limit       = "${ax1}_limit";

	return unless
		   ( $type eq 'charge'  &&   $pos->{$ax1} == $closest->{$ax2} )
		or ( $type eq 'retreat' && ( $pos->{$ax1} == 0
			                    or   $pos->{$ax1} == $arena->$limit   ));

	my $compare = $type eq 'charge' ?
		$pos->{$ax2} > $closest->{$ax2} : $pos->{$ax2} < $closest->{$ax2};

	return $compare ? $turn_dir->{ lesser } : $turn_dir->{ greater };
}

sub action_attack
{
	my ($self, $arena, $monster) = @_;
	$arena->attack( $monster );
}

1;
__END__