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 use in the [3DMaze] games. ################################################################## # 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 {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 {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 [http://www.cs.man.ac.uk/~fellowsd/tcl/#games/maze] 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.) ---- [Category Application] | [Category Games]