Scissors, stone, paper
Richard Suchenwirth 2003-08-30 - Arjen Markus uses the game of "Scissors, stone, paper" as example in his Tcl introduction for young programmers [L1 ]. The original game is played by two humans, doing synchronously one of three hand gestures: fingers split (=scissors), level hand (=paper), fist (=stone). See rules below for how to score. This prompted me to do this alternative implementation with a GUI, which gives simple examples of grid layout and textvariables.
The user plays by clicking on one of the three buttons. The computer's move is randomly drawn from the three possibilities and briefly displayed in the label to the right of the buttons (which at other times shows a question mark). In fact, it is a camouflaged button: click it for the rules message.
The scores of player and computer are displayed on top of this. Every move is followed by a brief color highlighting of scores: both yellow for a tie, or green for the one who won.
set about "Scissors, stone, paper
Richard Suchenwirth 2003
Powered by Tcl/Tk!
Scissors cut paper.
Stone grinds scissors.
Paper wraps stone."
proc ui {} {
global computer 1 2
foreach i {1 2} {
label .$i -textvariable $i -font {Helvetica 32} -width 3
set $i 0
}
foreach i {scissors stone paper} {
button .$i -text $i -command [list click $i]
}
button .computer -textvariable computer -relief ridge \
-command {tk_messageBox -message $about}
set computer ?
#------------------- Laying out the UI:
grid .1 .2 -sticky news
grid .scissors .computer -sticky news
grid .stone ^ -sticky news
grid .paper ^ -sticky news
}
if 0 {The following proc is executed when the user clicks a button.
It draws the computer's move at random, determines from the
''match'' table who won (or if it was a tie), updates the scores, and
does the flashing effects.
}
proc click what {
global computer 1 2
if {$computer != "?"} return ;# ignore extra clicks
set computer [lpick {scissors stone paper}]
array set match {
scissors,scissors 0 scissors,stone 2 scissors,paper 1
stone,scissors 1 stone,stone 0 stone,paper 2
paper,scissors 2 paper,stone 1 paper,paper 0
}
switch $match($what,$computer) {
0 {flash .1 yellow; flash .2 yellow}
1 {incr 1; flash .1 green}
2 {incr 2; flash .2 green}
}
after 1000 {set computer ?}
}
#--------- Utility routines:
proc flash {w color} {
set bg [$w cget -bg]
$w config -bg $color
after 1000 [list $w config -bg $bg]
}
proc lpick L {lindex $L [expr {int(rand()*[llength $L])}]}
#---------- Now let the game begin...
ui
bind . <Escape> {exec wish $argv0 &; exit} ;# debugging helper