[FWP] Maze

[Jerome Quelin <jerome.quelin@insalien.org>]

Hi there,

I'm trying to create a maze. The result is to be in a 2
dimensions array, and the values are either WALL (=1) or
FREE (=0). Of course, I want the maze to have a solution...
And I also want it to be kind of difficult to solve.
I haven't found anything such as an algorithm to create such
a maze, so here is how I have done : I create some "snakes"
that go randomly north, south, east or west if they can, and
if there is already a wall in every direction, they go back
one step, as long as they can. When they can't go back one
step and still can't go in a new direction, I destroy the
snake. When all the snakes are dead, my maze is created.

A little drawing is better than a long speech, so the file
attached contains a modified version that draws the maze
during its creation in a canvas.


Here is the code of the non-Tk version.
-- maze.pl --
#!/usr/bin/perl -w

use strict;
use Snake;

use constant NORTH => 1; use constant EAST  => 2;
use constant SOUTH => 4; use constant WEST  => 8;
use constant FREE => 0;  use constant WALL  => 1;
use constant NB_COLS => 51; use constant NB_ROWS => 51;
use constant NB_SNAKES => 15;
my @Maze;       # The 2 dims array.

create_maze();
print "Maze created\n";
exit(0);

sub find_free_neighbours {
    my ($j, $i) = @_;
    my @free = ();
    $i > 2         && $Maze[$i-2][$j] != WALL and push
@free, NORTH;
    $i < NB_ROWS-3 && $Maze[$i+2][$j] != WALL and push
@free, SOUTH;
    $j > 2         && $Maze[$i][$j-2] != WALL and push
@free, WEST;
    $j < NB_COLS-3 && $Maze[$i][$j+2] != WALL and push
@free, EAST;
    return @free;
}

sub create_maze {
    my @snakes;

    { # Clear the actual maze
        for ( my $i = 0 ; $i < NB_ROWS ; $i++) {
            for ( my $j = 0 ; $j < NB_COLS ; $j++) {
                $Maze[$i][$j] = FREE;
            }
        }
    }


    { # Create the snakes.
        for ( my $i = 0; $i < NB_SNAKES ; $i++ ) {
            my ($x, $y);
            do {
                $x = int( rand((NB_COLS-4)/2) ) * 2 + 2;
                $y = int( rand((NB_ROWS-4)/2) ) * 2 + 2;
            } while ($Maze[$y][$x] != FREE);
            my $snake = new Snake($x, $y);
            push @snakes, $snake;
            $Maze[$y][$x] = WALL;
        }
    }


    { # Create the new maze.
        while ( my $snake = shift @snakes ) { # Cycle
through the snakes.
            my $x = $snake->get_pos_X();
            my $y = $snake->get_pos_Y();
            my @allowed = find_free_neighbours($x, $y);
            my $dir = $snake->move(@allowed);

            if ( defined($dir) ) {
                # The snake can move : we store it again.
                push @snakes, $snake;
              switch: {
                  $dir == NORTH && do {
                      $Maze[$y-1][$x] = WALL;
                      $Maze[$y-2][$x] = WALL;
                      last;
                  };
                  $dir == SOUTH && do {
                      $Maze[$y+1][$x] = WALL;
                      $Maze[$y+2][$x] = WALL;
                      last;
                  };
                  $dir == EAST  && do {
                      $Maze[$y][$x+1] = WALL;
                      $Maze[$y][$x+2] = WALL;
                      last;
                  };
                  $dir == WEST  && do {
                      $Maze[$y][$x-1] = WALL;
                      $Maze[$y][$x-2] = WALL;
                      last;
                  };
              }

            }
        }
    }
}
-- end of maze.pl --
-- Snake.pm --
package Snake;

use strict;
use constant NORTH => 1; use constant EAST  => 2;
use constant SOUTH => 4; use constant WEST  => 8;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    bless ($self, $class);

    # Initialisation stuff...
    $self->{X} = shift;
    $self->{Y} = shift;
    $self->{PATH}  = ();

    return $self;
}

sub get_pos_X { return $_[0]->{X}; }
sub get_pos_Y { return $_[0]->{Y}; }

sub move {
    my $self = shift;
    my @allowed = @_;
    my $dir;

    if ( $#allowed == -1 ) {
        # Can't move one step back.
        $#{ $self->{PATH} } == -1 and return undef;

        # No more free neighbours : move one step back.
        $dir = pop @{ $self->{PATH} };
        $dir = ($dir << 2) % (NORTH|EAST|SOUTH|WEST);

    } else {
        # Choose randomly a new direction in those allowed.
        $dir = $allowed[ int(rand(@allowed)) ];
        push @{ $self->{PATH} }, $dir;
    }

    # Update the snake coordinates.
    $dir == WEST  and $self->{X} -= 2;
    $dir == EAST  and $self->{X} += 2;
    $dir == NORTH and $self->{Y} -= 2;

    $dir == SOUTH and $self->{Y} += 2;

    return $dir;
}

1;
-- end of Snake.pm


What do you think of this way of creating a maze ? How would
*you* have done if you were to create a maze ? (Do you know
an algorithm that create a maze ?)
And of course, I'm always happy to know of your
optimisations on my code...

Jerome
--
jerome.quelin@insalien.org

maze.tgz