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


Games-PMM documentation Contained in the Games-PMM distribution.

Index


Code Index:

NAME

Top

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

SYNOPSIS

Top

	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 );

DESCRIPTION

Top

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

METHODS

Top

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

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

* id

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

* health

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

* damage

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

* facing

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

* 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 Games::PMM::Monster::Commands for more information.

* turn( $direction )

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

* closest

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

* 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.

* 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.

AUTHOR

Top

chromatic, chromatic@wgz.org

BUGS

Top

No known bugs.

COPYRIGHT

Top


Games-PMM documentation Contained in the Games-PMM distribution.

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__