if 0 { [Richard Suchenwirth] 2002-10-03 - Tcl's possibilities may not be infinite, but are certainly very many. Reading an old BASIC book, I came across an example of a reaction tester that I thought might be nice to redo in Tcl/Tk. The idea is that the computer "challenges" you after a random time interval (< 1 sec), you "respond" by hitting a key or the left mouse button. The time between challenge and response is measured in milliseconds, and on average gives your reaction time. [http://mini.net/files/reactest.gif] The UI I came up with has a canvas, whose background colour is grey by default, green when the challenge comes, and red when the reaction was mistaken (too early, or wrong key). You can select a challenge mode, and then click the Start button. } proc ui {} { canvas .c -width 120 -height 100 -bg grey -borderwidth 2 -relief sunken bind .c <1> {response \t} set ::g(item) [.c create text 60 50 -font {Courier 64 bold}] radio .r ::g(mode) {mouse space 0-9 0-9a-z} button .start -text Start -command challenge button .clear -text C -command reset label .l -textvar g(result) -width 32 grid .c .r - -sticky news grid ^ .start .clear -sticky news grid .l - - -sticky news bind . {response %A} reset } proc radio {w varName values} { frame $w set i 0 foreach val $values { radiobutton $w.[incr i] -text $val -variable $varName -value $val } set $varName [lindex $values 0] eval pack [winfo children $w] -side top -anchor w -pady 0 } proc challenge {} { global g .start config -text Stop -command stop set g(expected) [switch -- $g(mode) { 0-9 {lpick {0 1 2 3 4 5 6 7 8 9}} 0-9a-z {lpick {0 2 3 4 5 6 7 8 9 a b c d e f g h i j k m n o p q r s t u v w x y z}} space {subst " "} mouse {subst \t} }] incr g(nTries) after [expr {round(500 + rand() * 1000)}] { .c config -bg green .c itemconfig $g(item) -text $g(expected) set g(t0) [clock clicks -millisec] } } proc stop {} { foreach event [after info] {after cancel $event} .start config -text Start -command challenge .c config -bg grey .c itemconfig $::g(item) -text "" } proc response char { global g set dt [expr {[clock clicks -millisec] - $g(t0)}] set g(tLast) $dt if {$char == $g(expected)} { incr g(tSum) $dt if {$dt > $g(tMax)} {set g(tMax) $dt} if {$dt < $g(tMin)} {set g(tMin) $dt} .c config -bg grey .c itemconfig $g(item) -text "" } else { .c config -bg red incr g(nErrors) } set g(expected) "" display after 100 challenge } proc reset {} { array set ::g {nTries 0 nErrors 0 tMin 99999 tMax 0 tSum 0 tLast -} .c itemconfig $::g(item) -text "" display } proc display {} { global g set errorRate [expr {$g(nTries)? $g(nErrors)*100./$g(nTries) : 0}] set g(result) "$g(nTries) tries, $g(nErrors) errors" append g(result) " ([format %.1f $errorRate] %) - last: $g(tLast) ms" set valid [expr {$g(nTries) - $g(nErrors)}] set average [expr {$valid? $g(tSum)/$valid : 0}] append g(result) "\nmin: $g(tMin) max:$g(tMax) avg: $average ms" } proc lpick list {lindex $list [expr {int([llength $list]*rand())}]} #------------------------------------------------------------------ ui bind . {exec wish $argv0 &; exit} bind . {console show} ---- [SS] 7Sep2004: Very interesting! but I think it should count it as an error when the user presses the mouse button before the box become green, otherwise to cheat is too easy.