AutoMaze - BBH based on suggestion by RS, using his graph code from Graph theory in Tcl. Those unfamiliar with Tcl/Tk will want to read, "When all you want is to run a Tk application".
This seems to require an 'edges' proc which isn't defined... RS Not here, but as alluded above, you need a few routines from Graph theory in Tcl: edges, nodes, isBridge, isContinuous. As comments between Tcl code are guarded there with "if 0 {...}", just grab the whole chunk from "proc nodes" to (inclusively) "isBridge", paste into your editor, go!
RS added doodler, see end of page
BBH created new multi-player game version at TkMaze
KPV see maze generator2 for a faster version of generating mazes. It's used in the 3D Maze game.
##################################################################
# Auto Maze
# CAUTION : don;t try too large a grid size as this is NOT efficient
# you end up doing a lot of list operations on some large lists
#
##################################################################
proc createGrid {w h} {
set g ""
for {set r 0; set r1 1} {$r < $h} {incr r ; incr r1 } {
for {set c 0 ; set c1 1} {$c < $w} {incr c ; incr c1 } {
if {$r1 < $h} { lappend g "R${r}C$c,R${r1}C$c" }
if {$c1 < $w} { lappend g "R${r}C$c,R${r}C$c1" }
}
}
return $g
}
proc random {n} { expr {int(rand() * $n)} }
proc lYank {_L i} {
upvar 1 $_L L
set item [lindex $L $i]
set L [lreplace $L $i $i]
return $item
}
proc lDelete {_L item} {
upvar 1 $_L L
set i [lsearch -exact $L $item]
set L [lreplace $L $i $i]
}
proc reduceGraph {g} {
set eList [edges $g]
set n [expr {$::H*$::W-1}] ;# bbh fixed, RS brought here
while {[llength $g]>$n } {
set edge [lYank eList [random [llength $eList]]]
if { ! [isBridge $edge $g] } {
lDelete g $edge
}
}
return $g
}
proc renderMaze {g cvs} {
$cvs delete all
foreach e $g {
if [regexp {R(\d+)C(\d+),R(\d+)C(\d+)} $e -> r1 c1 r2 c2] {
set y1 [expr {($r1 * 10.0) + 1.0}]
set y2 [expr {($r2 * 10.0) + 9.0}]
set x1 [expr {($c1 * 10.0) + 1.0}]
set x2 [expr {($c2 * 10.0) + 9.0}]
$cvs create rectangle $x1 $y1 $x2 $y2 -fill $::CLR -outline $::CLR
}
}
# make enter/exit points..
foreach {x y} [list [random $::W] 0 [random $::W] $::H] {
set x [expr {$x * 10.0}]
set y [expr {$y * 10.0}]
$cvs create rectangle \
[expr {$x + 1.0}] [expr {$y - 1.0}] \
[expr {$x + 9.0}] [expr {$y + 1.0}] \
-fill $::CLR -outline $::CLR
}
foreach x [list -1.0 [expr {($::W * 10) + 1.0}]] {
$cvs create rectangle $x 0.0 $x 0.0 -fill {} -outline {}
}
# second time looks better - so do it twice
scaleData $cvs
after idle scaleData $cvs
}
proc scaleData {cvs} {
set bbox [$cvs bbox all]
if {[llength $bbox] != 4} {
return
}
foreach {x1 y1 x2 y2} $bbox break
set dw [expr $x2 - $x1]
set dh [expr $y2 - $y1]
set cw [winfo width $cvs]
set ch [winfo height $cvs]
set sx [expr {double($cw)/double($dw)}]
set sy [expr {double($ch)/double($dh)}]
$cvs move all [expr -1 * $x1] [expr -1 * $y1]
$cvs scale all 0 0 $sx $sy
}
proc newMaze {} {
global H W
set g [createGrid $W $H]
set m [reduceGraph $g]
renderMaze $m .c
}
proc makeGUI {} {
wm title . "Maze"
set ::W 10
set ::H 10
set ::CLR grey75
. config -background $::CLR
label .lw -text Width: -background $::CLR
entry .ew -textvar W -width 5 -validate all -vcmd {string is integer %P}
label .lh -text Height: -background $::CLR
entry .eh -textvar H -width 5 -validate all -vcmd {string is integer %P}
button .b -text "New Maze" -command newMaze -background $::CLR
canvas .c -width 400 -height 400 -bd 0 -relief flat -background black -highlightthickness 0
grid x .lw .ew .lh .eh .b x -padx 5 -pady 5
grid .c -columnspan 99 -sticky news -padx 5 -pady 5
grid rowconfigure . 1 -weight 1
grid columnconfig . 0 -weight 1
grid columnconfig . 6 -weight 1
update
bind .c <Configure> {scaleData %W}
}
makeGUIOr, to make larger mazes in a reasonable amount of time - BBH
proc createGrid {w h} {
set g ""
for {set r 0; set r1 1} {$r < $h} {incr r ; incr r1 } {
for {set c 0 ; set c1 1} {$c < $w} {incr c ; incr c1 } {
if {$r1 < $h} { lappend g "R${r}C$c,R${r1}C$c" }
if {$c1 < $w} { lappend g "R${r}C$c,R${r}C$c1" }
}
}
return $g
}
proc random {n} { expr {int(rand() * $n)} }
proc lYank {_L i} {
upvar 1 $_L L
set item [lindex $L $i]
set L [lreplace $L $i $i]
return $item
}
proc lDelete {_L item} {
upvar 1 $_L L
set i [lsearch -exact $L $item]
set L [lreplace $L $i $i]
}
proc reduceGraph {g w h} {
set eList [edges $g]
set n [expr {$w*$h -1}]
while {[llength $g] > $n } {
set edge [lYank eList [random [llength $eList]]]
if { ! [isBridge $edge $g] } {
lDelete g $edge
}
}
return $g
}
proc renderMazeBlock {g cvs origX origY} {
foreach e $g {
if [regexp {R(\d+)C(\d+),R(\d+)C(\d+)} $e -> r1 c1 r2 c2] {
set x1 [expr {$origX + ($c1 * 10.0) + 1.0}]
set x2 [expr {$origX + ($c2 * 10.0) + 9.0}]
set y1 [expr {$origY + ($r1 * 10.0) + 1.0}]
set y2 [expr {$origY + ($r2 * 10.0) + 9.0}]
$cvs create rectangle $x1 $y1 $x2 $y2 -fill $::CLR -outline $::CLR
}
}
}
proc connectMazeBlocks {g cvs} {
foreach e $g {
if [regexp {R(\d+)C(\d+),R(\d+)C(\d+)} $e -> r1 c1 r2 c2] {
if {$r1 == $r2} {
set y1 [expr {($r1*100.0) + ([random 10] * 10.0) + 3.0}]
set y2 [expr $y1 + 8.0]
set x1 [expr {($c2*100.0) - 5.0}]
set x2 [expr {($c2*100.0) + 5.0}]
} else {
set x1 [expr {($c1*100.0) + ([random 10] * 10.0) + 3.0}]
set x2 [expr $x1 + 8.0]
set y1 [expr {($r2*100.0) - 5.0}]
set y2 [expr {($r2*100.0) + 5.0}]
}
$cvs create rectangle $x1 $y1 $x2 $y2 -fill $::CLR -outline $::CLR
}
}
# make enter/exit points..
foreach {X Y} [list [random $::W] 0 [random $::W] $::H] {
set x [expr {$X * 100.0 + [random 10] * 10.0}]
set y [expr {$Y * 100.0}]
$cvs create rectangle \
[expr {$x + 3.0}] [expr {$y - 5.0}] \
[expr {$x + 11.0}] [expr {$y + 5.0}] \
-fill $::CLR -outline $::CLR
}
}
proc newMaze {} {
global H W
.c delete all
.c config -width [expr $W*100 + 4] -height [expr $H*100+4] -cursor watch
set ::N [expr $W*$H]
set blocks {}
label .c.l -font {helvetica 144 bold italic} -textvar N -background black -foreground yellow
.c create window [expr $W*50] [expr $H*50] -anchor c -window .c.l
update
for {set r 0} {$r < $H} {incr r} {
for {set c 0} {$c < $W} {incr c} {
set oX [expr $c * 100 + 2]
set oY [expr $r * 100 + 2]
set g [createGrid 10 10]
lappend blocks [reduceGraph $g 10 10] $oX $oY
incr ::N -1
update
}
}
set g [createGrid $W $H]
set m [reduceGraph $g $W $H]
destroy .c.l
foreach {b x y} $blocks {
renderMazeBlock $b .c $x $y
}
connectMazeBlocks $m .c
.c config -cursor {}
}
proc makeGUI {} {
wm title . "Maze"
set ::W 5
set ::H 5
set ::CLR grey75
. config -background $::CLR
label .lw -text Width: -background $::CLR
tk_optionMenu .ew W 1 2 3 4 5 6 7 8 9 10
.ew config -background $::CLR
label .lh -text Height: -background $::CLR
tk_optionMenu .eh H 1 2 3 4 5 6 7 8 9 10
.eh config -background $::CLR
button .b -text "New Maze" -command newMaze -background $::CLR
canvas .c -width 504 -height 504 -bd 0 -relief flat -background black -highlightthickness 0
grid x .lw .ew .lh .eh .b x -padx 5 -pady 5
grid .c -columnspan 99 -sticky {} -padx 5 -pady 5
wm resizable . 0 0
}RS could not resist to add doodling functionality (draw a line with left mouse button down), so you can better see your way through the maze... Just append this code at end and enjoy!
proc doodle {w {color black}} {
#-- enable a canvas to accept mouse drawing
bind $w <1> [list doodle'start %W %x %y $color]
bind $w <B1-Motion> {doodle'move %W %x %y}
}
proc doodle'start {w x y color} {
set x0 [$w canvasx $x]
set y0 [$w canvasy $y]
set ::_id [$w create line $x0 $y0 $x0 $y0 \
-width 3 -fill $color]
}
proc doodle'move {w x y} {
set x0 [$w canvasx $x]
set y0 [$w canvasy $y]
eval $w coords $::_id [concat [$w coords $::_id] $x0 $y0]
}
doodle .c red ;# install the bindings DKF: I've implemented [L1 ] a maze generator based on the idea of growing a crystal from a seed (somewhat like a Diffusion-limited Aggregate fractal) which also includes some discussion of the issues relating to building a maze in such a way.
In short, for mazes that are very much like a person would create, you need to make the probability of extending the maze from the place where you last extended (assuming it is legal to do so) be very high, as this tends to give very long and twisty passages with very few junctions. By contrast, a maze that looks like it was designed by a computer can be done by giving every legal adding point the same chance, though these mazes tend to be fairly easy to get about in once you puzzle out where the initial growth point is (the maze passages tend to end up radiating out from there with very few twists and turns.)
KPV -- This method can easily be extended into 3-dimensions simply by allowing growth to also move up and down. But this raises another issue in generating 'nice' looking mazes, namely, you don't want too many up and down doors. So, not only do you have to bias which cell to grow from, you also need to bias which direction to go. Maze generator2 uses this method. It also describes the cool property of being able to quickly compute the solution from any point in the maze to any other point.
http://www.ai.mit.edu/people/shivers/mazes.html is a Scheme-expressed reference. http://www.jwz.org/xscreensaver/ uses C to build mazes. http://www.moo3.at/flo/labyrinth/code.html has source for a PHP-based generator, and http://zxw.nm.ru/maze.htm or http://aspn.activestate.com/ASPN/Cookbook/Python/Recipe/252127 for one in Python.