[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

----
[GPS]: This is very impressive!  Thanks for sharing it.

----
[Category Games]