Anonymous user
Maze generation: Difference between revisions
→Tcl: Added implementation
(Javascript: slightly clearer code) |
(→Tcl: Added implementation) |
||
Line 231:
+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
a b c d e f g h i j k l m n o p</pre>
=={{header|Tcl}}==
{{trans|Javascript}}
<lang tcl>package require Tcl 8.5
# Helper to pick a random element of a list
proc pick list {
lindex $list [expr {int(rand() * [llength $list])}]
}
# Helper to index into a list of lists with offsets
proc tcl::mathfunc::idx {v x y} {
lindex $v [expr {$x+1}] [expr {$y+1}]
}
# Helper to write into a list of lists (with offsets)
proc unvisited= {x y value} {
upvar 1 unvisited u
lset u [expr {$x+1}] [expr {$y+1}] $value
}
# Maze builder; returns a dictionary
proc maze {x y} {
set n [expr {$x * $y - 1}]
if {$n < 0} {error "illegal maze dimensions"}
set horiz [lrepeat [expr {$x+1}] [lrepeat [expr {$y+1}] 0]]
set verti [lrepeat [expr {$x+1}] [lrepeat [expr {$y+1}] 0]]
set here [list [expr {int(rand()*$x)}] [expr {int(rand()*$y)}]]
set path [list $here]
set unvisited [lrepeat [expr {$x+2}] [lrepeat [expr {$y+2}] 0]]
for {set j 0} {$j < $x} {incr j} {
for {set k 0} {$k < $y} {incr k} {
unvisited= $j $k [expr {$here ne [list $j $k]}]
}
}
while {0 < $n} {
lassign $here hx hy
set neighbours {}
foreach {dx dy} {1 0 0 1 -1 0 0 -1} {
if {idx($unvisited, $hx+$dx, $hy+$dy)} {
lappend neighbours [list [expr {$hx+$dx}] [expr {$hy+$dy}]]
}
}
if {[llength $neighbours]} {
incr n -1
lassign [set here [pick $neighbours]] nx ny
unvisited= $nx $ny 0
if {$nx == $hx} {
set py [expr {($ny + $hy - 1) / 2}]
lset horiz $nx $py 1
} else {
set px [expr {($nx + $hx - 1) / 2}]
lset verti $px $ny 1
}
lappend path $here
} else {
set here [lindex $path end]
set path [lrange $path 0 end-1]
}
}
return [dict create x $x y $y horiz $horiz verti $verti]
}
# Maze displayer; takes a maze dictionary
proc display {m} {
set text {}
dict with m {
for {set j 0} {$j < $x*2+1} {incr j} {
set line {}
for {set k 0} {$k < $y*4+1} {incr k} {
if {$j%2 && ($k%4 || $k && idx($horiz, ($j-1)/2, $k/4-1))} {
append line " "
} elseif {$j%2} {
append line "|"
} elseif {0 == $k%4} {
append line "+"
} elseif {$j && idx($verti, $j/2-1, $k/4)} {
append line " "
} else {
append line "-"
}
}
if {!$j} {set line [string replace $line 1 3 " "]}
if {$x*2-1 == $j} {set line [string replace $line end end " "]}
lappend text $line
}
}
return [join $text \n]
}
# Demonstration
puts [display [maze 8 11]]</lang>
Output:
<pre>
+ +---+---+---+---+---+---+---+---+---+---+
| | | |
+---+---+ +---+---+ + +---+ +---+ +
| | | | | |
+ + +---+ +---+---+ +---+ + + +
| | | | | | | |
+ +---+ +---+---+---+ + + + + +
| | | | | | | |
+ + + + +---+---+ + +---+---+ +
| | | | | | | |
+---+---+---+---+ + +---+ + + +---+
| | | | | | | |
+ +---+---+ + + + + + +---+ +
| | | | | | | |
+---+ + +---+---+---+---+ + +---+ +
| |
+---+---+---+---+---+---+---+---+---+---+---+
</pre>
| |||