if 0 {[Richard Suchenwirth] 2003-08-30 - [Arjen Markus] uses the game of "Scissors, stone, paper" as example in his Tcl introduction for young programmers. 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. [WikiDbImage ssp.jpg] 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 . {exec wish $argv0 &; exit} ;# debugging helper ---- [Arts and crafts of Tcl-Tk programming] [Category Toy]