view release on metacpan or  search on metacpan

lib/Algorithm/QuadTree.pm  view on Meta::CPAN

package Algorithm::QuadTree;
$Algorithm::QuadTree::VERSION = '0.5';
use strict;
use warnings;
use Carp;

###############################
#
# Creating a new QuadTree objects automatically
# segments the given area into quadtrees of the
# specified depth.
#
# Arguments are a hash:
#
# -xmin  => minimum x value
# -xmax  => maximum x value
# -ymin  => minimum y value
# -ymax  => maximum y value
# -depth => depth of tree
#
###############################

BEGIN {
	require Algorithm::QuadTree::PP;
	my $backend = 'Algorithm::QuadTree::PP';

	my $check_backend = $ENV{ALGORITHM_QUADTREE_BACKEND} || 'Algorithm::QuadTree::XS';
	if (eval "require $check_backend; 1;") {
		$backend = $check_backend;
	}

	$backend->import;
}

# List::Util 1.45 added 'uniqstr'
use constant HAS_LIST_UTIL => eval { require List::Util; List::Util->VERSION('1.45'); 1 };

sub new
{
	my $self  = shift;
	my $class = ref($self) || $self;
	my %args = @_;

	my $obj = bless {}, $class;

	for my $arg (qw/xmin ymin xmax ymax depth/) {
		unless (exists $args{"-$arg"}) {
			carp "- must specify $arg";
			return undef;
		}

		$obj->{uc $arg} = $args{"-$arg"};
	}

	$obj->{ORIGIN} = [0, 0];
	$obj->{SCALE} = 1;

	_AQT_init($obj);

	return $obj;
}

sub DESTROY
{
	my ($self) = @_;

	_AQT_deinit($self);
}

# modify coords according to window
sub _adjustCoords
{
	my ($self, @coords) = @_;

	if (@coords == 4) {
		# rectangle

		$_ = $self->{ORIGIN}[0] + $_ / $self->{SCALE}
			for $coords[0], $coords[2];
		$_ = $self->{ORIGIN}[1] + $_ / $self->{SCALE}
			for $coords[1], $coords[3];
	}
	elsif (@coords == 3) {
		# circle

		$coords[0] = $self->{ORIGIN}[0] + $coords[0] / $self->{SCALE};
		$coords[1] = $self->{ORIGIN}[1] + $coords[1] / $self->{SCALE};
		$coords[2] /= $self->{SCALE};
	}

	return @coords;
}

sub add
{
	my ($self, $object, @coords) = @_;

	# assume that $object is unique.
	# assume coords are (xmin, ymix, xmax, ymax) or (centerx, centery, radius)

	@coords = $self->_adjustCoords(@coords)
		unless $self->{SCALE} == 1;

	_AQT_addObject($self, $object, @coords);