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.
