Maze generation: Difference between revisions
Content added Content deleted
m (→{{header|Perl 5}}: fix headers) |
(→{{header|Perl}}: shortened somewhat) |
||
| Line 906: | Line 906: | ||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
<lang perl>use List::Util 'max'; |
|||
my ($w, $h) = @ARGV; |
|||
Tested on Perl 5.8, but should work on any Perl5 installation on most platforms. |
|||
$w ||= 26; |
|||
$h ||= 127; |
|||
my $avail = $w * $h; |
|||
# cell is padded by sentinel col and row, so I don't check array bounds |
|||
This implementation observes that due to the grid formation of the maze, reflection can be used to simplify the algorithm. Walls are only removed on the East (right) and South (bottom) walls (if those walls are not part of the maze boundary). |
|||
my @cell = (map([(('1') x $w), 0], 1 .. $h), [('') x ($w + 1)]); |
|||
my @ver = map([("| ") x $w], 1 .. $h); |
|||
my @hor = map([("+--") x $w], 0 .. $h); |
|||
sub walk { |
|||
<lang perl>use strict; |
|||
my ($x, $y) = @_; |
|||
$cell[$y][$x] = ''; |
|||
$avail-- or return; # no more bottles, er, cells |
|||
my |
my @d = ([-1, 0], [0, 1], [1, 0], [0, -1]); |
||
while (@d) { |
|||
my $maze = init_maze($dimension, $dimension); |
|||
my $i = splice @d, int(rand @d), 1; |
|||
my ($x1, $y1) = ($x + $i->[0], $y + $i->[1]); |
|||
$cell[$y1][$x1] or next; |
|||
my ($startRow, $startCol) = (int(rand($dimension)), int(rand($dimension))); |
|||
make_maze($maze, $startRow, $startCol, undef); |
|||
if ($x == $x1) { $hor[ max($y1, $y) ][$x] = '+ ' } |
|||
print_maze($maze); |
|||
if ($y == $y1) { $ver[$y][ max($x1, $x) ] = ' ' } |
|||
walk($x1, $y1); |
|||
#---Subs--- |
|||
} |
|||
sub init_maze { |
|||
my ($max_row, $max_col) = @_; |
|||
my $maze = []; |
|||
for (my $r=0; $r < $max_row; $r++) { |
|||
for (my $c=0; $c < $max_col; $c++) { |
|||
push @{$maze->[$r]}, {'visited' => 0, |
|||
'bottom' => 1, |
|||
'right' => 1, |
|||
}; |
|||
} |
|||
} |
|||
return $maze; |
|||
} |
} |
||
walk(int rand $w, int rand $h); # generate |
|||
sub make_maze { |
|||
my ($maze, $row, $col) = @_; |
|||
$maze->[$row]->[$col]->{'visited'} = 1; |
|||
while (my $unvisited = get_unvisited($maze, $row, $col)) { |
|||
last unless @$unvisited; |
|||
# Randomly select a neighbor |
|||
my $choice = $unvisited->[ rand(@$unvisited) ]; |
|||
# Knock down the wall between them |
|||
remove_wall($maze, [$row, $col], $choice); |
|||
# move to this new cell |
|||
make_maze($maze, $choice->[0], $choice->[1]); |
|||
} |
|||
} |
|||
sub remove_wall { |
|||
my ($maze, $r1, $r2) = @_; |
|||
my $selected; |
|||
if ( $r1->[0] == $r2->[0] ) { |
|||
# Rows are equal, must be East/West neighbors |
|||
$selected = ($r1->[1] < $r2->[1]) ? $r1 : $r2; |
|||
$maze->[ $selected->[0] ]->[ $selected->[1] ]->{'right'} = 0; |
|||
} elsif ( $r1->[1] == $r2->[1] ) { |
|||
# Columns are the same, must be North/South neighbors |
|||
$selected = ($r1->[0] < $r2->[0]) ? $r1 : $r2; |
|||
$maze->[ $selected->[0] ]->[ $selected->[1] ]->{'bottom'} = 0; |
|||
} else { |
|||
die("ERROR: bad neighbors ($r1->[0], $r1->[1]) and ($r2->[0], $r2->[1])\n"); |
|||
} |
|||
return; |
|||
} |
|||
sub get_unvisited { |
|||
my ($maze, $row, $col) = @_; |
|||
my @found; |
|||
# look for neighbors in cardinal directions; |
|||
# be mindful of maze boundaries |
|||
if ($row == 0) { |
|||
push @found, [$row + 1, $col] unless $maze->[$row + 1]->[$col]{'visited'}; |
|||
} elsif ($row == @$maze - 1) { |
|||
push @found, [$row - 1, $col] unless $maze->[$row - 1]->[$col]->{'visited'}; |
|||
} else { |
|||
if ($row + 1 < @$maze) { |
|||
push @found, [$row + 1, $col] unless $maze->[$row + 1]->[$col]->{'visited'}; |
|||
} |
|||
push @found, [$row - 1, $col] unless $maze->[$row - 1]->[$col]->{'visited'}; |
|||
} |
|||
if ($col == 0) { |
|||
push @found, [$row, $col + 1] unless $maze->[$row]->[$col + 1]->{'visited'}; |
|||
} elsif ($col == (@{$maze->[0]} - 1)) { |
|||
push @found, [$row, $col - 1] unless $maze->[$row]->[$col - 1]->{'visited'}; |
|||
} else { |
|||
if ($col + 1 < @{$maze->[0]}) { |
|||
push @found, [$row, $col + 1] unless $maze->[$row]->[$col + 1]->{'visited'}; |
|||
} |
|||
push @found, [$row, $col - 1] unless $maze->[$row]->[$col - 1]->{'visited'}; |
|||
} |
|||
return \@found; |
|||
} |
|||
sub print_maze { |
|||
my ($maze) = @_; |
|||
my $screen = []; |
|||
my $screen_row = 0; |
|||
for (my $r=0; $r < @$maze; $r++) { |
|||
if ($r == 0) { |
|||
# Top border |
|||
push @{$screen->[$r]}, '+'; |
|||
for (@{$maze->[0]}) { |
|||
push @{$screen->[$r]}, '--', '+'; |
|||
} |
|||
} |
|||
for (my $c=0; $c < @{$maze->[0]}; $c++) { |
|||
my @middle; |
|||
if ($c == 0) { |
|||
push @middle, "|"; |
|||
} |
|||
push @middle, " "; # room center |
|||
if ($maze->[$r]->[$c]->{'right'}) { |
|||
push @middle, "|"; |
|||
} else { |
|||
push @middle, " "; |
|||
} |
|||
push @{$screen->[$screen_row + 1]}, @middle; |
|||
my @bottom; |
|||
if ($c == 0) { |
|||
push @bottom, "+"; |
|||
} |
|||
if ($maze->[$r]->[$c]->{'bottom'}) { |
|||
push @bottom, "--"; |
|||
} else { |
|||
push @bottom, " "; |
|||
} |
|||
push @bottom, "+"; |
|||
push @{$screen->[$screen_row + 2]}, @bottom; |
|||
} |
|||
$screen_row += 2; |
|||
} |
|||
for (my $r=0; $r < @$screen; $r++) { |
|||
for (my $c=0; $c < @{$screen->[0]}; $c++) { |
|||
print $screen->[$r]->[$c]; |
|||
} |
|||
print "\n"; |
|||
} |
|||
print "\n"; |
|||
} |
|||
</lang> |
|||
Sample output (7x7): |
|||
for (0 .. $h) { # display |
|||
<pre> |
|||
print @{$hor[$_]}, "+\n"; |
|||
+--+--+--+--+--+--+--+ |
|||
print @{$ver[$_]}, "|\n" if $_ < $h; |
|||
| | | |
|||
}</lang>run as <code>maze.pl [width] [height]</code> or use default dimensions. Sample 4 x 1 output:<lang>+--+--+--+--+ |
|||
+ +--+ + +--+--+ + |
|||
| |
| | |
||
+-- |
+--+--+--+--+</lang> |
||
| | | | | |
|||
+ +--+ + +--+ + + |
|||
| | | | | |
|||
+ + +--+--+ +--+--+ |
|||
| | | | |
|||
+ +--+--+ +--+--+ + |
|||
| | | | |
|||
+--+ + +--+ + + + |
|||
| | | | | |
|||
+--+--+--+--+--+--+--+ |
|||
</pre> |
|||
=={{header|Perl 6}}== |
=={{header|Perl 6}}== |
||