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.

WikiDbImage 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 . <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.