Sarnold A classical recursivity example as a small game.
The goal is to move entierly a tower from one pit to another. The tower is formed by 3 to 5 discs, which reside on a pit. There are three pits, and you can move only one disc at a time, but not over a smaller disc.
#! /usr/bin/wish
# Nous fonctionnons en mode graphique
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 {} {
foreach i {1 2 3} {
DrawStack $i
}
}
proc DrawStack {stackIndex} {
# 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)
.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 {} {
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.go -text "Go!" -command {Begin}
pack .command.go -side right
}
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 {} {
discInit
drawStacks
if {$::computer} {
stackMove $::nbDiscs 1 2 3
}
# Destroy .command
# Destroy .stacks
# init
}
proc Destroy {args} {
if {[llength $args]==0} {
return
}
foreach i $args {
set children [winfo children $i]
if {[llength $children]==0} {
destroy $i
} else {
Destroy $children
destroy $i
}
}
}
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"
}
lappend ::discs($to) $discWidth
set ::discs($from) [lrange $::discs($from) 0 end-1]
update
after 600
drawStacks
}
array set discs {}
init