#
 # AutoMaze - from suggestion by [Richard Suchenwirth], using his graph
 # code from [Graph theory in Tcl]
 #
 # by [BBH]
 #
 # 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