sub new
{
bless
{
x_limit => 9,
y_limit => 9,
coordinates => [],
monsters => {},
}, shift;
}
sub coordinates
{
my $self = shift;
return $self->{coordinates};
}
sub monsters
{
my $self = shift;
$self->{monsters};
}
sub x_limit
{
my $self = shift;
$self->{x_limit};
}
sub y_limit
{
my $self = shift;
$self->{y_limit};
}
sub add_monster
{
my ($self, $monster, %coordinates) = @_;
$self->set_position( monster => $monster, %coordinates );
}
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;
}
sub minmax
{
my ($self, $val1, $val2) = @_;
return $val1 < $val2 ? ( $val1, $val2 ) : ( $val2, $val1 );
}
sub scan
{
my ($self, $monster) = @_;
my $id = $monster->id();
my $pos = $self->get_position( $monster );
my @seen;
while ( my ($monster_id, $data) = each %{ $self->monsters() })
{
next if $monster_id == $id;
my ($x, $y) = @$data;
my $distance = $self->get_distance( $pos, x => $x, y => $y );
next unless $self->can_see( $monster, $pos,
distance => $distance,
x => $x,
y => $y
);
push @seen,
{
id => $monster_id,
x => $x,
y => $y,
distance => $distance,
};
}
return @seen;
}
my %facings =
(
north => sub {
my ($self, $pos) = @_;
return
{
from => $pos->{x},
to => $self->x_limit(),
perp => 'y',
axis => 'x',
};
},
south => sub {
my ($self, $pos) = @_;
return
{
from => 0,
to => $pos->{x},
perp => 'y',
axis => 'x',
};
},
east => sub {
my ($self, $pos) = @_;
return
{
from => $pos->{y},
to => $self->y_limit(),
perp => 'x',
axis => 'y',
}
},
west => sub {
my ($self, $pos) = @_;
return
{
from => 0,
to => $pos->{y},
perp => 'x',
axis => 'y',
}
},
);
sub can_see
{
my ($self, $monster, $pos, %args) = @_;
my $look = $facings{ $monster->facing() };
my $limits = $self->$look( $pos );
my $axis = $limits->{axis};
my $perp_axis = $limits->{perp};
return ! $self->behind( $monster, $pos, %args ) if $args{distance} == 1;
return if $args{$perp_axis} == $pos->{$perp_axis};
return 1 if $args{$axis} >= $limits->{from} and
$args{$axis} <= $limits->{to};
return;
}
my %check_behind =
(
north => { axis => 'y', mod => -1 },
south => { axis => 'y', mod => +1 },
east => { axis => 'x', mod => -1 },
west => { axis => 'x', mod => +1 },
);
sub behind
{
my ($self, $monster, $pos, %args) = @_;
my $check = $check_behind{ $monster->facing };
return $pos->{$check->{axis}} + $check->{mod} == $args{$check->{axis}};
}
sub move_monster
{
my ($self, $monster, %coords) = @_;
my $position = $self->get_position( $monster );
$position->{x} += $coords{x};
$position->{y} += $coords{y};
$self->update_position( $monster,
x => $position->{x},
y => $position->{y},
);
}
sub attack
{
my ($self, $monster) = @_;
my $victim = $self->get_victim( $monster );
return unless $victim;
$victim->damage();
}
sub get_victim
{
my ($self, $monster) = @_;
my @nearby = grep { $_->{distance} == 1 } $self->scan( $monster );
return unless @nearby;
return $self->get_monster( map { $_ => $nearby[0]->{$_} } qw( x y ) );
}
1;