view release on metacpan or  search on metacpan

lib/Game/Collisions/AABB.pm  view on Meta::CPAN

sub _reinsert
{
    my ($self) = @_;
    my $current_parent = $self->parent;
    return if ! defined $current_parent;
    $self->_detach_from_parent;

    while( defined( my $possible_root = $current_parent->parent ) ) {
        $current_parent = $possible_root;
    }

    # $current_parent will now be the root of the tree
    $current_parent->insert_new_aabb( $self );
    return;
}

sub _detach_from_parent
{
    my ($self) = @_;
    my $current_parent = $self->parent;
    return unless defined $current_parent;

    my $current_grandparent = $current_parent->parent;
    my $is_left = ($current_parent->left_node() == $self);
    if(! defined $current_grandparent ) {
        # Parent must have been root. Just detach ourselves.
        if( $is_left ) {
            $current_parent->set_left_node( undef );
        }
        else {
            $current_parent->set_right_node( undef );
        }
    }
    else {
        # Our parent is removed, and our sibling takes its place in the 
        # grandparent
        my $sibling = $is_left
            ? $current_parent->right_node
            : $current_parent->left_node;
        my $is_parent_left
            = ($current_grandparent->left_node == $current_parent);

        if( $is_parent_left ) {
            $current_grandparent->set_left_node( $sibling );
        }
        else {
            $current_grandparent->set_right_node( $sibling );
        }
    }
    
    $self->set_parent( undef );
    return;
}



sub _set_node
{
    my ($self, $node, $index) = @_;
    Scalar::Util::unweaken( $self->[$index] )
        if defined $self->[$index];
    $self->[$index] = $node;
    Scalar::Util::weaken( $self->[$index] );
    my $former_parent = defined $node
        ? $node->set_parent( $self )
        : undef;
    return $former_parent;
}

sub _resize_to_fit_children
{
    my ($self) = @_;
    return if ! $self->is_branch_node;
    my ($x, $y, $length, $height) = $self->_calculate_bounding_box_for_nodes(
        $self->[_LEFT_NODE],
        $self->[_RIGHT_NODE],
    );

    $self->[_X] = $x;
    $self->[_Y] = $y;
    $self->[_LENGTH] = $length;
    $self->[_HEIGHT] = $height;
    $self->[_MAX_X] = $x + $length;
    $self->[_MAX_Y] = $y + $height;

    return;
}

sub _calculate_bounding_box_for_nodes
{
    my ($self, $node1, $node2) = @_;
    return @$node1[_X, _Y, _LENGTH, _HEIGHT] if ! defined $node2;
    return @$node2[_X, _Y, _LENGTH, _HEIGHT] if ! defined $node1;

    my $min_x = List::Util::min( $node1->x, $node2->x );
    my $min_y = List::Util::min( $node1->y, $node2->y );
    my $max_x = List::Util::max(
        $node1->length + $node1->x,
        $node2->length + $node2->x,
    );
    my $max_y = List::Util::max(
        $node1->height + $node1->y,
        $node2->height + $node2->y,
    );

    my $length = $max_x - $min_x;
    my $height = $max_y - $min_y;
    return ($min_x, $min_y, $length, $height);
}


1;
__END__


=head1 NAME

  Game::Collisions::AABB

=head1 METHODS

=head2 new