=head1 NAME

Array::Tour - Base class for Array Tours.

=head1 SYNOPSIS

  #
  # For a new package.  Add extra methods and internal attributes afterwards.
  #
  package Array::Tour::NewTypeOfTour
  use base qw(Array::Tour);
  
  # (Code goes here).

or

  #
  # Make use of the constants in the package. 
  #
  use Array::Tour qw(:directions);
  use Array::Tour qw(:status);

or

  #
  # Use Array::Tour for its default 'typewriter' tour of the array.
  #
  use Array::Tour;
  
  my $by_row = Array::Tour->new(dimensions => [24, 80, 1]);
  

=head1 PREREQUISITES

Perl 5.8 or later. This is the version of perl under which this module
was developed.

=head1 DESCRIPTION

Array::Tour is a base class for iterators that traverse the cells of an
array. This class should provide most of the methods needed for any type
of tour, whether it needs to visit each cell or not, and whether
the tour needs to be a continuous path or not.

The iterator provides coordinates and directions.  It does not define
the array.  This leaves the user of the tour object free to
define the form of the array or the data structure behind it without
restrictions from the tour object.

By itself without any subclassing or options, the Array::Tour class traverses a
simple left-to-right, top-to-bottom typewriter path. There are options to change
the direction or rotation of the path.

=cut

package Array::Tour;
use 5.008;
use strict;
use warnings;
use integer;

use vars qw(@ISA);
require Exporter;

@ISA = qw(Exporter);

use vars qw(%EXPORT_TAGS @EXPORT_OK);
%EXPORT_TAGS = (
	'directions' => [ qw ( NoDirection
		North NorthWest West SouthWest Ceiling
		South SouthEast East NorthEast Floor
		SetPosition
	)],
	'status' => [ qw (START TOURING STOP)]
);

@EXPORT_OK = ( @{ $EXPORT_TAGS{'directions'} }, @{ $EXPORT_TAGS{'status'} } );

our $VERSION = '0.04';

#
# Directions.
#
# The eight possible directions that one can move from a cell, including
# "null" direction NoDirection, and position change indicator SetPosition.
#
use constant NoDirection => 0x0000;
use constant North       => 0x0001;	# 0;
use constant NorthWest   => 0x0002;	# 1;
use constant West        => 0x0004;	# 2;
use constant SouthWest   => 0x0008;	# 3;
use constant Ceiling     => 0x0010;	# 4;
use constant South       => 0x0020;	# 5;
use constant SouthEast   => 0x0040;	# 6;
use constant East        => 0x0080;	# 7;
use constant NorthEast   => 0x0100;	# 8;
use constant Floor       => 0x0200;	# 9;
use constant SetPosition => 0x8000;	# 15;

#
# {tourstatus} constants.
#
use constant START	=> 0;
use constant TOURING	=> 1;
use constant STOP	=> 2;


=head2 Tour Object Methods

=head3 new([<attribute> => value, ...])

Creates the object with its attributes.

Since attributes are set using the internal method _set(), it's recommended that
subclasses do not override new(), but provide their own _set() method to handle
their own attributes instead.

Four attributes start out available from the base class, C<dimensions>,
C<offset>, C<position>, and C<start>.

These four attributes are automatically set before calling the C<_set()>
method:

=over 4

=item dimensions

I<Default value: [1, 1, 1].> Provide the size of the array:

  my $spath1 = Array::Tour->new(dimensions => [16, 16, 1]);

The dimensions attribute represents a three-dimensional array, defined by rows,
columns, and levels.  If you are interested only in a two-dimensional array,
you don't need to specify the third dimension -- it will be added on for you:

  my $spath1 = Array::Tour->new(dimensions => [16, 16]);

This has the exact same effect as the code above it.

In fact the B<dimensions> attribute is so forgiving that if you are only
interested in a simple square array, this will be sufficient:

    my $spath1 = Array::Tour->new(dimensions => 16);

The attribute will detect the single dimension, duplicate it, and add the
third dimension of 1.  You will have the same dimensions as the previous
examples.

=back

=cut

