A little reaction tester
Revision 3 of A little reaction tester
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.
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 . <Key> {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 . <Escape> {exec wish $argv0 &; exit}
bind . <F1> {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.
RLH For whatever reason, the whole page was clipped. I copied from an older version to get the page back.