The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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__

=head1 NAME

Games::PMM::Monster - represents a Monster in a PMM Game

=head1 SYNOPSIS

	use Games::PMM::Monster;
	use Games::PMM::Arena;

	my @commands = ( scan charge attack );
	my $monster  = Games::PMM::Monster->new( commands => \@commands );
	my $arena    = Games::PMM::Arena->new();

	$arena->add_monster( $monster, x => 0, y => 0 );

=head1 DESCRIPTION

Games::PMM::Monster represents a Monster that battles in a PMM game.  It
contains all of the monster state and behavior.

=head1 METHODS

=over 4

=item * new( [ commands => \@commands ] )

Creates and returns a new Monster object.  Any C<commands> provided will be
passed straight through to a L<Games::PMM::Monster::Commands> object.

=item * id

Returns the identifier of this Monster.  All Monsters created within a program
have a unique identifier.

=item * health

Returns the Monster's current health.  Monsters start with three points of
health.

=item * damage

Removes a point of health from the Monster and returns the current value.

=item * facing

Returns the direction the Monster is currently facing.  This is one of the four
cardinal directions.

=item * next_command

Returns the next command the Monster would like to execute.  This may return a
false value if the Monster is looping around its entire command set.  See
L<Games::PMM::Monster::Commands> for more information.

=item * turn( $direction )

Turns the Monster in the given C<$direction>, either C<left> or C<right>.

=item * closest

Returns information about the closest other Monster this Monster has seen.
Data is returned as a hash reference with keys of C<id>, C<distance>, and C<x>
and C<y> coordinates.  You'll probably only use this if you are extending this
class.

=item * charge( x => $x, y => $y )

Moves or turns the Monster toward the given coordinates.  Monsters prefer to
move in the direction they are facing, but they will turn if they can go no
further in the current direction.

=item * retreat( x => $x, y => $y )

Moves or turns the Monster away from the given coordinates.  Monsters prefer to
move along the axis it is facing (tending to back up when retreating), but will
turn if it can go no further in the current direction.

=back

=head1 AUTHOR

chromatic, C<chromatic@wgz.org>

=head1 BUGS

No known bugs.

=head1 COPYRIGHT

Copyright (c) 2003, chromatic.  All rights reserved.  This module is
distributed under the same terms as Perl itself, in the hope that it is useful
but certainly under no guarantee.