Game-Collisions
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Game/Collisions.pm view on Meta::CPAN
# Copyright (c) 2018 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package Game::Collisions;
$Game::Collisions::VERSION = '0.5';
use v5.14;
use warnings;
use List::Util ();
use Game::Collisions::AABB;
# ABSTRACT: Fast, pure Perl collision 2D detection
sub new
{
my ($class) = @_;
my $self = {
root_aabb => undef,
all_aabbs => {},
};
bless $self => $class;
return $self;
}
sub make_aabb
{
my ($self, $args) = @_;
my $aabb = Game::Collisions::AABB->new( $args );
$self->_add_aabb( $aabb );
return $aabb;
}
sub get_collisions
{
my ($self) = @_;
my @aabbs_to_check = values %{ $self->{all_aabbs} };
my @collisions;
foreach my $aabb (@aabbs_to_check) {
push @collisions => $self->get_collisions_for_aabb( $aabb );
}
return @collisions;
}
sub get_collisions_for_aabb
{
my ($self, $aabb) = @_;
return () if ! defined $self->{root_aabb};
my @collisions;
my @nodes_to_check = ($self->{root_aabb});
while( @nodes_to_check ) {
my $check_node = shift @nodes_to_check;
if( $check_node->is_branch_node ) {
my $left_node = $check_node->left_node;
my $right_node = $check_node->right_node;
if( defined $left_node && $left_node->does_collide( $aabb ) ) {
push @nodes_to_check, $left_node;
}
if( defined $right_node && $right_node->does_collide( $aabb ) ) {
push @nodes_to_check, $right_node;
}
}
else {
# We already know it collided, since it wouldn't be added
# to @nodes_to_check otherwise.
push @collisions, [ $aabb, $check_node ];
}
}
return @collisions;
}
sub get_collisions_for_aabb_bruteforce
{
view all matches for this distributionview release on metacpan - search on metacpan
( run in 2.035 seconds using v1.00-cache-2.02-grep-82fe00e-cpan-f5108d614456 )