sub new
{
	my $class = shift;
	my $self = {};

	#
	# We are copying from an existing Tour object?
	#
	if (ref $class)
	{
		if ($class->isa("Array::Tour"))
		{
			$class->_copy($self, @_);
			return bless($self, ref $class);
		}

		warn "Attempts to create an Array Touring object from a '",
			ref $class, "' object fail.\n";
		return undef;
	}

	#
	# Starting from scratch.
	#
	bless($self, $class);
	my %attributes = @_;
	$self->_set_dimensions(%attributes);
	$self->_set_offset(%attributes);
	delete @attributes{qw(dimensions offset)};
	$self->{position} = [0, 0, 0];
	$self->{start} = [0, 0, 0];
	$self->{array} = undef;
	$self->{tourlength} = 1;
	map {$self->{tourlength} *= $_} $self->get_dimensions();
	$self->{tourstatus} = START;
	$self->{odometer} = 0;
	$self->_set(%attributes);

	return $self;
}

=head3 reset([<attribute> => value, ...])

Reset the object by returning its internal state to its original form.
Optionally change some of the characteristics using the same parameters
found in the new() method.

=cut

sub reset
{
	my $self = shift;
	my %newargs = @_;

	my %params = $self->describe();
	$params{position} = [0, 0, 0];
	$params{tourlength} = 1;
	$params{tourstatus} = START;
	$params{odometer} = 0;

	#
	# Apply any options passed in.
	#
	map {$params{$_} = $newargs{$_}} keys %newargs;

	return $self->_set(%params);
}

=head3 has_next()

Returns 1 if there is more to the tour, 0 if finished.

=cut

sub has_next
{
	my $self = shift;
	return ($self->{tourstatus} == STOP)? 0: 1;
}

=head3 get_dimensions()

Returns an array of the dimensions.

=cut

sub get_dimensions
{
	my $self = shift;
	return @{$self->{dimensions}};
}

=head3 direction()

Returns the current direction as found in the :directions EXPORT tag.

=cut

sub direction
{
	my $self = shift;
	return (${$self->{position}}[0] == 0)? NoDirection: East;
}

=head3 opposite_direction()

Return the direction opposite from the current direction.

=cut

sub opposite_direction
{
	my $self = shift;
	my $dir = $self->direction();
	return NoDirection if ($dir == NoDirection);
	return ($dir <=  Ceiling )? ($dir << 5): ($dir >> 5);
}

=head3 say_direction

Return the name in English of the current direction.

=cut

sub say_direction
{
	my $self = shift;
	my $dir = $self->direction();

	return $self->direction_name($dir);
}

=head3 direction_name

Return the name in English of the direction passed in.

   print $tour->direction_name(NorthWest), " is ", NorthWest, "\n";

=cut

sub direction_name
{
	my $self = shift;
	my($dir) = @_;

	return q(NoDirection) if ($dir == NoDirection);
	return q(North) if ($dir == North);
	return q(NorthWest) if ($dir == NorthWest);
	return q(West) if ($dir == West);
	return q(SouthWest) if ($dir == SouthWest);
	return q(Ceiling) if ($dir == Ceiling);
	return q(South) if ($dir == South);
	return q(SouthEast) if ($dir == SouthEast);
	return q(East) if ($dir == East);
	return q(NorthEast) if ($dir == NorthEast);
	return q(Floor) if ($dir == Floor);
	if ($dir == SetPosition)
	{
		my @p = @{$self->get_position()};
		return q(SetPosition) . "[" . join(", ", @p) . "]";
	}
	return q(unknown direction);
};

=head3 get_position

Return a reference to an array of coordinates of the current position.

    @absolute_pos = @{$self->get_position()};

=cut

sub get_position
{
	my $self = shift;
	return $self->{position};
}

=head3 get_offset

Return a reference to an array of offsets to be added to the current position.

    @offset = @{$self->get_offset()};

=cut

sub get_offset
{
	my $self = shift;
	return $self->{offset};
}

=head3 adjusted_position

Return a reference to an array of coordinates that are created from the position
plus the offset. Used by the next() method.

    @current_pos = @{$self->adjusted_position()};

=cut

