view release on metacpan or  search on metacpan

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

package Algorithm::RectanglesContainingDot;

use strict;
use warnings;

our $VERSION = '0.02';

package
     Algorithm::RectanglesContainingDot::Perl;

our $MIN_DIV = 8;

sub new {
    my $class = shift;
    my $self = { rects => [],
                 names => [] };
    bless $self, $class;
}

sub _reset { delete shift->{div} }

sub add_rectangle {
    my ($self, $name, $x0, $y0, $x1, $y1) = @_;

    ($x0, $x1) = ($x1, $x0) if $x0 > $x1;
    ($y0, $y1) = ($y1, $y0) if $y0 > $y1;

    push @{$self->{rects}}, ($x0, $y0, $x1, $y1);
    push @{$self->{names}}, $name;
    delete $self->{div};
}

sub rectangles_containing_dot {
    my $self = shift;
    my $div = $self->{div} || $self->_init_div;
    @{$self->{names}}[_rectangles_containing_dot($div, $self->{rects}, @_)];
}

sub _rectangles_containing_dot_ref {
    my ($self, $x, $y) = @_;
    my $names = $self->{names};
    my $rects = $self->{rects};
    my @ret;
    for (0..$#$names) {
        my $i0 = $_ * 4;
        if ($rects->[$i0] <= $x and
            $rects->[$i0+1] <= $y and
            $rects->[$i0+2] >= $x and
            $rects->[$i0+3] >= $y) {
            push @ret, $names->[$_];
        }
    }
    @ret;
}

# div is:
# x/y, right_div, left_div, point, all

sub _init_div {
    my $self = shift;
    $self->{div} = [undef, undef, undef, undef, [0..$#{$self->{names}}]]
}

sub _rectangles_containing_dot {
    my ($div, $rects, $x, $y) = @_;
    # print ".";
    while (1) {
        my $dir = $div->[0] || _divide_rects($div, $rects);

        if ($dir eq 'n') {
            my @ret;
            for (@{$div->[4]}) {
                my ($x0, $y0, $x1, $y1) = @{$rects}[4*$_ .. 4*$_+3];
                push @ret, $_
                    if ($x >= $x0 and $x <= $x1 and $y >= $y0 && $y <= $y1);
            }
            return @ret;