view release on metacpan or  search on metacpan

lib/Games/PMM/Arena.pm  view on Meta::CPAN

sub set_position
{
	my ($self, %args) = @_;

	my $coords   = $self->coordinates();
	my $monsters = $self->monsters();

	return unless $self->validate_position( %args );

	$coords->[ $args{x} ][ $args{y} ]   = $args{monster};
	$monsters->{ $args{monster}->id() } = [ $args{x}, $args{y} ];
}

sub validate_position
{
	my ($self, %args) = @_;
	my $coords        = $self->coordinates();

	return unless $self->within_bounds( %args );

	return if defined $coords->[ $args{x} ][ $args{y} ];
	return 1;
}

sub within_bounds
{
	my ($self, %args) = @_;
	my $coords        = $self->coordinates();

	return if $args{x} > $self->x_limit() or $args{y} > $self->y_limit();
	return if $args{x} < 0                or $args{y} < 0;

	return 1;
}

sub delete_position
{
	my ($self, %args) = @_;
	my $coords        = $self->coordinates();
	my $monsters      = $self->monsters();
	my $monster       = $coords->[ $args{ x } ][ $args{ y } ];

	$coords->[ $args{ x } ][ $args{ y } ] = undef;
	return unless $monster;
	delete $monsters->{ $monster->id() };
}

sub get_position
{
	my ($self, $monster) = @_;
	my $id               = $monster->id();
	my $monsters         = $self->monsters();

	return unless exists $monsters->{ $id };

	my ($x, $y)          = @{ $monsters->{ $id } }; 
	return { x => $x, y => $y };
}

sub update_position
{
	my ($self, $monster, %args)   = @_;
	my $old_pos                   = $self->get_position( $monster );

	return unless $self->validate_position( %args );

	$self->delete_position( monster => $monster, %$old_pos );
	$self->set_position(    monster => $monster,  %args );
}

sub get_monster
{
	my ($self, %args) = @_;
	my $coords        = $self->coordinates();

	return unless $self->within_bounds( %args );

	return $coords->[ $args{x} ][ $args{y} ];
}

for my $method
(
	{ name => 'forward', modifier => +1 },
	{ name => 'reverse', modifier => -1 },
)
{
	no strict 'refs';

	*{ $method->{name} } = sub
	{
		my ($self, $monster) = @_;

		my $pos        = $self->get_position( $monster );
		my $direction  = $monster->direction( $method->{modifier} );
		$pos->{x}     += $direction->{x};
		$pos->{y}     += $direction->{y};

		return unless $self->validate_position( %$pos );

		$self->update_position( $monster, %$pos );
	};
}

sub is_wall
{
	my ($self, %args) = @_;

	return 1 if $args{x} < 0 or $args{x} > $self->x_limit();
	return 1 if $args{y} < 0 or $args{y} > $self->y_limit();
	return;
}

sub get_distance
{
	my ($self, $pos, %to) = @_;

	my ($small_x, $big_x) = $self->minmax( $to{x}, $pos->{x} );
	my ($small_y, $big_y) = $self->minmax( $to{y}, $pos->{y} );

	return $big_x - $small_x + $big_y - $small_y;