File Coverage

blib/lib/Collision/Util.pm

Criterion	Covered	Total	%
statement	13	63	20.6
branch	0	40	0.0
condition	0	6	0.0
subroutine	4	8	50.0
pod	2	4	50.0
total	19	121	15.7

package Collision::Util;

use warnings;
use strict;

BEGIN {
    require Exporter;
    our @ISA = qw(Exporter);
    our @EXPORT_OK = qw(
            check_contains check_contains_rect
            check_collision check_collision_rect
    );
    our %EXPORT_TAGS = (
        all => \@EXPORT_OK,
        std => [qw( check_contains check_collision )],
    );
}

use Carp ();

our $VERSION = '0.01';


sub check_contains {
    my ($self, $target) = (@_);

    Carp::croak "must receive a target"
        unless $target;

    my @ret = ();
    my $ref = ref $target;
    if ( $ref eq 'ARRAY' ) {
        my $id = 0;
        foreach ( @{$target} ) {
            $id++;
            if (check_contains_rect($self, $_) ) {
                push @ret, $id;
                last unless wantarray;
            }
        }
    }
    elsif ( $ref eq 'HASH' ) {
        foreach ( keys %{$target} ) {
            if (check_contains_rect($self, $target->{$_}) ) {
                push @ret, $_;
                last unless wantarray;
            }
        }
    }
    else {
        return check_contains_rect($self, $target);
    }
    return wantarray ? @ret : $ret[0];
}

sub check_contains_rect {
    Carp::croak "must receive a target"
        unless $_[1];

    my $contains;
    eval {
        $contains = ($_[0]->x <= $_[1]->x)
            && ($_[0]->y <= $_[1]->y)
            && ($_[0]->x + $_[0]->w >= $_[1]->x + $_[1]->w)
            && ($_[0]->y + $_[0]->h >= $_[1]->y + $_[1]->h)
            && ($_[0]->x + $_[0]->w > $_[1]->x)
            && ($_[0]->y + $_[0]->h > $_[1]->y)
            ;
    };
    Carp::croak "elements should have x, y, w, h accessors" if $@;
    return $contains;
}

sub check_collision {
    my ($self, $target) = (@_);

    Carp::croak "must receive a target"
        unless $target;

    my @ret = ();
    my $ref = ref $target;
    if ( $ref eq 'ARRAY' ) {
        my $id = 0;
        foreach ( @{$target} ) {
            $id++;
            if (check_collision_rect($self, $_) ) {
                push @ret, $id;
                last unless wantarray;
            }
        }
    }
    elsif ( $ref eq 'HASH' ) {
        foreach ( keys %{$target} ) {
            if (check_collision_rect($self, $target->{$_}) ) {
                push @ret, $_;
                last unless wantarray;
            }
        }
    }
    else {
        return check_collision_rect($self, $target);
    }
    return wantarray ? @ret : $ret[0];
}

sub check_collision_rect {
    Carp::croak "must receive a target"
        unless $_[1];

    my $collide;
    eval {
        $collide = (
               ($_[0]->x >= $_[1]->x && $_[0]->x < $_[1]->x + $_[1]->w)
            || ($_[1]->x >= $_[0]->x && $_[1]->x < $_[0]->x + $_[0]->w)
           )
           &&
           (
               ($_[0]->y >= $_[1]->y && $_[0]->y < $_[1]->y + $_[1]->h)
            || ($_[1]->y >= $_[0]->y && $_[1]->y < $_[0]->y + $_[0]->h)
           )
           ;
    };
    Carp::croak "elements should have x, y, w, h accessors" if $@;
    return $collide;
}


42;
__END__