AutoMaze - [BBH] based on suggestion by [Richard Suchenwirth], using his graph code from [Graph theory in Tcl]

This seems to require an 'edges' proc which isn't defined...

[RS] added doodler, see end of page
 ##################################################################
 # 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}
 }
 
 makeGUI
----
Or, 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
 }
----
if 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 
----
[Category Application]