AutoMaze - BBH based on suggestion by Richard Suchenwirth, using his graph code from Graph theory in Tcl
##################################################################
# 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]
while { ! [isTree $g] } {
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}
}makeGUI