Keith Vetter : using the maze generating engine from maze generator2, this little game displays 3D mazes. You can adjust the width, height and depth of the maze. You can also try solving the maze by moving around a man with the arrow keys. At any point, you can have the shortest route to the exit displayed.
##+##########################################################################
#
# 3DMaze.tcl
#
# Draws a maze with a guaranteed unique solution.
# by Keith Vetter
#
# The program works by picking a spot randomly in the maze, then
# random walking until it can't proceed on untravelled cells. It then
# backs up until it can branch onto a untravelled cells and proceeds
# on a new random walk. When all cells have been visited we're done
# except for selecting a spot on the east and west wall for the
# entrances.
#
# Revisions:
# KPV August 31, 1994 - initial revision
# KPV Sep 24, 2002 - ported to tk8+
# KPV Sep 25, 2002 - exposed 3d capabilities, added the moving man
set sz(x) 15 ;# Maze width
set sz(y) 15 ;# Maze height
set sz(z) 3 ;# Maze levels
##+##########################################################################
#
# Init
#
# Sets up some global variables.
#
proc Init {} {
global sz DIR WALL DOOR MOTION MARK
set sz(w) 550 ;# Canvas width
set sz(h) 550 ;# Canvas height
set sz(box) 30 ;# Cell box size
set sz(tm) 50 ;# Top margin
set sz(lm) 50 ;# Left margin
set sz(lw) 3 ;# Line width
set sz(animate) 0
set sz(solution) {}
# These directions also act as bit shift amounts
array set DIR {NORTH 0 EAST 1 UP 2 SOUTH 3 WEST 4 DOWN 5 DONE -1}
foreach {a b} [array get DIR] {set DIR($b) $a}
array set WALL {
NORTH 0x01 EAST 0x02 UP 0x04 SOUTH 0x08 WEST 0x10 DOWN 0x20 ANY 0x3F
}
array set DOOR {
NORTH 0x0100 EAST 0x0200 UP 0x0400 SOUTH 0x0800 WEST 0x1000 DOWN 0x2000
ANY 0x3F00
}
array set MOTION {
0,x 0 0,y -1 0,z 0 1,x 1 1,y 0 1,z 0 2,x 0 2,y 0 2,z -1
3,x 0 3,y 1 3,z 0 4,x -1 4,y 0 4,z 0 5,x 0 5,y 0 5,z 1
}
array set MARK {X 0x4000 ? 0x8000 ANY 0xC000 VICTORY 0x400}
}
proc WALLDIR {dir} {return [expr {$::WALL(NORTH) << $dir}] }
proc DOORDIR {dir} {return [expr {$::DOOR(NORTH) << $dir}] }
proc WALLDOORDIR {dir} {return [expr {($::WALL(NORTH) | $::DOOR(NORTH))<<$dir}]}
proc OPPOSITE {dir} {return [expr {($dir + 3) % 6}] }
proc ADDHINT {x y z dir} {ORMAZE $x $y $z [expr {($dir + 1) << 16}]}
proc GETHINT {x y z} {return [expr {($::maze($x,$y,$z) >> 16) - 1}]}
proc ORMAZE {x y z n} {set ::maze($x,$y,$z) [expr {$::maze($x,$y,$z) | $n}]}
proc INFO {msg} {.c itemconfig INFO -text $msg ; update idletasks }
proc CANMOVE {x y z d} {expr {$::maze($x,$y,$z) & [DOORDIR $d]}}
proc ISMARKED {x y z who} {expr {$::maze($x,$y,$z) & $who}}
proc DOMARK {x y z who} {ORMAZE $x $y $z $who}
proc UNMARK {x y z who} {set ::maze($x,$y,$z) [expr {$::maze($x,$y,$z) &~$who}]}
proc MOVETO {x y z d} {list [incr x $::MOTION($d,x)] [incr y $::MOTION($d,y)] \
[incr z $::MOTION($d,z)]}
##+##########################################################################
#
# NewMaze
#
# Creates a new maze of a given size.
#
proc NewMaze {{x -1} {y -1} {z 1}} {
if {$x != -1} { set ::sz(x) $x ; set ::sz(y) $y ; set ::sz(z) $z }
set w [winfo width .c] ; set h [winfo height .c]
.c config -scrollregion [list 0 0 $w $h]
.c delete all
.c create text [expr $w/2] [expr $h/2] -anchor c -font bold -tag INFO
INFO "thinking"
set w [expr {($w - 2.0*$::sz(lm)) / $::sz(x)}]
set h [expr {($h - 2.0*$::sz(tm)) / $::sz(y)}]
set x [expr {$w < $h ? $w : $h}]
set ::sz(box) [expr {$x > 100 ? 100 : $x < 5 ? 5 : $x}]
set ::sz(solve) 0
AnimateCmd 0
FillMaze
ShowMaze
set ::sz(best) [llength [GetSolution]]
}
##+##########################################################################
#
# InitMaze
#
# Set up emptry with only outer walls matrix
#
proc InitMaze {} {
global maze sz
catch {unset maze}
for {set x 0} {$x < $sz(x)} {incr x} { ;# Set all cells to 0
for {set y 0} {$y < $sz(y)} {incr y} {
for {set z 0} {$z < $sz(z)} {incr z} {
set maze($x,$y,$z) 0
}
}
}
for {set z 0} {$z < $sz(z)} {incr z} { ;# North, south walls
for {set x 0} {$x < $sz(x)} {incr x} {
ORMAZE $x 0 $z $::WALL(NORTH)
ORMAZE $x [expr {$sz(y) - 1}] $z $::WALL(SOUTH)
}
}
for {set z 0} {$z < $sz(z)} {incr z} { ;# East, west walls
for {set y 0} {$y < $sz(y)} {incr y} {
ORMAZE 0 $y $z $::WALL(WEST)
ORMAZE [expr {$sz(x) - 1}] $y $z $::WALL(EAST)
}
}
for {set x 0} {$x < $sz(x)} {incr x} { ;# Up, down walls
for {set y 0} {$y < $sz(y)} {incr y} {
ORMAZE $x $y 0 $::WALL(UP)
ORMAZE $x $y [expr {$sz(z) - 1}] $::WALL(DOWN)
}
}
}
##+##########################################################################
#
# FillMaze
#
# Does the actual maze creation by randomly walking around the maze.
#
proc FillMaze {} {
global sz maze
InitMaze
set ::mstack {}
eval PushPos [PickEntrance]
set cnt [expr {$sz(x) * $sz(y) * $sz(z)}]
while {1} {
foreach {px py pz} [PopPos] break
if {$px == -1} break ;# We're done
set newDir [PickDir $px $py $pz] ;# Get a new direction
if {$newDir == -1} continue ;# Can't move, try new position
set whence [OPPOSITE $newDir]
PushPos $px $py $pz
ORMAZE $px $py $pz [DOORDIR $newDir] ;# Add door in the new direction
# Cell we move into
foreach {px py pz} [MOVETO $px $py $pz $newDir] break
# It too has a door
PushPos $px $py $pz
ORMAZE $px $py $pz [DOORDIR $whence]
# Stuff solution info into high bits
ADDHINT $px $py $pz $whence
if {([incr cnt -1] % 100) == 0} { INFO "Thinking $cnt" }
}
INFO "drawing"
# Now open the outer wall up for our entrance and exit
set maze($sz(start)) [expr {$maze($sz(start)) & ~$::WALL(WEST)}]
set maze($sz(end)) [expr {$maze($sz(end)) & ~$::WALL(EAST)}]
set maze($sz(end)) [expr {$maze($sz(end)) | $::DOOR(EAST)}]
set sz(solution) {}
}
##+##########################################################################
#
# PickEntrance
#
# Pick where the entrance and exit should be.
#
proc PickEntrance {} {
set x1 0 ;# Left wall
set y1 [expr {int(rand() * $::sz(y))}]
set z1 0
set x2 [expr {$::sz(x) - 1}] ;# Right wall
set y2 [expr {int(rand() * $::sz(y))}]
set z2 [expr {int(rand() * $::sz(z))}]
set z2 [expr {$::sz(z) - 1}]
set ::sz(lvl) $z1
set ::sz(start) "$x1,$y1,$z1"
set ::sz(end) "$x2,$y2,$z2"
set ::sz(end2) [list $::sz(x) $y2 $z2]
foreach {::sz(px) ::sz(py) ::sz(pz)} [list $x1 $y1 $z1] break
set ::maze($::sz(x),$y2,$z2) [DOORDIR $::DIR(WEST)] ;# MoveMan needs this
set ::sz(cnt) 0
return [list $x2 $y2 $z2]
}
##+##########################################################################
#
# PickDir
#
# Picks a random legal direction to move from (px,py,pz), -1 if no move.
#
proc PickDir {px py pz} {
set dirs {}
foreach dir {0 1 2 3 4 5} {
eval lappend dirs [OKDir? $px $py $pz $dir]
}
regsub -all {([0134] )} $dirs {\1\1\1\1} dirs ;# Make up/down less likely
set len [llength $dirs]
if {$len == 0} {return -1}
return [lindex $dirs [expr {int(rand() * $len)}]]
}
##+##########################################################################
#
# OKDir?
#
# Sees if it's legal to move in direction dir. If that cell is
# already visited then we put up a wall.
#
proc OKDir? {px py pz dir} {
if {$::maze($px,$py,$pz) & [WALLDOORDIR $dir]} {return ""}
foreach {px2 py2 pz2} [MOVETO $px $py $pz $dir] break
if {$::maze($px2,$py2,$pz2) & $::DOOR(ANY)} { ;# Destination visited???
ORMAZE $px $py $pz [WALLDIR $dir] ;# Yes, put up a wall
ORMAZE $px2 $py2 $pz2 [WALLDIR [OPPOSITE $dir]]
return ""
}
return $dir
}
##+##########################################################################
#
# DoDisplay
#
# Initializes our display
#
proc DoDisplay {} {
wm title . "3D Maze"
pack [frame .bottom] -side bottom -fill x
canvas .c -relief raised -bd 2 -wid $::sz(w) -height $::sz(h) -highlightth 0
scrollbar .sb -command ScrollBarCmd
scale .x -orient h -var sz(x) -fr 2 -to 100 -label "Maze Width" -relie ridge
scale .y -orient h -var sz(y) -fr 2 -to 100 -label "Maze Height" -reli ridge
scale .z -orient h -var sz(z) -fr 1 -to 5 -label "Maze Depth" -relie ridge
button .new -text "New Maze" -command NewMaze
checkbutton .anim -text "Animate Solution" -command {AnimateCmd -1} \
-variable sz(animate) -relief raised -anchor w
checkbutton .solve -text "Show Solution" -command {ShowSolution -1} \
-variable sz(solve) -relief raised -anchor w
button .helper -text Help -command Help
pack .sb -side right -fill y
pack .c -side left -fill both -expand 1
pack .x .y .z -side left -in .bottom
pack .new -side left -in .bottom -expand 1
pack .solve .anim .helper -side top -in .bottom -fill x -padx 1m
bind .c <MouseWheel> {ScrollBarCmd scroll [expr {-%D/abs(%D)}] page}
bind .c <Key-Up> [list MoveMan $::DIR(NORTH) 0]
bind .c <Shift-Key-Up> [list MoveMan $::DIR(NORTH) 1]
bind .c <Key-Down> [list MoveMan $::DIR(SOUTH) 0]
bind .c <Shift-Key-Down> [list MoveMan $::DIR(SOUTH) 1]
bind .c <Key-Left> [list MoveMan $::DIR(WEST) 0]
bind .c <Shift-Key-Left> [list MoveMan $::DIR(WEST) 1]
bind .c <Key-Right> [list MoveMan $::DIR(EAST) 0]
bind .c <Shift-Key-Right> [list MoveMan $::DIR(EAST) 1]
bind .c <Key-Prior> [list MoveMan $::DIR(UP) 0]
bind .c <Shift-Key-Prior> [list MoveMan $::DIR(UP) 1]
bind .c <Key-Home> [list MoveMan $::DIR(UP) 0]
bind .c <Shift-Key-Home> [list MoveMan $::DIR(UP) 1]
bind .c <Key-Next> [list MoveMan $::DIR(DOWN) 0]
bind .c <Shift-Key-Next> [list MoveMan $::DIR(DOWN) 1]
bind .c <Key-End> [list MoveMan $::DIR(DOWN) 0]
bind .c <Shift-Key-End> [list MoveMan $::DIR(DOWN) 1]
bind .c <Key-n> NewMaze
bind .c <Key-space> [list ShowMark 1]
bind Canvas <Button-2> [bind Text <Button-2>]
bind Canvas <B2-Motion> [bind Text <B2-Motion>]
focus .c
update
}
##+##########################################################################
#
# ShowMaze
#
# Shows level 0 of the current maze
#
proc ShowMaze {} {
.c delete all
set x [expr {$::sz(lm) + ($::sz(x) * $::sz(box) / 2)}]
set ::sz(title) "Maze: $::sz(x)x$::sz(y)x$::sz(z)"
.c create text $x 10 -anchor n -font bold -tag title
ShowLevel $::sz(lvl)
}
##+##########################################################################
#
# ShowLevel
#
# Draws this level of the maze
#
proc ShowLevel {z} {
set ::sz(lvl) $z
.c itemconfig title -text "$::sz(title) Level [expr {$::sz(z) - $z}]"
set low [expr {1.0 * $::sz(lvl) / $::sz(z)}]
set high [expr {(1.0 + $::sz(lvl)) / $::sz(z)}]
.sb set $low $high
.c delete maze solve man mark
for {set x 0} {$x < $::sz(x)} {incr x} {
for {set y 0} {$y < $::sz(y)} {incr y} {
ShowCell $x $y $::sz(lvl)
;#update
}
}
ShowSolution $z
ShowMan 0
}
##+##########################################################################
#
# ShowCell
#
# Shows walls for this cell
#
proc ShowCell {x y z} {
set m $::maze($x,$y,$z)
set w $::sz(lw)
foreach {- - x0 y0 x1 y1 x2 y2 x3 y3} [CellXY $x $y] break
if {$m & $::WALL(NORTH)} {.c create line $x0 $y0 $x1 $y1 -wid $w -tag maze}
if {$m & $::WALL(EAST)} {.c create line $x1 $y1 $x2 $y2 -wid $w -tag maze}
if {$m & $::WALL(SOUTH)} {.c create line $x2 $y2 $x3 $y3 -wid $w -tag maze}
if {$m & $::WALL(WEST)} {.c create line $x3 $y3 $x0 $y0 -wid $w -tag maze}
if {$m & $::DOOR(UP)} {ShowStairs $x $y 1}
if {$m & $::DOOR(DOWN)} {ShowStairs $x $y 0}
if {$m & $::MARK(ANY)} {ShowMark 0 $x $y $z}
}
##+##########################################################################
#
# ShowSolution
#
# Uses the HINT data in each cell to get the solution and displays it
# for level lvl. LVL = -1 then we get a new solution and show for
# level sz(lvl)
#
proc ShowSolution {lvl} {
.c delete solve
if {! $::sz(solve)} return
if {$lvl == -1} {GetSolution ; set lvl $::sz(lvl)}
if {[llength $::sz(solution)] == 0} GetSolution
if {[llength $::sz(solution)] == 0} return
set xy {}
foreach pos $::sz(solution) {
foreach {px py pz} $pos break
if {$pz == $lvl} {
foreach {cx cy} [CellXY $px $py] break
lappend xy $cx $cy
} else {
if {[llength $xy] == 2} {
set xy [MakeBox $xy]
.c create oval $xy -tag solve -fill cyan -outline cyan
} elseif {[llength $xy] > 0} {
.c create line $xy -tag solve -fill cyan -width 5 -arrow last
}
set xy {}
}
}
if {$pz == $lvl} {
foreach {cx cy x0 y0 x1 y1 x2 y2 x3 y3} [CellXY $px $py] break
lappend xy $x1 $cy ;# Exit door
.c create line $xy -tag solve -fill cyan -width 5 -arrow last
}
.c raise man
.c raise mark
}
##+##########################################################################
#
# GetSolution
#
# Returns a list of cells that is the path to the exit.
#
proc GetSolution {} {
set ::sz(solution) {}
if {$::sz(px) == $::sz(x)} {return {}} ;# We're at the exit
foreach {px py pz} [list $::sz(px) $::sz(py) $::sz(pz)] break
while {1} {
lappend xy [list $px $py $pz]
set dir [GETHINT $px $py $pz]
if {$dir == -1} break
foreach {px py pz} [MOVETO $px $py $pz $dir] break
}
set ::sz(solution) $xy
}
##+##########################################################################
#
# CellXY
#
# Returns the coordinates of cell at (px,py) starting nw and going clockwise.
#
proc CellXY {px py} {
set cx [expr {$::sz(lm) + ($px+.5) * $::sz(box)}]
set cy [expr {$::sz(tm) + ($py+.5) * $::sz(box)}]
set x0 [expr {$::sz(lm) + $px * $::sz(box)}]
set y0 [expr {$::sz(tm) + $py * $::sz(box)}]
set x2 [expr {$x0 + $::sz(box)}]
set y2 [expr {$y0 + $::sz(box)}]
return [list $cx $cy $x0 $y0 $x2 $y0 $x2 $y2 $x0 $y2]
}
##+##########################################################################
#
# MakeBox
#
# Returns top left, bottom right of 60% of the cells dimension.
#
proc MakeBox {xy {y -1}} {
if {$y != -1} { set xy [CellXY $xy $y] } ;# Convert maze to canvas units
foreach {x y} $xy break
set amt [expr {(.6 * $::sz(box)) / 2}]
return [list [expr {$x - $amt}] [expr {$y - $amt}] \
[expr {$x + $amt}] [expr {$y + $amt}]]
}
##+##########################################################################
#
# PushPos
#
# Pushes a position onto stack stack
#
proc PushPos {x y z} {
lappend ::mstack [list $x $y $z]
return ""
}
##+##########################################################################
#
# PopPos
#
# Pops top position off the stack. If we always take the top, then the
# maze will have one main corridor from the initial random walk. So we
# occassionally pick a position at random.
#
proc PopPos {} {
set len [llength $::mstack]
if {$len == 0} { return [list -1 -1 -1]}
set where end
if {rand() > .8} { set where [expr {int(rand() * $len)}] }
set pos [lindex $::mstack $where]
set ::mstack [lreplace $::mstack $where $where]
return $pos
}
##+##########################################################################
#
# ShowStairs
#
# Shows stairs going up or down. Pretty poor right now, just an arrow.
#
proc ShowStairs {px py updown} {
foreach {cx cy x0 y0 x1 y1 x2 y2 x3 y3} [CellXY $px $py] break
if {$updown} {
set x [expr {($cx + $x0) / 2}]
set y0 [expr {$y0 + 2}]
.c create line $x $y0 $x $y3 -tag {up maze} -arrow first -width 2 \
-fill magenta
} else {
set x [expr {($cx + $x1) / 2}]
set y3 [expr {$y3 - 2}]
.c create line $x $y0 $x $y3 -tag {down maze} -arrow last -width 2 \
-fill purple
}
}
##+##########################################################################
#
# ScrollBarCmd
#
# Called by scrollbar and mousewheel for changing levels.
#
proc ScrollBarCmd {verb amt args} {
set lvl $::sz(lvl)
if {$verb == "moveto"} {
set lvl [expr {round($amt * $::sz(z))}]
} elseif {$verb == "scroll"} {
if {($amt < 0 && $lvl > 0) || ($amt > 0 && $lvl+1 < $::sz(z))} {
incr lvl $amt
}
}
if {$::sz(lvl) != $lvl} {
ShowLevel $lvl
}
}
##+##########################################################################
#
# MoveMan
#
# Moves the man symbol in the given direction if possible.
#
proc MoveMan {dir all} {
global sz
if {$sz(animate)} return
while {1} {
if {! [CANMOVE $sz(px) $sz(py) $sz(pz) $dir]} break
foreach {sz(px) sz(py) sz(pz)} [MOVETO $sz(px) $sz(py) $sz(pz) $dir] \
break
ShowMan 1
incr sz(cnt)
if {! $all} break
}
if {$sz(px) >= $sz(x)} { ;# Check for victory
if {! [ISMARKED $sz(px) $sz(py) $sz(pz) $::MARK(VICTORY)]} {
set txt "You did it\n\n"
append txt "Total moves: $sz(cnt)\n"
append txt "Best possible: $sz(best)"
tk_messageBox -message $txt
ORMAZE $sz(px) $sz(py) $sz(pz) $::MARK(VICTORY)
}
}
}
##+##########################################################################
#
# ShowMark
#
# Shows the mark for a cell. If toggle, then rotates between various marks
#
proc ShowMark {toggle {x -1} {y -1} {z -1}} {
global sz
if {$x == -1} { foreach {x y z} [list $sz(px) $sz(py) $sz(pz)] break }
if {$toggle} {
if {[ISMARKED $x $y $z $::MARK(X)]} {
UNMARK $x $y $z $::MARK(X)
DOMARK $x $y $z $::MARK(?)
} elseif {[ISMARKED $x $y $z $::MARK(?)]} {
UNMARK $x $y $z $::MARK(?)
} else {
DOMARK $x $y $z $::MARK(X)
}
}
set tag "mark,$x,$y"
.c delete $tag
if {$x == $sz(x)} { UNMARK $x $y $z $::MARK(ANY) ; return } ;# Victory spot
foreach {x0 y0 x2 y2} [MakeBox $x $y] break
if {[ISMARKED $x $y $z $::MARK(X)]} {
.c create line $x0 $y0 $x2 $y2 -fill red -tag [list mark $tag] -width 3
.c create line $x2 $y0 $x0 $y2 -fill red -tag [list mark $tag] -width 3
} elseif {[ISMARKED $x $y $z $::MARK(?)]} {
set w [expr {$x2 - $x0}]
set h [expr {$y2 - $y0}]
foreach {a b c} {.75 .25 .125} break
lappend xy $x0 [expr {$y0 + $a * $h}] [expr {$x0 + $b * $w}] $y2
lappend xy $x2 [expr {$y0 + $c * $h}]
.c create line $xy -tag [list mark $tag] -fill red -width 3
}
.c raise man
}
##+##########################################################################
#
# ShowMan
#
# Displays the polygon for the man. If force, then we change levels if need be.
#
proc ShowMan {force} {
global sz
foreach {x y z} [list $sz(px) $sz(py) $sz(pz)] break
if {$force && $sz(lvl) != $z} { ShowLevel $z }
if {$sz(lvl) != $z} return
.c delete man
if {$sz(box) < 15} {
.c create rect [MakeBox $x $y] -tag man \
-fill dodgerblue -outline dodgerblue
return
}
set man {9 -66 -24 -67 -33 -54 -41 -43 -41 -34 -37 -29 -29 -29 -17 -50
-13 -51 -4 -52 0 -51 2 -50 -1 -45 -24 -5 -23 29 -28 30 -38 31
-46 31 -57 30 -63 31 -64 39 -63 44 -56 45 -49 46 -39 46 -25
47 -9 47 -5 38 -7 24 -4 17 3 20 12 24 17 28 19 38 17 63 23 68
28 68 34 66 35 65 37 60 38 46 37 25 37 19 9 0 8 -6 14 -14 21
-23 23 -24 26 -17 25 -24 25 -15 26 -13 63 -12 65 -14 65 -18
65 -21 60 -26 38 -27 36 -30 34 -51 33 -54 38 -55 45 -59 48
-65 48 -71 48 -75 44 -82 39 -85 33 -87 28 -87 20 -84 19 -83
16 -79 15 -74 13 -70 13 -65}
foreach {cx cy} [CellXY $x $y] break
set sc [expr {$sz(box) * .8 / 160.0}]
foreach {x y} $man {
lappend xy [expr {$cx + $x * $sc}] [expr {$cy + $y * $sc}]
}
.c create poly $xy -tag man -fill dodgerblue
}
##+##########################################################################
#
# AnimateCmd
#
# Turns on and off and start animation.
#
proc AnimateCmd {how} {
if {$how != -1} {set ::sz(animate) $how}
catch {after cancel $::sz(after)} ;# Stop any animation
if {$::sz(animate)} {
set xy [GetSolution]
AnimateSolution [lappend xy $::sz(end2)]
}
}
##+##########################################################################
#
# AnimateSolution
#
# Does the animation of the solution.
#
proc AnimateSolution {{sol -1}} {
if {[llength $sol] == 0} { AnimateCmd 0 ; return}
foreach {::sz(px) ::sz(py) ::sz(pz)} [lindex $sol 0] break
ShowMan 1
update
set ::sz(after) [after 500 AnimateSolution [list [lrange $sol 1 end]]]
}
##+##########################################################################
#
# Help
#
# Give very simple help.
#
proc Help {} {
set txt " o Use the scroll bar or mouse wheel to change which level ";
append txt "is displayed.\n\n"
append txt " o Use the arrow keys, page up and page down to move the man. "
append txt "Shift-arrow keys will move the man until it hits a wall.\n\n"
append txt " o Press the space bar to set and clear marks.\n\n"
append txt " o Showing or Animating the solution will always do so from "
append txt "the current location."
catch {destroy .help}
toplevel .help
wm transient .help .
button .help.quit -text Dismiss -command {catch {destroy .help}}
text .help.t -wrap word -width 70 -height 14 -pady 10
pack .help.quit -side bottom -expand 1
pack .help.t -side left -fill both -expand 1
.help.t insert end "3D Maze" header "\nby Keith Vetter\n\n" header2 $txt n
.help.t tag config header -justify center -font bold -foreground red
.help.t tag config header2 -justify center -font bold
.help.t tag config n -lmargin2 [font measure [.help.t cget -font] " o "]
.help.t config -state disabled
}
##+##########################################################################
#
# what
#
# Debugging routine which displays a cells data.
#
proc what {x y z} {
global maze WALL DOOR MARK DIR
set value $maze($x,$y,$z)
foreach arr [list WALL DOOR MARK] {
puts -nonewline "$arr: "
foreach {name bit} [array get $arr] {
if {$name == "ANY"} continue
if {$value & $bit} {
puts -nonewline [format %-6s [string tolower $name]]
}
}
puts ""
}
puts "HINT: [string tolower $DIR([GETHINT $x $y $z])]"
}
Init
DoDisplay
NewMaze