| Grid-Coord documentation | Contained in the Grid-Coord distribution. |
Grid::Coord - abstract representation and manipulation of points and rectangles
use Grid::Coord my $point1 = Grid::Coord->new(5,4); # point(y=>5, x=>4) my $rect1 = Grid::Coord->new(2,3 => 6,5); # rectangle print "TRUE" if $rect1->contains($point1); my $rect2 = Grid::Coord->new(3,4 => 5,5); # another rectangle my $rect3 = $rect1->overlap($rect2) # (3,4 => 5,5) print $rect3->stringify; # "(3,4 => 5,5)" print $rect3; # "(3,4 => 5,5)" print "TRUE" if $rect3->equals(Grid::Coord->new(3,4 => 5,5)); print "TRUE" if $rect3 == Grid::Coord->new(3,4 => 5,5);
Manage points or rectangles on a grid. This is generic, and could be used for spreadsheets, ascii art, or other nefarious purposes.
Grid->Coord->new($y, $x); Grid->Coord->new($min_y, $min_x, $max_y, $max_x);
The min_y, min_x, max_y, max_x functions:
print $coord->max_x; # get value $coord->min_x(4); # set value to 4
$c3 = $c1->overlap($c2); print "TRUE" if $rect1->contains($rect2); print "TRUE" if $rect1->equals($rect2);
Four operators are overloaded:
So that print $coord does something reasonable
so that if ($coord1 == $coord2)
does the right thing.
So that $c1 + $c2 is a synonym for $c1-offset($c2)>
So that $c1 - $c2 is a synonym for $c1-delta($c2)>
The iterator returns a Grid::Coord object for each cell in the current Grid::Coord range.
my $it = $grid->cell_iterator; # or ->cell_iterator_rowwise
# my $it = $grid->cell_iterator_colwise; # top to bottom
while (my $cell = $it3->()) {
# do something to $cell
}
You can also iterate columns/rows with $grid->cells_iterator $grid->rows_iterator
None reported yet.
From the author.
osfameron@cpan.org http://osfameron.perlmonk.org/
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
The full text of the license can be found in the LICENSE file included with this module.
perl(1).
| Grid-Coord documentation | Contained in the Grid-Coord distribution. |
package Grid::Coord; use strict; use warnings; use Data::Dumper; use Carp qw/confess/; our $VERSION = '0.05'; # $Id$ ########################################### main pod documentation begin ##
use overload q("") => \&stringify, q(==) => \&equals, q(!=) => \¬_equals, q(+) => \&offset, q(-) => \δ sub new { my $class = shift; if (@_ == 2) { push @_, @_; } elsif (@_ != 4) { die "Grid::Coord objects must be (y,x) or (miny,minx=>maxy,maxx)\n"; } my $self = bless [@_], (ref ($class) || $class); return ($self); } sub min_y { my $self=shift; if (! @_) { return $self->[0] } else { $self->[0] = shift } } sub min_x { my $self=shift; if (! @_) { return $self->[1] } else { $self->[1] = shift } } sub max_y { my $self=shift; if (! @_) { return $self->[2] } else { $self->[2] = shift } } sub max_x { my $self=shift; if (! @_) { return $self->[3] } else { $self->[3] = shift } } sub is_point { my $self = shift; for (0..1) { my ($min, $max) = ($self->[$_], $self->[$_+2]); return unless defined $min && defined $max; return unless $min == $max; } return 1; } sub overlap { my ($self, $other)=@_; if (! $other->isa(__PACKAGE__)) { die "Can't overlap with something that isn't a Grid::Coord object!\n"; } my @coords = ( max($self->min_y, $other->min_y), max($self->min_x, $other->min_x), min($self->max_y, $other->max_y), min($self->max_x, $other->max_x) ); return if ($coords[0] > $coords[2] or $coords[1] > $coords[3]); return $self->new(@coords); } sub contains { my ($self, $other)=@_; if (! $other->isa(__PACKAGE__)) { die "Can't 'contains' with something that isn't a Grid::Coord object!\n"; } return ($self->overlap($other) == $other); } sub stringify { my $self=shift; my @rep = map { defined $_ ? $_ : 'null' } @$self; if ($self->is_point) { return "($rep[0],$rep[1])" } else { return "($rep[0],$rep[1], $rep[2],$rep[3])"; } } sub equals { my ($self, $other) = @_; for (0..3) { return unless (defined $self->[$_]) ? defined $other->[$_] && $self->[$_] == $other->[$_] : ! defined $other->[$_]; } return $self; } sub not_equals { # new versions of Test::Builder seem to make cmp_ok fail on this my ($self, $other) = @_; return ! $self->equals($other); } sub offset { # 'add' 2 ranges together, offsetting them my $self=shift; if (ref $_[0] eq "Grid::Coord") { my $other = shift; my @coords; for (0..3) { push @coords, only($self->[$_],$other->[$_],sub { return $_[0]+$_[1] }) } return $self->new(@coords); } else { return $self->offset($self->new(@_)); } } sub delta { # 'subtract' 2 ranges together, calculating the offest my $self=shift; if (ref $_[0] eq "Grid::Coord") { my $other = shift; my @coords; for (0..3) { push @coords, only($self->[$_],$other->[$_],sub { return $_[1]-$_[0] }) } return $self->new(@coords); } else { return $self->offset($self->new(@_)); } } sub head { my $self=shift; return $self->new($self->[0], $self->[1]) } sub tail { my $self=shift; return $self->new($self->[2], $self->[3]) } sub row {my $self=shift; return $self->new($self->[0],undef,$self->[0],undef)} sub col {my $self=shift; return $self->new(undef, $self->[1],undef,$self->[1])} sub min { return only(@_) || (($_[0] < $_[1]) ? $_[0] : $_[1]) } sub max { return only(@_) || (($_[0] > $_[1]) ? $_[0] : $_[1]) }
sub only { if (! defined $_[0]) { return $_[1]} if (! defined $_[1]) { return $_[0]} if (my $coderef=$_[2]) { return $coderef->(@_) } else { return } } { no warnings 'once'; *cell_iterator=\&cell_iterator_rowwise; } sub cell_iterator_rowwise { my $self=shift; return $self->_cell_iterator( $self->rows_iterator, sub{$self->cols_iterator}); } sub cell_iterator_colwise { my $self=shift; return $self->_cell_iterator( $self->cols_iterator, sub{$self->rows_iterator}); } sub _cell_iterator { # We pass in the major-line iterator as an iterator. # However, as the minor-line iterator will be created # various times, we pass in a factory function instead! my ($self, $maj_it, $min_fac) = @_; my $min_it = $min_fac->(); my $maj=$maj_it->(); return sub { { return unless $maj; if (my $min=$min_it->()) { return $maj->overlap($min) } else { $maj = $maj_it->(); $min_it = $min_fac->(); redo; } } } } sub rows_iterator { my $self=shift; my $row=$self->row; return $self->line_iterator($row, 1, undef); } sub cols_iterator { my $self=shift; my $col=$self->col; return $self->line_iterator($col, undef, 1); } sub line_iterator { my ($self, $orig_line, $y, $x)=@_; my $line=$orig_line; return sub { # TODO: warning on next line in eq #if ($_[0] eq 'clone') { die;return line_iterator($self,$orig_line, $y,$x) } my $old_line = $line; if ($line) { $line = $line->offset($y,$x); if (! $line->overlap($self)) { $line=undef; } } return $old_line; } } 1; #this line is important and will help the module return a true value __END__