Grid::Coord - abstract representation and manipulation of points and rectangles


Grid-Coord documentation Contained in the Grid-Coord distribution.

Index


Code Index:

NAME

Top

Grid::Coord - abstract representation and manipulation of points and rectangles

SYNOPSIS

Top

  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);

DESCRIPTION

Top

Manage points or rectangles on a grid. This is generic, and could be used for spreadsheets, ascii art, or other nefarious purposes.

USAGE

Top

Constructor

 Grid->Coord->new($y, $x);
 Grid->Coord->new($min_y, $min_x,  $max_y, $max_x);

Accessing coordinates

The min_y, min_x, max_y, max_x functions:

 print $coord->max_x; # get value
 $coord->min_x(4);    # set value to 4

Relationships with other Coords

 $c3 = $c1->overlap($c2);
 print "TRUE" if $rect1->contains($rect2);
 print "TRUE" if $rect1->equals($rect2);

Overloaded operators

Four operators are overloaded:

* the stringification operator

So that print $coord does something reasonable

* the equality operator

so that if ($coord1 == $coord2) does the right thing.

* the add operator

So that $c1 + $c2 is a synonym for $c1-offset($c2)>

* the subtract operator

So that $c1 - $c2 is a synonym for $c1-delta($c2)>

Iterating

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

BUGS

Top

None reported yet.

SUPPORT

Top

From the author.

AUTHOR

Top

	osfameron@cpan.org
	http://osfameron.perlmonk.org/

COPYRIGHT

Top

SEE ALSO

Top

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(!=) => \&not_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__