[KPV] - like [maze generator] this little program produces mazes. This version is simpler and much faster than previous version.

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.

----
 ##+##########################################################################
 #
 # 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+
 #
 
 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