File Coverage

blib/lib/Games/Maze.pm

Criterion	Covered	Total	%
statement	452	502	90.0
branch	177	226	78.3
condition	57	100	57.0
subroutine	39	42	92.8
pod	9	10	90.0
total	734	880	83.4

package Games::Maze;
use 5.016001;

use Carp;
use Moo;
use Types::Standard qw( ArrayRef Str Bool CodeRef Int );
use Scalar::Util qw( blessed );

our $VERSION = '1.09';


our $North      = 0x0001;	# 0;
our $NorthWest  = 0x0002;	# 1;
our $West       = 0x0004;	# 2;
our $SouthWest  = 0x0008;	# 3;
our $Ceiling    = 0x0010;	# 4;
our $South      = 0x0020;	# 5;
our $SouthEast  = 0x0040;	# 6;
our $East       = 0x0080;	# 7;
our $NorthEast  = 0x0100;	# 8;
our $Floor      = 0x0200;	# 9;
our $Path_Mark  = 0x8000;	# 15;

#
# So, in bytes, cells are the bit sum of:
#
# 1  0  | 3  2  1  0  | 3  2  1  0
# ------+-------------+-----------
# F  NE | E  SE S  C  | SW W  NW N
#
#
#                200 (down)
#
#       002   001   100
#          \   |   /
#           \  |  /
#            \ | /
#             \|/
#  004 --------+-------- 080
#             /|\
#            / | \
#           /  |  \
#          /   |   \
#      008    020    040
#
#          010 (up)
#
# Path_Mark = 8000
#
# The legal directions (in hexadecimal) for square cells.
#
#
#                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.
#
# Only keys that don't begin with an underscore
# are allowed to be seen.
#
sub describe()
{
	my $self = shift;

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

#
# internals
#
# %maze_attr = $obj->internals();
#
# Returns as a hash the hidden internal attributes of the maze object.
#
# Only keys that begin with an underscore (excepting _corn)
# are allowed to be seen.
#
sub internals()
{
	my $self = shift;

	return map {$_, $self->{$_}} grep(/^_(?!corn)/, keys %{$self});
}

#
# reset
#
# Resets the matrix m. You should not normally need to call this method,
# as the other methods will call it when needed.
#
sub reset
{
	my $self = shift;
	my($l, $c, $r);

	$self->{_corn} = ([]);
	$self->{form} = 'Rectangle' unless (exists $self->{form});
	$self->{generate} = 'Random';
	$self->{connect} = 'Simple';

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

	#
	# Now that we've got one level reset, copy it to the rest.
	#
	my $m = $self->{_corn};

	foreach $l (2..$self->{_lvls})
	{
		foreach $r (0..$self->{_rows} + 1)
		{
			foreach $c (0..$self->{_cols} + 1)
			{
				$$m[$l][$r][$c] = $$m[1][$r][$c];
			}
		}
	}

	#
	# Top and bottom border levels.  Removing the floor is good enough.
	#
	foreach $r (0..$self->{_rows} + 1)
	{
		foreach $c (0..$self->{_cols} + 1)
		{
			$$m[0][$r][$c] =
				$$m[$self->{_lvls} + 1][$r][$c] = $Floor;
		}
	}

	#
	# Now that the internals are set, do the same for
	# the entry, exit coordinates.
	#
	$self->_set_entry_exit();

	$self->{_status} = 'reset';
	return $self;
}

#
# make
#
# $obj->make();
#
# Perform a random walk through the walls of the grid. This creates a
# simply-connected maze.
#
sub make
{
	my $self = shift;
	my(@queue, @dir);

	my($c, $r, $l) = $self->_get_start_point();
	my $choose_dir = $self->{fn_choosedir} || \&_random_dir;

	$self->reset() if ($self->{_status} ne 'reset');

	for (;;)
	{
		@dir = $self->_collect_dirs($c, $r, $l);

		#
		# There is a cell to break into.
		#
		if (@dir > 0)
		{
			#
			# If there were multiple choices, save it
			# for future reference.
			#
			push @queue, ($c, $r, $l) if (@dir > 1);

			#
			# Choose a wall at random and break into the next cell.
			#
			($c, $r, $l) = $self->_break_thru($choose_dir->(\@dir, [$c, $r, $l]),
							$c, $r, $l);

			print STDERR $self->to_hex_dump() if ($Debug_make_vx);
			print STDERR $self->to_ascii() if ($Debug_make_ascii);
		}
		else	# No place to go, back up.
		{
			last if (@queue == 0);	# No place to back up, quit.
			($c, $r, $l) = splice @queue, 0, 3;
		}
	}

	$self->_add_egress();
	$self->{_status} = 'make';
	return $self;
}

#
# solve
#
# $obj->solve();
#
# Finds a solution to the maze by examining a path until a
# dead end is reached.
#
sub solve
{
	my $self = shift;

	$self = $self->make() if ($self->{_status} ne 'make');
	return undef unless ($self);

	my $dir = $North;;
	my($c, $r, $l, $fin_c, $fin_r, $fin_l) = $self->_get_entry_exit();

	$self->_toggle_pathmark($c, $r, $l);

	while ($c != $fin_c or $r != $fin_r or $l != $fin_l)
	{
		my($cc, $rr, $ll);

		#
		# Look around for an open wall (bit == 1).
		#
		while (1)
		{
			$dir = $self->_next_direct($dir);
			last if ($self->_wall_open($dir, $c, $r, $l));
		}

		#
		# Mark (or unmark) the cell we are about to enter (or leave).
		#
		($dir, $cc, $rr, $ll) = $self->_move_thru($dir, $c, $r, $l);

		if ($self->_on_pathmark($cc, $rr, $ll))
		{
			$self->_toggle_pathmark($c, $r, $l);
		}
		else
		{
			$self->_toggle_pathmark($cc, $rr, $ll);
		}

		($c, $r, $l) = ($cc, $rr, $ll);

		print $self->to_hex_dump() if ($Debug_solve_vx);
		print $self->to_ascii() if ($Debug_solve_ascii);
	}

	$self->{_status} = 'solve';
	return $self;
}

#
# unsolve
#
# $obj->unsolve();
#
# Erase the path left by the solve() method.
#
sub unsolve
{
	my $self = shift;

	return $self if ($self->{_status} eq 'make');

	if ($self->{_status} eq 'solve')
	{
		my $m = $self->{_corn};
		my $allwalls = $North|$NorthWest|$West|$SouthWest|$Ceiling|
				$South|$SouthEast|$East|$NorthEast|$Floor;

		foreach my $l (1..$self->{_lvls})
		{
			foreach my $r (1..$self->{_rows})
			{
				foreach my $c (1..$self->{_cols})
				{
					$$m[$l][$r][$c] &= $allwalls;
				}
			}
		}
		$self->{_status} = 'make';
	}
	else
	{
		$self = $self->make();
	}

	return $self;
}

#
# to_hex_dump
#
# @xlvls = $obj->to_hex_dump();
# $xstr = $obj->to_hex_dump();
#
# Returns a formatted hexadecimal string all of the cell values, including
# the border cells, but excluding the all-border 0th and level+1 levels.
#
# 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 to_hex_dump
{
	my $self = shift;
	my $m = $self->{_corn};
	my @levels;

	foreach my $l (1..$self->{_lvls})
	{
		my $vxstr = "";
		foreach my $r (0..$self->{_rows} + 1)
		{
			foreach my $c (0..$self->{_cols} + 1)
			{
				$vxstr .= sprintf(" %04x", $$m[$l][$r][$c]);
			}
			$vxstr .= "\n";
		}

		push @levels, $vxstr;
	}

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

#
# $class->_copy($self);
#
# Duplicate the maze object.
#
sub _copy
{
	my($other, $self) = @_;

	#
	# Direct copy of all keys, except for '_corn', which
	# we'll do with a deeper copy.
	#
	foreach my $k (grep($_ !~ /_corn/, keys %{$other}))
	{
		$self->{$k} = $other->{$k};
	}

	$self->{_corn} = ([]);
	my $m = $self->{_corn};
	my $o = $other->{_corn};

	foreach my $l (0..$other->{_lvls} + 1)
	{
		foreach my $r (0..$other->{_rows} + 1)
		{
			foreach my $c (0..$other->{_cols} + 1)
			{
				$$m[$l][$r][$c] = $$o[$l][$r][$c];
			}
		}
	}

	return $self;
}

#
# Default mechanism to perform the random walk.
#
sub _random_dir
{
	return ${$_[0]}[int(rand(@{$_[0]}))];
}

#
# ($start_c, $start_r, $start_l, $fin_c, $fin_r, $fin_l) = $obj->_get_entry_exit();
#
sub _get_entry_exit
{
	my $self = shift;

	return (@{ $self->{entry} },
		@{ $self->{exit} });
}

#
# Knock down the walls that represent the entrance and exit.
#
sub _add_egress
{
	my $self = shift;
	my $m = $self->{_corn};

	my @egress = $self->_get_entry_exit();

	#
	# This is for the to_ascii() method.
	#
	$$m[$egress[2]][$egress[1] - 1][$egress[0]] |= $South;

	$$m[$egress[2]][$egress[1]][$egress[0]] |= $North;
	$$m[$egress[5]][$egress[4]][$egress[3]] |= $South;

	return $self;
}


#
# $obj->_break_thru($wall, $c, $r, $l)
#
# Mark a wall as broken through.  Go through that wall
# to the next cell.  Mark the equivalent wall in that
# cell as broken through as well.
#
# Return the new column/row/level of the new cell.
#
sub _break_thru
{
	my $self = shift;
	my($wall, $c, $r, $l) = @_;
	my $m = $self->{_corn};

	$$m[$l][$r][$c] |= $wall;
	($wall, $c, $r, $l) = $self->_move_thru($wall, $c, $r, $l);
	$$m[$l][$r][$c] |= $wall;

	return ($c, $r, $l);
}

#
# if ($obj->_wall_open($dir, $c, $r, $l)) {...}
#
sub _wall_open
{
	my $self = shift;
	my($dir, $c, $r, $l) = @_;
	my $m = $self->{_corn};

	return ($$m[$l][$r][$c] & $dir) != 0;
}

#
# $obj->_toggle_pathmark($c, $r, $l)
#
# No return value.
#
sub _toggle_pathmark
{
	my $self = shift;
	my($c, $r, $l) = @_;
	my $m = $self->{_corn};

	$$m[$l][$r][$c] ^= $Path_Mark;
}

#
# if ($obj->_on_pathmark($c, $r, $l)) {...}
#
sub _on_pathmark
{
	my $self = shift;
	my($c, $r, $l) = @_;
	my $m = $self->{_corn};

	return (($$m[$l][$r][$c] & $Path_Mark) == $Path_Mark);
}

#
# Games::Maze::Quad - Create 3-D maze objects.
#
# Maze creation is done through the maze object's methods, listed below:
#
package Games::Maze::Quad;

use Moo;
extends 'Games::Maze';

use Carp;

our $VERSION = '1.09';

#
# to_ascii
#
# Translate the maze into a string of ascii 7-bit characters. If called in
# a list context, return as a list of levels. Otherwise returned as a
# single string, each level separated by a single newline.
#
sub to_ascii
{
	my $self = shift;
	my $m = $self->{_corn};
	my @levels = ();
	my($c, $r, $l);

	my(%horiz_walls) = (
		(0      , ":--"),
		($South  , ":  ")
	);

	my(%verti_walls) = (
		(0                              , "|  "),
		($West                           , "   "),
		($Path_Mark                      , "| *"),
		($West|$Path_Mark                 , "  *"),
		($Floor                          , "|f "),
		($West|$Floor                     , " f "),
		($Path_Mark|$Floor                , "|f*"),
		($West|$Path_Mark|$Floor           , " f*"),
		($Ceiling                        , "|c "),
		($West|$Ceiling                   , " c "),
		($Path_Mark|$Ceiling              , "|c*"),
		($West|$Path_Mark|$Ceiling         , " c*"),
		($Floor|$Ceiling                  , "|b "),
		($West|$Floor|$Ceiling             , " b "),
		($Path_Mark|$Floor|$Ceiling        , "|b*"),
		($West|$Path_Mark|$Floor|$Ceiling   , " b*")
	);

	foreach $l (1..$self->{_lvls})
	{
		my $lvlstr = "";

		#
		# End of all rows for this level.  Print the closing South walls.
		#
		foreach $c (1..$self->{_cols} + 1)
		{
			$lvlstr .= $horiz_walls{$$m[$l][0][$c] & $South};
		}

		$lvlstr .= "\n";

		foreach $r (1..$self->{_rows})
		{
			foreach $c (1..$self->{_cols} + 1)
			{
				my($v) = $$m[$l][$r][$c] & ($West|$Path_Mark|$Floor|$Ceiling);
				$lvlstr .= $verti_walls{$v};
			}


			$lvlstr .= "\n";

			foreach $c (1..$self->{_cols} + 1)
			{
				$lvlstr .= $horiz_walls{$$m[$l][$r][$c] & $South};
			}

			$lvlstr .= "\n";
		}

		push @levels, $lvlstr;
	}

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

#
# _set_internals
#
# Sets the internal values of the maze, and resets the first level of the maze.
#
sub _set_internals
{
	my $self = shift;
	my($c, $r);

	#
	# Check the dimensions for correctness.
	#
	my($cols, $rows, $lvls) = @{ $self->{dimensions} };

	if ($self->{form} eq 'Rectangle')
	{
		if ($cols < 2 or $rows < 2 or $lvls < 1)
		{
			carp "Minimum column, row, and level dimensions are 2, 2, 1";
			return undef;
		}
		$self->{_rows} = $rows;
		$self->{_cols} = $cols;
		$self->{_lvls} = $lvls;
	}
	else
	{
		carp "Unknown form requested for ", __PACKAGE__, ".\n";
		return undef;
	}

	#
	# Ensure that the starting point is set correctly.
	#
	if (defined $self->{start})
	{
		my @start = @{ $self->{start} };

		if ((not defined $start[0]) or
			$start[0] < 1 or $start[0] > $self->{_cols})
		{
			$start[0] = int(rand($self->{_cols})) + 1;
			carp "Start column $start[0] is out of range.\n";
		}
		if ((not defined $start[1]) or
			$start[1] < 1 or $start[1] > $self->{_rows})
		{
			$start[1] = int(rand($self->{_rows})) + 1;
			carp "Start row $start[1] is out of range.\n";
		}
		if ((not defined $start[2])
			or $start[2] < 1 or $start[2] > $self->{_rows})
		{
			$start[2] = int(rand($self->{_lvls})) + 1;
		}

		$self->{start} = \@start;
	}

	my $m = $self->{_corn};
	my $allwalls = $North | $West | $South | $East;

	#
	# Reset the center cells to unbroken.
	#
	foreach $r (1..$self->{_rows})
	{
		foreach $c (1..$self->{_cols})
		{
			$$m[1][$r][$c] = 0;
		}
	}

	#
	# Set the border cells.
	#
	foreach $r (0..$self->{_rows} + 1)
	{
		$$m[1][$r][$self->{_cols} + 1] = $North | $South | $East;
		$$m[1][$r][0] = $allwalls;
	}
	foreach $c (0..$self->{_cols} + 1)
	{
		$$m[1][$self->{_rows} + 1][$c] = $allwalls;
		$$m[1][0][$c] = $North | $West | $East;
	}

	$$m[1][0][$self->{_cols} + 1] |= $South;

	return $self;
}

#
# $obj->_set_entry_exit
#
# Pick the start and final points on the maze. These will become
# user-settable choices in the future.
#
sub _set_entry_exit
{
	my $self = shift;
	my $m = $self->{_corn};

	if (defined $self->{entry})
	{
		my @entry = @{ $self->{entry} };

		if ($entry[0] < 1 or $entry[0] > $self->{_cols})
		{
			$entry[0] = int(rand($self->{_cols})) + 1;
			carp "Entry column $entry[0] is out of range.\n";
		}

		$entry[1] = 1;
		$entry[2] = 1;

		$self->{entry} = \@entry;
	}
	else
	{
		$self->{entry} = [int(rand($self->{_cols})) + 1, 1, 1];
	}

	if (defined $self->{exit})
	{
		my @exit = @{ $self->{exit} };

		if ($exit[0] < 1 or $exit[0] > $self->{_cols})
		{
			$exit[0] = int(rand($self->{_cols})) + 1;
			carp "Exit column $exit[0] is out of range.\n";
		}

		$exit[1] = $self->{_rows};
		$exit[2] = $self->{_lvls};
		$self->{exit} = \@exit;
	}
	else
	{
		$self->{exit} = [int(rand($self->{_cols})) + 1,
					$self->{_rows},
					$self->{_lvls}];
	}

	return $self;
}

#
# $obj->_get_start_point
#
# Return the (or pick a) starting point in the maze.
#
sub _get_start_point
{
	my $self = shift;

	return @{ $self->{start} } if (defined $self->{start});

	return (
		int(rand($self->{_cols})) + 1,
		int(rand($self->{_rows})) + 1,
		int(rand($self->{_lvls})) + 1
	);
}

#
# ($dir, $c, $r, $l) = $obj->_move_thru($dir, $c, $r, $l)
#
# Move from the current cell to the next by going in the direction
# of $dir.  The function will return your new coordinates, and the
# number of the wall you just came through, from the point of view
# of your new position.
#
sub _move_thru
{
	my $self = shift;
	my($dir, $c, $r, $l) = @_;

	print STDERR "_move_thru: [$c, $r, $l] to $dir\n" if ($Debug_internal);

	if ($dir == $North or $dir == $South)
	{
		$r += ($dir == $North)? -1: 1;
	}
	elsif ($dir == $East or $dir == $West)
	{
		$c += ($dir == $West)? -1: 1;
	}
	else
	{
		$l += ($dir == $Ceiling)? -1: 1;
	}

	$dir = ($dir <= $Ceiling)? ($dir << 5): ($dir >> 5);

	print STDERR "_move_thru: [$c, $r, $l] from $dir\n" if ($Debug_internal);
	return ($dir, $c, $r, $l);
}

#
# @directions = $obj->_collect_dirs($c, $r, $l);
#
# Find all of our possible directions to wander when creating the maze.
# You are only allowed to go into not-yet-broken cells.  The directions
# are deliberately accumulated in a counter-clockwise fashion.
#
sub _collect_dirs
{
	my $self = shift;
	my $m = $self->{_corn};
	my @dir;
	my($c, $r, $l) = @_;

	#
	# Search for enclosed cells.
	#
	push(@dir, $North)    if ($$m[$l][$r - 1][$c] == 0);
	push(@dir, $West)     if ($$m[$l][$r][$c - 1] == 0);
	push(@dir, $South)    if ($$m[$l][$r + 1][$c] == 0);
	push(@dir, $East)     if ($$m[$l][$r][$c + 1] == 0);
	push(@dir, $Ceiling)  if ($$m[$l - 1][$r][$c] == 0);
	push(@dir, $Floor)    if ($$m[$l + 1][$r][$c] == 0);

	print STDERR "_collect_dirs($c, $r, $l) returns (", join(", ", @dir), ")\n" if ($Debug_internal);
	return @dir;
}

#
# $dir = $obj->_next_direct($dir)
#
# Returns the next direction to move to when checking walls.
#
sub _next_direct
{
	my $self = shift;
	my($dir) = @_;

	print STDERR "_next_direct: start with ", $dir, "\n" if ($Debug_internal);
	if ($dir == $Floor)
	{
		$dir = $North;
	}
	elsif ($dir == $Ceiling)
	{
		$dir = $South;
	}
	else
	{
		$dir <<= 2;
	}
	print STDERR "_next_direct: return ", $dir, "\n" if ($Debug_internal);
	return $dir;
}

#
# NAME
#
# Games::Maze::Hex - Create 3-D hexagon maze objects.
#
# Maze creation is done through the maze object's methods, listed below:
#
package Games::Maze::Hex;

use Moo;
extends 'Games::Maze';

use Carp;

our $VERSION = '1.09';

#
# to_ascii
#
# Translate the maze into a string of ascii 7-bit characters. If called in
# a list context, return as a list of levels. Otherwise returned as a
# single string, each level separated by a single newline.
#
sub to_ascii
{
	my $self = shift;
	my $m = $self->{_corn};
	my($c, $r, $l, @levels);

	my(%upper_west) = (
		(0                                      , '/  '),
		($NorthWest                              , '   '),
		($Floor                                  , '/f '),
		($NorthWest | $Floor                      , ' f '),
		($Ceiling                                , '/c '),
		($NorthWest | $Ceiling                    , ' c '),
		($Floor | $Ceiling                        , '/b '),
		($NorthWest | $Floor | $Ceiling            , ' b '),
		($Path_Mark                              , '/ *'),
		($NorthWest | $Path_Mark                  , '  *'),
		($Floor | $Path_Mark                      , '/f*'),
		($NorthWest | $Floor | $Path_Mark          , ' f*'),
		($Ceiling | $Path_Mark                    , '/c*'),
		($NorthWest | $Ceiling | $Path_Mark        , ' c*'),
		($Floor | $Ceiling | $Path_Mark            , '/b*'),
		($NorthWest | $Floor | $Ceiling | $Path_Mark, ' b*'),
	);
	my(%lower_west) = (
		(0                  , '\__'),
		($South             , '\  '),
		($SouthWest         , ' __'),
		($SouthWest | $South, '   '),
	);

	my $rlim = $self->{_rows} + 1;

	foreach $l (1..$self->{_lvls})
	{
		#
		# Print the top line of the border (the underscores on the
		# 'up' columns).
		#
		my $lvlstr = "";

		foreach $c (1..$self->{_cols})
		{
			if ($self->_up_column($c))
			{
				$lvlstr .= $lower_west{$$m[$l][0][$c] & ($SouthWest|$South)};
			}
			else
			{
				$lvlstr .= $lower_west{($SouthWest|$South)};
			}
		}

		$lvlstr .= "\n";

		#
		# Now print the rows.
		#
		foreach $r (1..$rlim)
		{
#			my($clim1, $clim2) = $self->_first_last_col($r);
			my($clim2) = $self->{_cols};

			#
			# It takes two lines to print out the hexagon, or parts of the
			# hexagon.  First, the top half.
			#
			foreach $c (1..$clim2 + 1)
			{
				if ($self->_up_column($c))
				{
					$lvlstr .= $upper_west{$$m[$l][$r][$c] & ($NorthWest|$Floor|$Ceiling|$Path_Mark)};
				}
				else
				{
					$lvlstr .= $lower_west{$$m[$l][$r - 1][$c] & ($SouthWest|$South)};
				}
			}

			$lvlstr .= "\n";

			#
			# Now, the lower half.
			#
			foreach $c (1..$clim2 + 1)
			{
				if ($self->_up_column($c))
				{
					$lvlstr .= $lower_west{$$m[$l][$r][$c] & ($SouthWest|$South)};
				}
				else
				{
					$lvlstr .= $upper_west{$$m[$l][$r][$c] & ($NorthWest|$Floor|$Ceiling|$Path_Mark)};
				}
			}

			$lvlstr .= "\n";
		}

		push @levels, $lvlstr;
	}

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

#
# _set_internals
#
# Sets the internal values of the maze, and resets the first level of the maze.
#
sub _set_internals
{
	my $self = shift;
	my($c, $r);

	#
	# Check the dimensions for correctness.
	#
	my($cols, $rows, $lvls) = @{ $self->{dimensions} };

	if ($self->{form} eq 'Rectangle')
	{
		if ($cols < 2 or $rows < 2 or $lvls < 1)
		{
			carp "Minimum column, row, and level dimensions are 2, 2, 1";
			return undef;
		}

		$self->{upcolumn_even} = 0 unless (defined $self->{upcolumn_even});
		$self->{_rows} = $rows;
		$self->{_cols} = $cols;
		$self->{_lvls} = $lvls;
	}
	elsif ($self->{form} eq 'Hexagon')
	{
		if ($cols < 2 or $rows < 1 or $lvls < 1)
		{
			carp "Minimum column, row, and level dimensions are 1, 2, 1";
			return undef;
		}

		$self->{upcolumn_even} = 1 - ($cols & 1);
		$self->{_rows} = $rows + $cols - 1;
		$self->{_cols} = $cols * 2 - 1;
		$self->{_lvls} = $lvls;
	}
	else
	{
		carp "Unknown form requested for ", __PACKAGE__, ".\n";
		return undef;
	}

	#
	# Ensure that the starting point is set correctly.
	#
	if (defined $self->{start})
	{
		my @start = @{ $self->{start} };

		if ((not defined $start[0]) or
			$start[0] < 1 or $start[0] > $self->{_cols})
		{
			$start[0] = int(rand($self->{_cols})) + 1;
			carp "Start column $start[0] is out of range.\n";
		}
		if ((not defined $start[1]) or
			$start[1] < 1 or $start[1] > $self->{_rows})
		{
			my($row_start, $row_end) = $self->_first_last_row($start[0]);
			$start[1] = int(rand($row_end - $row_start + 1)) + $row_start;
			carp "Start row $start[1] is out of range.\n";
		}

		if ((not defined $start[2])
			or $start[2] < 1 or $start[2] > $self->{_rows})
		{
			$start[2] = int(rand($self->{_lvls})) + 1;
		}

		$self->{start} = \@start;
	}

	my $m = $self->{_corn};

	#
	# Reset the center cells to unbroken.
	#
	foreach $r (1..$self->{_rows})
	{
		foreach $c (1..$self->{_cols})
		{
			$$m[1][$r][$c] = 0;
		}
	}

	#
	# Set the border cells.
	#
	if ($self->{form} eq 'Rectangle')
	{
		#
		# North and South boundry.
		#
		foreach $c (1..$self->{_cols})
		{
			$$m[1][0][$c] = $NorthWest;
			$$m[1][$self->{_rows} + 1][$c] = $SouthWest;

			if ($self->_up_column($c))
			{
				$$m[1][0][$c] |= $SouthWest;
				$$m[1][$self->{_rows} + 1][$c] |= $South;
			}
			else
			{
				$$m[1][$self->{_rows} + 1][$c] |= $NorthWest;
			}
		}

		#
		# East and West boundry.
		#
		foreach $r (0..$self->{_rows} + 1)
		{
			$$m[1][$r][0] = $South | $SouthWest;
			$$m[1][$r][$self->{_cols} + 1] = $South;
		}

		#
		# We use some of the boundry cells to print the top and bottom walls.
		# Make sure that some of those walls don't print.
		#
		if ($self->_up_column(1))
		{
			$$m[1][$self->{_rows} + 1][1] |= $NorthWest;
		}
		else
		{
			$$m[1][0][1] |= $SouthWest;
		}

		#
		# Eliminate some corner-border walls.
		#
		if ($self->_up_column($self->{_cols} + 1))
		{
			$$m[1][1][$self->{_cols} + 1] |= $NorthWest;
			$$m[1][$self->{_rows} + 1][$self->{_cols} + 1] |= $SouthWest;
		}
		else
		{
			$$m[1][$self->{_rows}][$self->{_cols} + 1] |= $SouthWest;
			$$m[1][$self->{_rows} + 1][$self->{_cols} + 1] |= $NorthWest;
		}
	}
	elsif ($self->{form} eq 'Hexagon')
	{
		my $allwalls = $North|$NorthWest|$SouthWest|$South|$SouthEast|$NorthEast;

		#
		# Set up the East-West boundries.
		#
		foreach $r (0..$self->{_rows} + 1)
		{
			$$m[1][$r][0] = $$m[1][$r][$self->{_cols} + 1] = $allwalls;
		}

		if ($self->_up_column($self->{_cols} + 1))
		{
			my($rlim1, $rlim2) = $self->_first_last_row($self->{_cols});
			for ($r = $rlim1; $r <= $rlim2; $r++)
			{
				$$m[1][$r + 1][1 + $self->{_cols}] ^= $NorthWest;
				$$m[1][$r][1 + $self->{_cols}] ^= $SouthWest;
			}
		}
		else
		{
			my($rlim1, $rlim2) = $self->_first_last_row($self->{_cols});
			for ($r = $rlim1; $r <= $rlim2; $r++)
			{
				$$m[1][$r][1 + $self->{_cols}] ^= $NorthWest;
				$$m[1][$r - 1][1 + $self->{_cols}] ^= $SouthWest;
			}
		}

		#
		# Extend the North and South boundries inward to create
		# the hexagonal form.
		#
		# In the Hexagon form, the columns dimension is the
		# midpoint of '_cols'.
		#
		for ($c = 1; $c <= $cols; $c++)
		{
			my($rlim1, $rlim2) = $self->_first_last_row($c);

			for ($r = 0; $r < $rlim1; $r++)
			{
				$$m[1][$r][$c] = $allwalls;
			}

			for ($r = $self->{_rows} + 1; $r > $rlim2; $r--)
			{
				$$m[1][$r][$c] = $allwalls;
			}

			$$m[1][$rlim1 - 1][$c] ^= $South;
		}

		for ($c = 1 + $cols; $c <= $self->{_cols}; $c++)
		{
			my($rlim1, $rlim2) = $self->_first_last_row($c);

			for ($r = 0; $r < $rlim1; $r++)
			{
				$$m[1][$r][$c] = $allwalls;
			}

			for ($r = $self->{_rows} + 1; $r > $rlim2; $r--)
			{
				$$m[1][$r][$c] = $allwalls;
			}

			$$m[1][$rlim1 - 1][$c] ^= $SouthWest|$South;
			$$m[1][$rlim2 + 1][$c] ^= $NorthWest;
		}
	}

	return $self;
}

#
# $obj->_set_entry_exit
#
# Pick the start and final points on the maze. This will become a
# user-settable choice in the future.
#
sub _set_entry_exit
{
	my $self = shift;
	my $m = $self->{_corn};

	if (defined $self->{entry})
	{
		my @entry = @{ $self->{entry} };

		if ($entry[0] < 1 or $entry[0] > $self->{_cols})
		{
			$entry[0] = int(rand($self->{_cols})) + 1;
			carp "Entry column $entry[0] is out of range.\n";
		}

		($entry[1], undef) = $self->_first_last_row($entry[0]);
		$entry[2] = 1;

		$self->{entry} = \@entry;
	}
	else
	{
		my @entry = (int(rand($self->{_cols})) + 1);

		($entry[1], undef) = $self->_first_last_row($entry[0]);
		$entry[2] = 1;

		$self->{entry} = \@entry;
	}

	if (defined $self->{exit})
	{
		my @exit = @{ $self->{exit} };

		if ($exit[0] < 1 or $exit[0] > $self->{_cols})
		{
			$exit[0] = int(rand($self->{_cols})) + 1;
			carp "Exit column $exit[0] is out of range.\n";
		}

		(undef, $exit[1]) = $self->_first_last_row($exit[0]);
		$exit[2] = $self->{_lvls};

		$self->{exit} = \@exit;
	}
	else
	{
		my @exit = (int(rand($self->{_cols})) + 1);

		(undef, $exit[1]) = $self->_first_last_row($exit[0]);
		$exit[2] = $self->{_lvls};

		$self->{exit} = \@exit;
	}

	return $self;
}

#
# $obj->_get_start_point
#
# Return the (or pick a) starting point in the maze.
#
sub _get_start_point
{
	my $self = shift;

	return @{ $self->{start} } if (defined $self->{start});

	my $c = int(rand($self->{_cols})) + 1;
	my($row_start, $row_end) = $self->_first_last_row($c);

	return (
		$c,
		int(rand($row_end - $row_start + 1)) + $row_start,
		int(rand($self->{_lvls})) + 1
	);
}

#
# ($dir, $c, $r, $l) = $obj->_move_thru($dir, $c, $r, $l)
#
# Move from the current cell to the next by going in the direction
# of $dir.  The function will return your new coordinates, and the
# number of the wall you just came through, from the point of view
# of your new position.
#
sub _move_thru
{
	my $self = shift;
	my($dir, $c, $r, $l) = @_;

	print STDERR "_move_thru: [$c, $r, $l] to $dir\n" if ($Debug_internal);
	if ($dir == $North or $dir == $South)
	{
		$r += ($dir == $North)? -1: 1;
	}
	elsif ($dir == $Ceiling or $dir == $Floor)
	{
		$l += ($dir == $Ceiling)? -1: 1;
	}
	else
	{
		if ($self->_up_column($c))
		{
			$r -= 1 if ($dir == $NorthWest or $dir == $NorthEast);
		}
		else
		{
			$r += 1 if ($dir == $SouthWest or $dir == $SouthEast);
		}

		if ($dir == $NorthWest or $dir == $SouthWest)
		{
			$c -= 1;
		}
		elsif ($dir == $NorthEast or $dir == $SouthEast)
		{
			$c += 1;
		}
	}

	$dir = ($dir <= $Ceiling)? ($dir << 5): ($dir >> 5);

	print STDERR "_move_thru: [$c, $r, $l] from $dir\n" if ($Debug_internal);
	return ($dir, $c, $r, $l);
}

#
# @directions = $obj->_collect_dirs($c, $r, $l);
#
# Find all of our possible directions to wander when creating the maze.
# You are only allowed to go into not-yet-broken cells.  The directions
# are deliberately accumulated in a counter-clockwise fashion.
#
sub _collect_dirs
{
	my $self = shift;
	my($c, $r, $l) = @_;
	my $m = $self->{_corn};
	my @dir;

	#
	# Search for enclosed cells.
	#
	push(@dir, $North) if ($$m[$l][$r - 1][$c] == 0);

	if ($self->_up_column($c))
	{
		push(@dir, $NorthWest) if ($$m[$l][$r - 1][$c - 1] == 0);
		push(@dir, $SouthWest) if ($$m[$l][$r][$c - 1] == 0);

		push(@dir, $South) if ($$m[$l][$r + 1][$c] == 0);

		push(@dir, $SouthEast) if ($$m[$l][$r][$c + 1] == 0);
		push(@dir, $NorthEast) if ($$m[$l][$r - 1][$c + 1] == 0);
	}
	else
	{
		push(@dir, $NorthWest) if ($$m[$l][$r][$c - 1] == 0);
		push(@dir, $SouthWest) if ($$m[$l][$r + 1][$c - 1] == 0);

		push(@dir, $South) if ($$m[$l][$r + 1][$c] == 0);

		push(@dir, $SouthEast) if ($$m[$l][$r + 1][$c + 1] == 0);
		push(@dir, $NorthEast) if ($$m[$l][$r][$c + 1] == 0);
	}

	push(@dir, $Ceiling) if ($$m[$l - 1][$r][$c] == 0);
	push(@dir, $Floor) if ($$m[$l + 1][$r][$c] == 0);

	print STDERR "_collect_dirs($c, $r, $l) returns (", join(", ", @dir), ")\n" if ($Debug_internal);
	return @dir;
}

#
# $dir = $obj->_next_direct($dir)
#
# Returns the next direction to move to when checking walls.
#
sub _next_direct
{
	my $self = shift;
	my($dir) = @_;

	print STDERR "_next_direct: start with ", $dir, "\n" if ($Debug_internal);
	if ($dir == $Floor)
	{
		$dir = $North;
	}
	elsif ($dir == $NorthWest)
	{
		$dir = $SouthWest;
	}
	elsif ($dir == $SouthEast)
	{
		$dir = $NorthEast;
	}
	else
	{
		$dir <<= 1;
	}
	print STDERR "_next_direct: return ", $dir, "\n" if ($Debug_internal);
	return $dir;
}

#
# if ($obj->_up_column($c)) {...}
#
# Which columns are high due to hexagonal drift?
#
sub _up_column
{
	my $self = shift;
	my($c) = @_;
	return 1 & ($c ^ $self->{upcolumn_even});
}

#
# ($first_col, $last_col) = $obj->_first_last_col($r)
#
# Given a row, what columns have the first and last non-border cells
# in the hexagon-formed grid?
#
sub _first_last_col
{
	my $self = shift;
	my($r) = @_;

	if ($self->{form} eq 'Hexagon')
	{
		my $mid_c = int(($self->{_cols} + 1)/2);
		my $ante_r = int($self->{_cols}/4);
		my $post_r = $self->{_rows} - int(($self->{_cols} + 1)/4);

		if ($r <= $ante_r)
		{
			my $offset = (2 * $r - 1);
			return ($mid_c - $offset,
				$mid_c + $offset);
		}
		elsif ($r > $post_r)
		{
			my $offset = (2 * ($self->{_rows} - $r));
			return ($mid_c - $offset,
				$mid_c + $offset);
		}
		else
		{
			return (1,
				$self->{_cols});
		}
	}
	else
	{
		return (1,
			$self->{_cols});
	}
}

#
# ($first_row, $last_row) = $obj->_first_last_row($c)
#
# Given a column, what rows have the first and last non-border cells
# in the hexagon-formed grid?
#
sub _first_last_row
{
	my $self = shift;
	my $c = $_[0];

	if ($self->{form} eq 'Hexagon')
	{
		#
		# Find how far off $c is from the midpoint (in the
		# Hexagon form, the columns dimension is the midpoint of
		# '_cols').
		#
		my $offset_c = abs(${ $self->{dimensions} }[0] - $c);

		return (int($offset_c/2) + 1,
			$self->{_rows} - int(($offset_c + 1)/2));
	}
	else
	{
		return (1,
			$self->{_rows});
	}
}

1;
__END__