Hanoi Towers

Introduction
Program
...
Introduction

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 2013aug01
This nice animated game deserves an image.
This is an image captured after the game had gone to its completion, in automatic mode. (The rings started on the left.)
Program

 #! /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
...

See also:
Towers of Hanoi at RosettaCode