File Coverage

blib/lib/Algorithm/BreakOverlappingRectangles.pm

Criterion	Covered	Total	%
statement	71	103	68.9
branch	9	20	45.0
condition			n/a
subroutine	17	22	77.2
pod	4	6	66.6
total	101	151	66.8

package Algorithm::BreakOverlappingRectangles;

use strict;
use warnings;

BEGIN {
  our $VERSION = '0.01';

  require XSLoader;
  XSLoader::load('Algorithm::BreakOverlappingRectangles', $VERSION);
}


use constant X0 => 0;
use constant Y0 => 1;
use constant X1 => 2;
use constant Y1 => 3;

our $verbose = 0;

use constant NVSIZE => length pack F => 1.0;
use constant IDOFFSET => NVSIZE * 4;

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

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

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

    my @ids;
    for (@names) {
        my $id = $self->{name2id}{$_};
        unless (defined $id) {
            $id = $self->{name2id}{$_} = @{$self->{names}};
            push @{$self->{names}}, $_;
        }
        push @ids, $id;
    }

    push @{$self->{rects}}, pack 'F4L*' => $x0, $y0, $x1, $y1, @ids;
    delete $self->{broken};
    ++($self->{n});
}

sub _do_break {
    my $self = shift;
    _break_rectangles $self->{rects};
    $self->{broken} = 1;
    $self->{iter} = 0;
}

* _brute_force_break = \&_brute_force_break_xs;

sub dump {
    my $self = shift;
    $self->_do_break unless $self->{broken};
    for (@{$self->{rects}}) {
        my ($x0, $y0, $x1, $y1, @ids) = unpack 'F4L*' => $_;
        my @names = map $self->{names}[$_], @ids;
        # my @names = @ids;
        print "[$x0 $y0 $x1 $y1 | @names]\n";
    }

    print "$self->{n} rectangles broken into ".(scalar @{$self->{rects}})."\n";

}

sub dump_stats {
    my $self = shift;
    $self->_do_break unless $self->{broken};
    print "$self->{n} rectangles broken into ".(scalar @{$self->{rects}})."\n";
}

sub get_rectangles {
    my $self = shift;
    $self->_do_break unless $self->{broken};
    my $names = $self->{names};
    map {
        my @a = unpack "F4I*" => $_;
        $a[$_] = $names->[$a[$_]] for (4..$#a);
        \@a;
    } @{$self->{rects}}
}


sub get_rectangles_as_array_ref {
    my $self = shift;
    tie my @iter, 'Algorithm::BreakOverlappingRectangles::Iterator', $self;
    return \@iter;
}

package Algorithm::BreakOverlappingRectangles::Iterator;

use base 'Tie::Array';

sub TIEARRAY {
    my ($class, $abor) = @_;
    my $self = bless \$abor, $class;
}

sub FETCH {
    my ($self, $index) = @_;
    my $abor = $$self;
    $abor->_do_break unless $abor->{broken};
    my $r = $abor->{rects}[$index];
    if (defined $r) {
        # print ".";
        my $names = $abor->{names};
        my ($x0, $y0, $x1, $y1, @ids) = unpack 'F4I*' => $r;
        return [$x0, $y0, $x1, $y1, map($names->[$_], @ids)];
    }
    ()
}

sub EXISTS {
    my ($self, $index) = @_;
    my $abor = $$self;
    $abor->_do_break unless $abor->{broken};
    my $rects = $abor->{rects};
    return (@$rects > $index);
}

sub FETCHSIZE {
    my ($self) = @_;
    my $abor = $$self;
    $abor->_do_break unless $abor->{broken};
    my $rects = $abor->{rects};
    return scalar(@$rects);
}

sub PUSH {
    my $self = shift;
    $self->[0] = 0;
    my $abor = $$self;
    $abor->add_rectangle(@$_) for (@_);
    1;
}


1;

__END__