Introduction edit
Sarnold A classical recursivity example as a small game.The goal is to move entierly a tower from one pit to another. <<br> The tower is formed by 3 or more discs, which reside on a pit (resp. stacked on a pole over that pit).There are three pits, and you can move only one disc at a time, but not over a smaller disc.
uniquename 2013aug01This nice animated game deserves an image.
Program edit
#! /usr/bin/wish
# We work in GUI mode
package require Tk
proc stackMove {numberOfDiscs from to temporary} {
if {$numberOfDiscs==1} {
oneMove $from $to
return
}
stackMove [expr {$numberOfDiscs-1}] $from $temporary $to
oneMove $from $to
stackMove [expr {$numberOfDiscs-1}] $temporary $to $from
}
proc drawStacks {{flashed 0}} {
foreach i {1 2 3} {
if {$i==$flashed} {
DrawStack $i 1
} else {
DrawStack $i
}
}
update
after 350
}
proc DrawStack {stackIndex {flashed 0}} {
# remove all existing discs
.stacks.tower$stackIndex delete all
.stacks.tower$stackIndex create rectangle 120 30 130 400 -tags tower -fill #777
.stacks.tower$stackIndex create rectangle 0 380 250 400 -tags base -fill #777
set Discs $::discs($stackIndex)
if {[llength $Discs]==1} {
return
}
set Discs [lrange $Discs 1 end]
set discIndex 0
foreach n $Discs {
# n is the size of the disc
# discIndex is the position (the highest to the top)
if {$flashed && $n==[lindex $Discs end]} {
.stacks.tower$stackIndex create rectangle [expr {125-$n*110/$::nbDiscs}] \
[expr {-$discIndex*25+375}] [expr {125+$n*110/$::nbDiscs}] \
[expr {-$discIndex*25+365}] -fill #F55
} else {
.stacks.tower$stackIndex create rectangle [expr {125-$n*110/$::nbDiscs}] \
[expr {-$discIndex*25+375}] [expr {125+$n*110/$::nbDiscs}] \
[expr {-$discIndex*25+365}] -fill #55C
}
incr discIndex
}
}
proc init {} {
wm title . "Hanoi Towers"
frame .stacks -width 750 -height 500
pack .stacks -side top
foreach i {1 2 3} {
set tower .stacks.tower
canvas $tower$i -width 250 -height 400
pack $tower$i -in .stacks -side left
$tower$i create rectangle 120 30 130 400 -tags tower -fill #777
$tower$i create rectangle 0 380 250 400 -tags base -fill #777
}
frame .command -width 750 -height 60
pack .command -side bottom
set ::nbDiscs 3
label .command.labelNbDiscs -text "Nb Discs :"
pack .command.labelNbDiscs -side left
spinbox .command.nbDiscs -textvariable ::nbDiscs\
-values {3 4 5} -state normal
pack .command.nbDiscs -side left
checkbutton .command.computer -variable ::computer
pack .command.computer -side left
label .command.automatic -text "automatic"
pack .command.automatic -side left
button .command.exit -text Exit -command {update;exit}
pack .command.exit -side right -padx 20
button .command.go -text "Go!" -command {Begin}
pack .command.go -side right -padx 20
}
proc discInit {} {
set n $::nbDiscs
incr n
foreach stack {1 2 3} {
set ::discs($stack) [list $n]
}
incr n -1
for {set width $n} {$width>0} {incr width -1} {
lappend ::discs(1) $width
}
drawStacks
}
proc Begin {} {
# beginning of the game : no move yet
set ::moveNumber 0
# disable interrupt game
.command.go configure -state disabled
discInit
drawStacks
if {$::computer} {
stackMove $::nbDiscs 1 2 3
.command.go configure -state normal
tk_messageBox -message "End of automatic game !"
} else {
ReadyToMove
}
# Destroy .command
# Destroy .stacks
# init
}
################################################################################
# returns 1 if the player have won the game, 0 if the game is still unfinished
################################################################################
proc HaveWonGame {} {
if {[llength $::discs(1)]==1} {
if {[llength $::discs(2)]==1 ||
[llength $::discs(3)]==1} {
return 1
}
}
return 0
}
################################################################################
# set the stacks to be ready for interactive playing
################################################################################
proc ReadyToMove {} {
if {[HaveWonGame]} {
tk_messageBox -message "Game won in $::moveNumber moves !\nCongratulations !"
.command.go configure -state normal
foreach i {1 2 3} {
.stacks.tower$i configure -background #fff
}
return
}
foreach i {1 2 3} {
if {[llength $::discs($i)]!=1} {
.stacks.tower$i bind all <ButtonPress-1> {SelectSource [string index %W end]}
} else {
.stacks.tower$i bind all <ButtonPress-1> {}
}
.stacks.tower$i configure -background #fff
}
}
################################################################################
# select the tower as source
# towerIndex : integer 1..3
################################################################################
proc SelectSource {towerIndex} {
set ::source $towerIndex
.stacks.tower$towerIndex bind all <ButtonPress-1> {ReadyToMove}
.stacks.tower$towerIndex configure -background #df7
foreach i {1 2 3} {
if {$i!=$towerIndex && [lindex $::discs($i) end]>[lindex $::discs($towerIndex) end]} {
.stacks.tower$i bind all <ButtonPress-1> {oneMoveInteractive %W; ReadyToMove}
}
}
update
}
################################################################################
# perform one move with interactive game
################################################################################
proc oneMoveInteractive {widget} {
set to [string index $widget end]
set from $::source
oneMove $from $to
}
################################################################################
# perform one move graphically and internally
################################################################################
proc oneMove {from to} {
if {[llength $::discs($from)]==1} {
error "stack no. $from is void"
}
set discWidth [lindex $::discs($from) end]
if {$discWidth>[lindex $::discs($to) end]} {
error "disc width overflow in destination"
}
# flash the top of the source stack
drawStacks $from
# perform the move in the global array
lappend ::discs($to) $discWidth
set ::discs($from) [lrange $::discs($from) 0 end-1]
incr ::moveNumber
# flash the top of the destination stack
drawStacks $to
drawStacks
}
array set discs {}
init... edit
See also:- Towers of Hanoi at RosettaCode
