view release on metacpan or  search on metacpan

lib/Games/Maze.pm  view on Meta::CPAN

#
#                North
#                 (1)
#            :------------:   (200) Down
#            |            |
#            |            |
#     West   |     .      | East
#      (4)   |            | (80)
#            |            |
#            :------------:
#                South
#  Up (10)        (20)
#
#
#
# The legal directions (in hexadecimal) for hexagon cells.
#
#                North
#                 (1)
#               ________      (200) Down
#              /        \
# NorthWest   /          \   NorthEast
#     (2)    /     .      \    (100)
#            \            /
# SouthWest   \          /   SouthEast
#     (8)      \________/       (40)
#                South
#  Up (10)        (20)
#
#
# The maze is represented as a matrix, sized 0..lvls+1, 0..cols+1, 0..rows+1.
# To avoid special "are we at the edge" checks, the outer border
# cells of the matrix are pre-marked, which leaves the cells in the
# area of 1..lvls, 1..cols, 1..rows to generate the maze.
#
# The top level upper left hand cell is the 0,0,0 corner of the maze, be
# it a cube or a honeycomb.  This is why they are called "levels" instead
# of "storeys".
#

my($Debug_make_ascii, $Debug_make_vx) = (0, 0);
my($Debug_solve_ascii, $Debug_solve_vx) = (0, 0);
my($Debug_internal) = 0;


#
# Valid options to new().
#
#
# new
#
# Creates the object with its attributes, listed below.
#

has fn_choosedir => ( is => 'ro', isa => CodeRef );

has upcolumn_even => ( is => 'ro', isa => Bool );

has [qw( _lvls _rows _cols )] => ( is => 'ro', isa => Int );

has [qw( dimensions entry exit start )] => ( is => 'ro', isa => ArrayRef );

has [qw( form cell generate connect )] => ( is => 'ro', isa => Str );

has '+form'     => default => 'Rectangle';
has '+cell'     => default => 'Quad';
has '+connect'  => default => 'Simple';
has '+generate' => default => 'Random';

# Coerce these attributes to ucfirst lc $value
for my $attr (qw( cell form ))
{
	has "+$attr" => trigger => sub
	{
		return if $_[1] =~ /^[A-Z][a-z]+$/;
		$_[0]->{$attr} = ucfirst lc $_[1];
	};
}

sub BUILDARGS
{
	my $self = shift;
	my $args = @_ ? @_ > 1 ? { @_ } : shift : {};

	$args->{dimensions} //= [];
	push @{ $args->{dimensions} }, 3 if (@{ $args->{dimensions} } < 1);
	push @{ $args->{dimensions} }, 3 if (@{ $args->{dimensions} } < 2);
	push @{ $args->{dimensions} }, 1 if (@{ $args->{dimensions} } < 3);

	return $args
}

around new => sub
{
	my $orig = shift;
	my $self = shift;

	# Constructing from existing maze
	if (blessed $self && $self->isa('Games::Maze'))
	{
		my $copy = $self->_copy;
		return bless $copy, ref($self);
	}

	$self = $self->$orig(@_);
	my $class = ref($self);

	# Already a sub-class
	return $self if $self->{cell} && $class =~ $self->{cell};

	# Rebless as sub-class
	$self = bless $self, $class . "::" . $self->{cell};
	return $self->reset;
};

#
# describe
#
# %maze_attr = $obj->describe();
#
# Returns as a hash the attributes of the maze object.