[KPV] - like [maze generator] this little program produces mazes. This version is simpler, faster and produces nice looking mazes than other version. It is used by the game [3D Maze].

This version works by picking a spot randomly in the maze, then doing a random walk on untravelled cells. When the walk hits a dead-end, it backs up until it can branch onto an untravelled cell and proceeds on a new random walk. When all cells have been visited we're done.

The code here actually can generate 3-d mazes but the GUI doesn't expose it. If you want to play with it see the sz(z) variable and the ShowLevel function. Or better yet, see [3D Maze] for it in full glory.

This method also has the nice property in that the solution from any point in the maze to any other can quickly be computed. As you build the maze, record from where a cell was entered from. This lets you build a path quickly from any cell to the generating point.
Now to get the path between two arbitrary points, first get the path from both points to the generating cell, determine where they join together, and combine the path from the first point to the junction point with the reverse path from the second point to the junction point.

----
 ##+##########################################################################
 #
 # DoMaze.tcl
 #
 # Draws a maze with a guaranteed unique solution.
 # by Keith Vetter
 #
 # The program works by picking a spot randomly in the maze, then
 # random walking until it can't proceed on untravelled cells. It then
 # backs up until it can branch onto a untravelled cells and proceeds
 # on a new random walk. When all cells have been visited we're done
 # except for selecting a spot on the east and west wall for the
 # entrances.
 # 
 # Revisions:
 # KPV August 31, 1994 - initial revision
 # KPV Sep 24, 2002 - ported to tk8+
 #

 package require Tk

 set sz(x) 15  ;# Maze width
 set sz(y) 15  ;# Maze height
 set sz(z)  1  ;# Maze levels -- you can have 3-d mazes
 
 ##+##########################################################################
 # 
 # Init
 # 
 # Sets up some global variables.
 # 
 proc Init {} {
     global sz DIR WALL DOOR MOTION
     
     set sz(w) 550                               ;# Canvas width
     set sz(h) 550                               ;# Canvas height
     set sz(box) 30                              ;# Cell box size
     set sz(tm) 50                               ;# Top margin
     set sz(lm) 50                               ;# Left margin
     set sz(lw) 3                                ;# Line width
 
     # These directions also act as bit shift amounts
     array set DIR {NORTH 0 EAST 1 UP 2 SOUTH 3 WEST 4 DOWN 5 }
     array set WALL {
         NORTH 0x01 EAST 0x02 UP 0x04 SOUTH 0x08 WEST 0x10 DOWN 0x20 ANY 0x3F
     }
     array set DOOR {
         NORTH 0x0100 EAST 0x0200 UP 0x0400 SOUTH 0x0800 WEST 0x1000 DOWN 0x2000
         ANY 0x3F00
     }
     array set MOTION {
         0,x 0 0,y -1 0,z 0    1,x  1 1,y 0 1,z 0   2,x 0 2,y 0 2,z -1 
         3,x 0 3,y  1 3,z 0    4,x -1 4,y 0 4,z 0   5,x 0 5,y 0 5,z  1 
     }
 }
 
 proc WALLDIR {dir}     {return [expr {$::WALL(NORTH) << $dir}] }
 proc DOORDIR {dir}     {return [expr {$::DOOR(NORTH) << $dir}] }
 proc WALLDOORDIR {dir} {return [expr {($::WALL(NORTH) | $::DOOR(NORTH))<<$dir}]}
 proc OPPOSITE {dir}    {return [expr {($dir + 3) % 6}] }
 proc BACKINFO {dir}    {return [expr {($dir + 1) << 16}]}
 proc BACKUNINFO {val}  {return [expr {($val >> 16) - 1}]}
 proc INFO {msg}        {.c itemconfig INFO -text $msg ; update idletasks }
 proc MOVETO {x y z dir} { list [incr x $::MOTION($dir,x)] \
                               [incr y $::MOTION($dir,y)] \
                               [incr z $::MOTION($dir,z)]
 }
 ##+##########################################################################
 # 
 # NewMaze
 # 
 # Creates a new maze of a given size.
 # 
 proc NewMaze {{x -1} {y -1} {z 1}} {
     if {$x != -1} { set ::sz(x) $x ; set ::sz(y) $y ; set ::sz(z) $z }
     set w [winfo width .c] ; set h [winfo height .c]
     .c delete all
     .c create text [expr $w/2] [expr $h/2] -anchor c -font bold -tag INFO
     INFO "thinking"
     
     set w [expr {($w - 2.0*$::sz(lm)) / $::sz(x)}]
     set h [expr {($h - 2.0*$::sz(tm)) / $::sz(y)}]
     set x [expr {$w < $h ? $w : $h}]
     set ::sz(box) [expr {$x > 100 ? 100 : $x < 5 ? 5 : $x}]
 
     FillMaze
     ShowMaze
 }
 ##+##########################################################################
 # 
 # InitMaze
 # 
 # Set up matrix and pick start and ending points
 #
 proc InitMaze {} {
     global maze sz
     catch {unset maze}
 
     for {set x 0} {$x < $sz(x)} {incr x} {      ;# Set all cells to 0
         for {set y 0} {$y < $sz(y)} {incr y} {
             for {set z 0} {$z < $sz(z)} {incr z} {
                 set maze($x,$y,$z) 0
             }
         }
     }
     for {set z 0} {$z < $sz(z)} {incr z} {      ;# North, south walls
         for {set x 0} {$x < $sz(x)} {incr x} {
             OrMaze $x 0 $z   $::WALL(NORTH) 
             OrMaze $x [expr {$sz(y) - 1}] $z $::WALL(SOUTH) 
         }
     }
     for {set z 0} {$z < $sz(z)} {incr z} {      ;# East, west walls
         for {set y 0} {$y < $sz(y)} {incr y} {
             OrMaze 0 $y $z   $::WALL(WEST)  
             OrMaze [expr {$sz(x) - 1}] $y $z $::WALL(EAST)  
         }
     }
     for {set x 0} {$x < $sz(x)} {incr x} {      ;# Up, down walls
         for {set y 0} {$y < $sz(y)} {incr y} {
             OrMaze $x $y 0   $::WALL(UP)         
             OrMaze $x $y [expr {$sz(z) - 1}] $::WALL(DOWN)  
         }
     }
 }
 ##+##########################################################################
 # 
 # FillMaze
 # 
 # Does the actual maze creation by randomly walking around the maze.
 # 
 proc FillMaze {} {
     global sz maze
     
     InitMaze
     set ::mstack {}
     eval PushPos [PickEntrance]
     set cnt [expr {$sz(x) * $sz(y) * $sz(z)}]
     
     while {1} {
         foreach {px py pz} [PopPos] break
         if {$px == -1} break                    ;# We're done
         set newDir [PickDir $px $py $pz]        ;# Get a new direction
         if {$newDir == -1} continue             ;# Can't move, try new position
         set whence [OPPOSITE $newDir]
         
         PushPos $px $py $pz
         OrMaze $px $py $pz [DOORDIR $newDir]    ;# Add door in the new direction
 
         # Cell we move into
         foreach {px py pz} [MOVETO $px $py $pz $newDir] break
 
         # It too has a door
         PushPos $px $py $pz
         OrMaze $px $py $pz [DOORDIR $whence]
 
         # Stuff solution info into high bits
         OrMaze $px $py $pz [BACKINFO $whence]
         if {([incr cnt -1] % 100) == 0} { INFO "Thinking $cnt" }
     }
     INFO "drawing"
 
     # Now open the outer wall up for our entrance and exit
     set maze($sz(start)) [expr {$maze($sz(start)) & ~$::WALL(WEST)}]
     set maze($sz(end))   [expr {$maze($sz(end))   & ~$::WALL(EAST)}]
 }
 ##+##########################################################################
 # 
 # PickEntrance
 # 
 # Pick where the entrance and exit should be.
 # 
 proc PickEntrance {} {
     set y1 [expr {int(rand() * $::sz(y))}]
     set y2 [expr {int(rand() * $::sz(y))}]
 
     set ::sz(start) "0,$y1,0"
     set ::sz(end)   "[expr {$::sz(x) - 1}],$y2,[expr {$::sz(z) - 1}]"
     return [list 0 $y1 0]
 }
 ##+##########################################################################
 # 
 # PickDir
 #
 # Picks a random legal direction to move from (px,py,pz), -1 if no move.
 # 
 proc PickDir {px py pz} {
     set dirs {}
     foreach dir {0 1 2 3 4 5} {
         eval lappend dirs [OKDir? $px $py $pz $dir]
     }
     
     set len [llength $dirs]
     if {$len == 0} {return -1}
     return [lindex $dirs [expr {int(rand() * $len)}]]
 }
 ##+##########################################################################
 # 
 # OKDir?
 # 
 # Sees if it's legal to move in direction dir. If that cell is
 # already visited then we put up a wall.
 # 
 proc OKDir? {px py pz dir} {
     if {$::maze($px,$py,$pz) & [WALLDOORDIR $dir]} {return ""}
     foreach {px2 py2 pz2} [MOVETO $px $py $pz $dir] break
     if {$::maze($px2,$py2,$pz2) & $::DOOR(ANY)} { ;# Destination already done?
         OrMaze $px $py $pz [WALLDIR $dir]
         OrMaze $px2 $py2 $pz2 [WALLDIR [OPPOSITE $dir]]
         return ""
     }
     return $dir
 }
 ##+##########################################################################
 # 
 # DoDisplay
 # 
 # Initializes our (simple) display
 # 
 proc DoDisplay {} {
     pack [frame .bottom] -side bottom -fill x
     canvas .c -relief raised -bd 2 -width $::sz(w) -height $::sz(h)
     scale .x -orient h -var sz(x) -fr 2 -to 100 -label "Maze Width" -relie ridge
     scale .y -orient h -var sz(y) -fr 2 -to 100 -label "Maze Height" -reli ridge
     button .new -text "New Maze" -command NewMaze
     button .solve -text "Show Solution" -command ShowSolution
 
     pack .c -side top -fill both -expand 1
     pack .x .y -side left -in .bottom
     pack .new .solve -side left -in .bottom -expand 1
     update
 }
 ##+##########################################################################
 # 
 # ShowMaze
 # 
 # Shows level 0 of the current maze
 # 
 proc ShowMaze {} {
     .c delete all
 
     set x [expr {$::sz(lm) + ($::sz(x) * $::sz(box) / 2)}]
     set txt "Maze: $::sz(x)x$::sz(y)"
     if {$::sz(z) > 1} {append txt "x$::sz(z) Level 0"}
     .c create text $x 10 -text $txt -anchor n -font bold
     ShowLevel 0
     .solve config -text "Show Solution"
 }
 ##+##########################################################################
 # 
 # ShowLevel
 # 
 # Draws this level of the maze (for mazes with sz(z) > 1)
 # 
 proc ShowLevel {z} {
     .c delete maze
     for {set x 0} {$x < $::sz(x)} {incr x} {
         for {set y 0} {$y < $::sz(y)} {incr y} {
             ShowCell $x $y $z
         }
     }
 }
 ##+##########################################################################
 # 
 # ShowCell
 # 
 # Shows walls for this cell
 # 
 proc ShowCell {x y z} {
     set m $::maze($x,$y,$z)
     set w $::sz(lw)
     
     foreach {cx cy x0 y0 x1 y1 x2 y2 x3 y3} [CellXY $x $y] break
     
     if {$m & $::WALL(NORTH)} {.c create line $x0 $y0 $x1 $y1 -wid $w -tag maze}
     if {$m & $::WALL(EAST)}  {.c create line $x1 $y1 $x2 $y2 -wid $w -tag maze}
     if {$m & $::WALL(SOUTH)} {.c create line $x2 $y2 $x3 $y3 -wid $w -tag maze}
     if {$m & $::WALL(WEST)}  {.c create line $x3 $y3 $x0 $y0 -wid $w -tag maze}
     if {$m & $::DOOR(UP)}    {.c create text $x0 $y0 -text " u" \
                                  -anchor nw -tag maze}
     if {$m & $::DOOR(DOWN)}  {.c create text $x1 $y1 -text "d " \
                                  -anchor ne -tag maze}
 }
 ##+##########################################################################
 # 
 # ShowSolution
 # 
 # Uses the BACKINFO in each cell to get the solution.
 # 
 proc ShowSolution {} {
     if {[.c find withtag s] != ""} {            ;# Already showing solution???
         .c delete s
         .solve config -text "Show Solution"
         return
     }
     foreach {px py pz} [split $::sz(end) ,] break
     foreach {cx cy x0 y0 x1 y1 x2 y2 x3 y3} [CellXY $px $py] break
     set xy [list $x1 $cy]                       ;# The exit door
     
     while {1} {
         foreach {x y} [CellXY $px $py] break
         lappend xy $x $y
         
         set back [BACKUNINFO $::maze($px,$py,$pz)]
         if {$back == -1} break
         foreach {px py pz} [MOVETO $px $py $pz $back] break
     }
     foreach {cx cy x0 y0 x1 y1 x2 y2 x3 y3} [CellXY $px $py] break
     lappend xy $x0 $cy                          ;# Then entrance door
     
     .c create line $xy -tag s -fill cyan -width 5 -arrow first
     .solve config -text "Hide Solution"
 }
 ##+##########################################################################
 # 
 # CellXY
 # 
 # Returns the coordinates of cell at (px,py) starting nw and going clockwise.
 # 
 proc CellXY {px py} {
     set x [expr {$::sz(lm) + $px * $::sz(box)}]
     set y [expr {$::sz(tm) + $py * $::sz(box)}]
     set cx [expr {$::sz(lm) + ($px+.5) * $::sz(box)}]
     set cy [expr {$::sz(tm) + ($py+.5) * $::sz(box)}]
 
     set xy [list $cx $cy $x $y]
     set x [expr {$x + $::sz(box)}]
     lappend xy $x $y
     set y [expr {$y + $::sz(box)}]
     lappend xy $x $y
     set x [expr {$x - $::sz(box)}]
     lappend xy $x $y
 
     return $xy
 }
 ##+##########################################################################
 # 
 # OrMaze
 # 
 # Helper function to logically OR value to maze(x,y,z)
 # 
 proc OrMaze {x y z value} {
     set ::maze($x,$y,$z) [expr {$::maze($x,$y,$z) | $value}]
 }
 ##+##########################################################################
 # 
 # PushPos
 # 
 # Pushes a position onto stack stack
 #
 proc PushPos {x y z} {
     lappend ::mstack [list $x $y $z]
     return ""
 }
 ##+##########################################################################
 # 
 # PopPos
 # 
 # Pops top position off the stack. If we always take the top, then the
 # maze will have one main corridor from the initial random walk. So we
 # occassionally pick a position at random.
 # 
 proc PopPos {} {
     set len [llength $::mstack]
     if {$len == 0} { return [list -1 -1 -1]}
 
     set where end
     if {rand() > .8} { set where [expr {int(rand() * $len)}] }
     set pos [lindex $::mstack end]
     set ::mstack [lrange $::mstack 0 end-1]
     return $pos
 }
 
 Init
 DoDisplay
 NewMaze

<<categories>> Graph Theory | Application | Games