[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
 
-----
[Category Games]