sub adjusted_position
{
	my $self = shift;

	my @position = @{ $self->{position} };
	my @offset = @{ $self->{offset} };
	map {$position[$_] += $offset[$_]} (0..$#position);
	return \@position;
}

=head3 next()

Returns an array reference to the next coordinates to use. Returns
undef if the iterator is finished.

    my $ctr = 1;
    my $tour = Array::Tour->new(dimensions => 64);

    while (my $cref = $tour->next())
    {
        my($x_coord, $y_coord, $z_coord) = @{$cref};
        $grid[$y_coord, $x_coord] = isprime($ctr++);
    }

The above example would look like a completed Sieve of Eratothenes in the array
@grid.

=cut

sub next
{
	my $self = shift;

	return undef unless ($self->has_next());

	#
	# Set up the conditions for the pacing.
	#
	if ($self->{tourstatus} == START)
	{
		$self->{tourstatus} = TOURING;
	}
	else
	{
		#
		# Move to the next cell, checking to see if we've
		# reached the end of the row/plane/cube.
		#
		my($dim, $lastdim) = (0, scalar @{$self->{dimensions}});
		while ($dim < $lastdim and ${$self->{position}}[$dim] == ${$self->{dimensions}}[$dim] - 1)
		{
			${$self->{position}}[$dim++] = 0;
		}
		${$self->{position}}[$dim] += 1 unless ($dim == $lastdim);
	}

	$self->{tourstatus} = STOP if (++$self->{odometer} == $self->{tourlength});
	return $self->adjusted_position();
}

=head3 uses_array

Returns 0 or 1 depending upon whether there's an internal
array to return.
=cut

sub uses_array {my $self = shift; return 0;}


=head3 get_array

Return a reference to the internally generated array.

    $arrayref = $self->get_array()

=cut

sub get_array
{
	my $self = shift;
	$self->_make_array() unless (defined $self->{array});
	return $self->{array};
}

=head3 describe()

Returns as a hash the attributes of the tour object. The hash may be
used to create a new object.

=cut

sub describe
{
	my $self = shift;
	return map {$_, $self->{$_}} grep(/^[a-z]/, keys %{$self});
}

#
# $self->_set(%attributes);
#
# Set the attributes that were passed in via new().
# This one's pretty minimal because the attributes
# that we care about in this class are already set.
#
=head3 _set()

Take the parameters provided to new() and use them to set the
attributes of the touring object.

=cut

sub _set()
{
	my $self = shift;
	my(%params) = @_;

	warn "Unknown paramter $_" foreach (grep{$_ !~ /reverse/} (keys %params));
	return $self;
}

#
# $self = $self->_set_dimensions($params);
#
# Sets the {dimensions} attribute of the object to an
# array reference.  If a value N is provided instead of
# an array reference, an NxN square array is created.
#
# In all cases, the reference returned has at least three dimensions.
# The third dimension is 1 by default.
#
=head3 _set_dimensions()

    my @dims = Array::Tour->new(dimensions => [12, 16]);

If the grid is going to be square, a single integer is sufficient:

    my @dims = Array::Tour->new(dimensions => 16);

In both cases, the C<dimensions> attribute is set with a reference to
a three dimensional array.  The third dimension is set to 1 if no value
is given for it.

=cut

sub _set_dimensions
{
	my $self = shift;
	my(%params) = @_;
	my $dim = $params{dimensions} || [1, 1, 1];

	my @dimensions;

	if (ref $dim eq 'ARRAY')
	{
		@dimensions = map {$_ ||= 1} @{$dim};
		push @dimensions, 1 if (@dimensions < 1);
		push @dimensions, $dimensions[0] if (@dimensions < 2);
	}
	else
	{
		#
		# Square grid if only one dimension is defined.
		#
		@dimensions = ($dim) x 2;
	}
	push @dimensions, 1 if (@dimensions < 3);
	$self->{dimensions} = \@dimensions;

	return $self;
}

#
# @offsets = _set_offset($offsetref);
#
# Set the offset. This method extends the offset array by zeros
# to match the size of the dimensions array.
#
# Method _set_dimensions() must be called beforhand.
#
sub _set_offset
{
	my $self = shift;
	my(%params) = @_;
	my $offsetref = $params{offset} || [0, 0, 0];

	$self->{offset} = $offsetref;

	my $dims = scalar @{$self->{dimensions}};
	my $offsets = scalar @{$self->{offset}};
	push @{$self->{offset}}, (0) x ($dims - $offsets) if ($dims > $offsets);
	return @{$self->{offset}};
}

#
# $self->_make_array();
# $self->_make_array($default_value);
#
# Make an internal array for reference purposes.  The array cells are
# set to zero by default, but a different default value may be passed in.
#
sub _make_array
{
	my $self = shift;
	my $dflt = (scalar @_)? $_[0]: 0;
	my($rows, $cols, $lvls) = map {$_ - 1} @{$self->{dimensions}};

	my $m = $self->{array} = ([]);
	foreach my $l (0..$lvls)
	{
		foreach my $r (0..$rows)
		{
			foreach my $c (0..$cols)
			{
				$$m[$l][$r][$c] = $dflt;
			}
		}
	}
	return $self;
}

#
# dump_array
#
# @xlvls = $obj->dump_array($spr_fmt);
# $xstr = $obj->dump_array($spr_fmt);
#
# Returns a formatted string of all the cell values.  By default,
# the format string is " %04x", so the default output strings will
# be rows of hexadecimal numbers separated by a space.
#
# If called in a list context, returns a list of strings, each one
# representing a level. If called in a scalar context, returns a single
# string, each level separated by a single newline.
#
sub dump_array
{
	my $self = shift;
	my $format = $_[0] || " %04x";
	my($rows, $cols, $lvls) = map {$_ - 1} @{$self->{dimensions}};
	my $m = $self->{array};
	my @levels;

	foreach my $l (0..$lvls)
	{
		my $vxstr = "";
		foreach my $r (0..$rows)
		{
			foreach my $c (0..$cols)
			{
				$vxstr .= sprintf($format, $$m[$l][$r][$c]);
			}
			$vxstr .= "\n";
		}

		push @levels, $vxstr;
	}

	return wantarray? @levels: join("\n", @levels);
}

#
# [$c, $r, $l] = $self->_move_to($direction);
#
# Return a new position depending upon the direction taken.
#
sub _move_to
{
	my $self = shift;
	my($dir) = @_;
	my($c, $r, $l) = @{ $self->{position} };

	--$r if ($dir & (North | NorthWest | NorthEast));
	++$r if ($dir & (South | SouthWest | SouthEast));
	++$c if ($dir & (East  | NorthEast | SouthEast));
	--$c if ($dir & (West  | NorthWest | SouthWest));
	++$l if ($dir & Floor);
	--$l if ($dir & Ceiling);
	return [$c, $r, $l];
}

#
# $class->_copy($self);
#
# Duplicate the iterator.
#
sub _copy
{
	my($other, $self) = @_;
	foreach my $k (grep($_ !~ /_array/, keys %{$other}))
	{
		$self->{$k} = $other->{$k};
	}
	if ($other->uses_array())
	{
		# copy it.
	}
}

1;
__END__

=head2 Internal Tour Object Methods

=head2 Methods expected to be provided by the derived class.

These methods exist in the base class, but don't do much that is
useful. The deriving class is expected to override these methods.

=head2 Subclassing

Array::Tour keeps track of its state through internal attributes that are
sufficient for its purposes.  Derived classes will probably need to add
their own attributes.

=over 4

=item dimensions

I<Default value: [1, 1, 1].>  Passed in via method new() using the dimensions
key, which sets it through the set_dimensions() method.

=item offset

I<Default value: [0, 0, 0].> The coordinate of the upper left corner.
Calls to get_coordinates() will return the position adjusted by the value
in C<offset>.

=item start

I<Default value: [0, 0, 0].> The starting position of the tour.  Set
automatically in this class.

=item position

The current position of the iterator in the array.

=back

There are also internal attributes that are used to control the behavior
of an Array::Tour object. These have default values that you may
override in your sub-class:

=over 4

=item odometer

I<Starting value: 0.> The number of cells visited thus far.

=item tourlength

I<Default value: number of cells in the array.> The total number of cells
to visit. This is sometimes used to determine the endpoint of the tour.

=item tourstatus

Initially set to B<START>.  The remaining _tourstatus values (found with
the export tag C<:status>) are B<TOURING> and B<STOP>.

=item array

I<default value: undef.>  A reference to an internal array.  Some sub-classes
need an internal array for bookkeeping purposes.  This is where it will go.
The method _make_array() will create an internal array for a sub-class if it is
needed.

=back

=head2 Current Tours

This, the base class, performs a typewriter left to right tour of the array. If
the array has a third dimension, it will go to the next level after completing
the tour of the rows of the current level.

The subclasses that come with this package are:

L<Spiral|Array::Tour::Spiral>

L<Serpentine|Array::Tour::Serpentine>

L<RandomWalk|Array::Tour::RandomWalk>

There may be other tours under development.  See the Changes file for more information.

=head2 EXPORT

The :directions EXPORT tag will let you use the constants that indicate
direction.  They are the directions C<North>, C<NorthEast>, C<East>,
C<SouthEast>, C<South>, C<SouthWest>, C<West>, and C<NorthWest>.

The :status EXPORT tag has the values for the running state of the
iterator.

=head2 See Also

=head1 AUTHOR

John M. Gamble may be found at <jgamble@cpan.org>

=cut
