Maze generation: Difference between revisions
→{{header|Perl 6}}: Added perl 6 solution
Underscore (talk | contribs) (Added Haskell.) |
Thundergnat (talk | contribs) (→{{header|Perl 6}}: Added perl 6 solution) |
||
Line 677:
And this does indeed save a negligible bit of processing, but the maze algorithm will still be forced to backtrack through a number of locations which have no unvisited neighbors.
=={{header|Perl 6}}==
Works with Rakudo 2011.01
Supply a width and height and optionally the x,y grid coords for the starting cell. If no starting cell is supplied, a random one will be selected automatically. 0,0 is the top left corner.
<lang perl6>display( gen_maze( 11, 8 ) );
sub gen_maze (
$x_size,
$y_size,
$start_x = $x_size.rand.Int,
$start_y = $y_size.rand.Int
) {
my %walls;
my @maze;
for ^$y_size -> $x {
@maze[$x] = [ 1 xx $x_size];
%walls{'y'}[$x] = ['|' xx $x_size];
%walls{'x'}[$x] = ['---' xx $x_size];
}
my @stack;
my @current = ($start_y, $start_x);
while 1 {
my @next = get_unvisited_neighbors( @maze, @current );
unless @next[0].defined {
last unless @stack;
@current = @stack.pop.list;
next;
}
last unless @current;
@stack.push( [@current] );
move( @maze, @next, @current, %walls );
@current = @next;
}
return %walls;
}
sub get_unvisited_neighbors(@maze, @current) {
my ($x, $y) = @current;
my @neighbors;
@neighbors.push([ $x-1, $y ]) if ($x > 0) && @maze[$x-1][$y];
@neighbors.push([ $x+1, $y ]) if ($x < +@maze) && @maze[$x+1][$y];
@neighbors.push([ $x, $y-1 ]) if ($y > 0) && @maze[$x][$y-1];
@neighbors.push([ $x, $y+1 ]) if ($y < +@maze[0]) && @maze[$x][$y+1];
return |@neighbors.roll(1) if +@neighbors;
}
sub move ($maze, $next, $current, $walls) {
$maze[$next[0]][$next[1]] = 0;
given ($next, $current) {
when $next[0] < $current[0] { $walls{'x'}[$next[0]][$current[1]] = ' '}
when $next[0] > $current[0] { $walls{'x'}[$current[0]][$current[1]] = ' '}
when $next[1] < $current[1] { $walls{'y'}[$current[0]][$current[1]] = ' ' }
when $next[1] > $current[1] { $walls{'y'}[$current[0]][$next[1]] = ' ' }
}
}
sub display ($walls) {
say '+'~('---' xx $walls{'y'}[0]).join('+')~'+';
for ^$walls{'x'} -> $i {
say ~$walls{'y'}[$i].join(' ')~' |';
say '+'~$walls{'x'}[$i].join('+')~'+';
}
}</lang>
Sample Output:
<pre>
+---+---+---+---+---+---+---+---+---+---+---+
| | | | |
+---+---+ + + + +---+---+---+---+ +
| | | | |
+ +---+---+ +---+---+ +---+---+---+---+
| | | |
+ +---+ +---+ +---+ +---+---+---+ +
| | | | | |
+ +---+---+ +---+ +---+ + +---+---+
| | | | | | | |
+---+ + + +---+---+ + +---+ + +
| | | | | | |
+ +---+---+---+ + + + +---+---+ +
| | | | | |
+ + +---+---+---+---+---+---+ +---+ +
| | |
+---+---+---+---+---+---+---+---+---+---+---+
</pre>
=={{header|PicoLisp}}==
Line 731 ⟶ 816:
+---+---+---+---+---+---+---+---+---+---+---+
a b c d e f g h i j k</pre>
=={{header|PureBasic}}==
<lang PureBasic>Enumeration
| |||