maze generator2
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.
uniquename 2013aug18
This nice maze generator deserves to have an image to let all who stumble across this page know what the code below creates.
I added a 'tk_setPalette' statement to my copy of this code, to give the GUI a blue background rather than the default gray palette of the code below. This helps make the solution stand out when you click the 'show solution' button.
##+##########################################################################
#
# 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