Version 4 of A little reaction tester

Updated 2005-12-10 14:16:22

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.

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