UtiliTest Code

#!/bin/sh
#---------------------------------------
# Notice:
#
# UtiliTest is an open source user feedback program 
# which is designed to perform various queries 
# on the screen, especially for test of usability. 
# Moreover, this small software provides formatted 
# collect data as output which makes the future quantitative 
# analysis easy. Its user interface is friendly.
#
# This software is free of charge for any purpose.
# This software can be copied, and distributed, with or without
# modifications; but this notice must be included on any copy.
#
# We do not warrant that the software is error free or fit 
# for any purpose.
#
#
# Homepage: http://utilitest.sourceforge.net
# User forum: https://sourceforge.net/forum/forum.php?forum_id=724072
#
# Authors: 
#    Teng Wen Xuan (rick.teng@free.fr)
#    Tan Ning (tanning412@gamil.com)
#
#---------------------------------------
#\
exec tclsh $0 $*

################################################################
# What it does:
# 
#  - to perform a usability test (mainly for testing website usability)
#  - to configure your test tasks
#  - to collect user data
#
# Yet lacking: 
#
#  - GUI for task design 
#
# Revisions:
# May 1st, 2006 - initial revision
# Aug. 1st, 2007 - 1st beta version
# 
################################################################

package require Tk

if {[info exists ::starkit::topdir]} {
    package require -exact Itcl 3.2
    package require -exact Itk 3.2
} else {
    package require Itcl 3.2
    package require Itk 3.2
}

package require Tclx
package require Iwidgets 4.0

#-------------------------------------------------------------------
#Define constants
#-------------------------------------------------------------------
set APPNAME "Usability tester"

if [info exist env(HOME)] {
    set ::ini_file [file join $env(HOME) "utilitest.ini"]
} else {
    set ::ini_file [file join [pwd] "utilitest.ini"]
}

set ::pwdstr [pwd]

if {[catch {set ::tmpdir $::env(TMP)}]} { set ::tmpdir $::pwdstr }

if {$::tcl_platform(platform)=={windows}} {
    set ::Prefs(browser) {C:/Program Files/Internet Explorer/IEXPLORE.EXE}
    set ::Prefs(python_exe) [lindex [auto_execok python.exe] 0]
    if {$::Prefs(python_exe)==""} {
        set ::Prefs(python_exe) {c:/Python24/python.exe}
    }
    
} else {
    foreach browser {htmlview firefox iexplorer mozilla konqueror netscape} {
        set ::Prefs(browser) [lindex [auto_execok $browser] 0]
        if {[string length $binary]} { break }
    }
}
set ::vncpwdfile [file join [file dir [info script]] vncpwdfile]
set ::vnc_available 0
set ::today [clock format [clock seconds] -format %d-%h-%Y]

set ::colorbar_data { {#ff0300 #ff0e00 #ff0e00 #ff1200 #ff1200 #fd1400 #fe1900 #fe1a00 #fe1900 #fe1c00 #fe1e00 #fe1e00 #fe1d00 #fe1e00 #fe2200 #fe2200 #fc2500 #fd2400 #fd2608 #fd250d #fd280e #fd270e #fb2a0e #fc2b0e #fc2b0e #fc2f0e #fc2e0e #fc300e #fa310e #fb300e #fb320e #fb330e #fb320e #fb350e #f9360e #fa360e #fa390e #fa390e #fa380e #fa390d #f93c0e #f93d13 #f93c13 #f83f13 #f93e13 #f94013 #f94213 #f94013 #f74413 #f84313 #f84513 #f84513 #f64813 #f74713 #f74913 #f74a12 #f54b14 #f64a15 #f44d16 #f54c16 #f54e16 #f34f16 #f44e16 #f45116 #f45216 #f25316 #f35416 #f35515 #f15619 #f25518 #f0581a #f1571a #ef591a #f05a1a #f0591a #ee5c1a #ef5b1a #ee5c19 #ee5f1c #ee5e1c #ee601c #ee611c #ec621c #ed631c #ed621c #eb651c #ec661c #ea671b #eb681d #eb671e #e86a1e #e9691e #e76b1e #e86c1e #e86b1e #e66e1e #e76d1e #e76f1d #e66f1f #e4721f #e5711f #e2741f #e3731e #e17520 #e27522 #e17822 #e17722 #e17922 #df7a22 #e07920 #de7c23 #df7b23 #de7d22 #dd7e24 #db7f24 #dc8024 #dc7f23 #d98225 #da8125 #d98325 #d78425 #d88325 #d68625 #d78524 #d68726 #d48726 #d58726 #d38926 #d38a26 #d28b25 #d08c27 #d18c28 #d18b28 #ce8e28 #cd8f28 #ce8e27 #cc9129 #cd9029 #cc9229 #cb9329 #ca9429 #c89529 #c99428 #c6962a #c7952a #c6972a #c5982a #c5972a #c39a2a #c39929 #c29b2b #c19c2b #bf9d2b #c09c2a #bd9e2c #bc9f2e #bd9e2e #baa12e #bba02e #baa12e #b8a22e #b9a12c #b8a32f #b5a42f #b5a32f #b5a52f #b3a62f #b4a52e #b1a730 #b2a630 #afa930 #afa830 #aeaa2f #abab31 #acaa31 #abac31 #a9ad31 #aaad31 #a8ac30 #a5af32 #a6af32 #a5ae32 #a3b032 #a4af32 #a1b132 #a2b032 #a0b231 #a0b333 #9eb433 #9fb433 #9cb433 #9cb333 #9bb532 #9ab534 #98b634 #99b534 #95b734 #94b834 #95b734 #94b934 #93b934 #90b934 #90b834 #8eba34 #8fb934 #8cbb34 #8dba34 #8abc34 #8abb33 #88bd35 #89bc35 #87be35 #87be35 #85be35 #86bd35 #83bf35 #84be35 #81c035 #81bf34 #7fc136 #80c036 #7dc236 #7ec236 #7bc136 #7bc336 #7ac235 #77c437 #78c437 #77c437 #76c337 #75c537 #74c537 #71c537 #72c537 #71c437 #6fc537 #70c536 #6dc638 #6ec638 #6dc538 #6ac738 #69c738 #6ac738 #67c738 #68c738 #67c638 #66c838 #63c838 #64c838 #63c738 #62c937 #61c939 #5fc939 #60c839 #5dca39 #5dca39 #5bca39 #5cc939 #59cb39 #5acb39 #59cb39 #57cb39 #58ca39 #55cc39 #56cc39 #55cc39 #54cc39 #53cc39 #51cc39 #52cb39 #4fcd39 #50cd39 #4fcd39 #4dcd39 #4ecd39 #4ecc39 #4bce39 #4cce39 #4bce39 #49ce39 #4ace39 #47ce39 #48ce39 #47ce39 #45ce39 #46ce39 #45cd39 #43cf39 #44cf39 #40cf39 #42cf39 #42cf39 #40cf39 #3ecf39 #3fce38 #3cd03a #3dd03a #3dd03a #3ad03a #39d03a #3ad03a} {#ff0300 #ff0e00 #ff0e00 #ff1200 #ff1200 #fd1400 #fe1900 #fe1a00 #fe1900 #fe1c00 #fe1e00 #fe1e00 #fe1d00 #fe1e00 #fe2200 #fe2200 #fc2500 #fd2400 #fd2608 #fd250d #fd280e #fd270e #fb2a0e #fc2b0e #fc2b0e #fc2f0e #fc2e0e #fc300e #fa310e #fb300e #fb320e #fb330e #fb320e #fb350e #f9360e #fa360e #fa390e #fa390e #fa380e #fa390d #f93c0e #f93d13 #f93c13 #f83f13 #f93e13 #f94013 #f94213 #f94013 #f74413 #f84313 #f84513 #f84513 #f64813 #f74713 #f74913 #f74a12 #f54b14 #f64a15 #f44d16 #f54c16 #f54e16 #f34f16 #f44e16 #f45116 #f45216 #f25316 #f35416 #f35515 #f15619 #f25518 #f0581a #f1571a #ef591a #f05a1a #f0591a #ee5c1a #ef5b1a #ee5c19 #ee5f1c #ee5e1c #ee601c #ee611c #ec621c #ed631c #ed621c #eb651c #ec661c #ea671b #eb681d #eb671e #e86a1e #e9691e #e76b1e #e86c1e #e86b1e #e66e1e #e76d1e #e76f1d #e66f1f #e4721f #e5711f #e2741f #e3731e #e17520 #e27522 #e17822 #e17722 #e17922 #df7a22 #e07920 #de7c23 #df7b23 #de7d22 #dd7e24 #db7f24 #dc8024 #dc7f23 #d98225 #da8125 #d98325 #d78425 #d88325 #d68625 #d78524 #d68726 #d48726 #d58726 #d38926 #d38a26 #d28b25 #d08c27 #d18c28 #d18b28 #ce8e28 #cd8f28 #ce8e27 #cc9129 #cd9029 #cc9229 #cb9329 #ca9429 #c89529 #c99428 #c6962a #c7952a #c6972a #c5982a #c5972a #c39a2a #c39929 #c29b2b #c19c2b #bf9d2b #c09c2a #bd9e2c #bc9f2e #bd9e2e #baa12e #bba02e #baa12e #b8a22e #b9a12c #b8a32f #b5a42f #b5a32f #b5a52f #b3a62f #b4a52e #b1a730 #b2a630 #afa930 #afa830 #aeaa2f #abab31 #acaa31 #abac31 #a9ad31 #aaad31 #a8ac30 #a5af32 #a6af32 #a5ae32 #a3b032 #a4af32 #a1b132 #a2b032 #a0b231 #a0b333 #9eb433 #9fb433 #9cb433 #9cb333 #9bb532 #9ab534 #98b634 #99b534 #95b734 #94b834 #95b734 #94b934 #93b934 #90b934 #90b834 #8eba34 #8fb934 #8cbb34 #8dba34 #8abc34 #8abb33 #88bd35 #89bc35 #87be35 #87be35 #85be35 #86bd35 #83bf35 #84be35 #81c035 #81bf34 #7fc136 #80c036 #7dc236 #7ec236 #7bc136 #7bc336 #7ac235 #77c437 #78c437 #77c437 #76c337 #75c537 #74c537 #71c537 #72c537 #71c437 #6fc537 #70c536 #6dc638 #6ec638 #6dc538 #6ac738 #69c738 #6ac738 #67c738 #68c738 #67c638 #66c838 #63c838 #64c838 #63c738 #62c937 #61c939 #5fc939 #60c839 #5dca39 #5dca39 #5bca39 #5cc939 #59cb39 #5acb39 #59cb39 #57cb39 #58ca39 #55cc39 #56cc39 #55cc39 #54cc39 #53cc39 #51cc39 #52cb39 #4fcd39 #50cd39 #4fcd39 #4dcd39 #4ecd39 #4ecc39 #4bce39 #4cce39 #4bce39 #49ce39 #4ace39 #47ce39 #48ce39 #47ce39 #45ce39 #46ce39 #45cd39 #43cf39 #44cf39 #40cf39 #42cf39 #42cf39 #40cf39 #3ecf39 #3fce38 #3cd03a #3dd03a #3dd03a #3ad03a #39d03a #3ad03a} }

#-------------------------------------------------------------------
#Set default preferences
#-------------------------------------------------------------------
catch {unset -nocomplain ::Prefs(recents_list)}
set ::Prefs(task_script)  task.txt
set ::Prefs(max_recents) 5

#-------------------------------------------------------------------
#variables
#-------------------------------------------------------------------
set myFont(question)   {-family Garamond -size 20 -weight bold}
set myFont(choice)   {-family Garamond -size 16}
set myFont(scale_label)   {-family Garamond -size 16 -weight bold}
set myFont(sbold)   {-family Helvetica -size 8 -weight bold}
set myFont(bold)   {-family Helvetica -size 10 -weight bold}
set myFont(comment)   {-family Helvetica -size 12}
set myFont(sitalic) {-family Helvetica -size 8 -slant italic}
set myFont(italic) {-family Helvetica -size 10 -slant italic}

set ::collecting_data_dir [file join $::pwdstr collect $::today]
set ::current(page_num) 1
set ::current(Q_num) 0
set ::current(recorder_pid) ""
set ::current(swf_files) ""

#-------------------------------------------------------------------
#Main window
#-------------------------------------------------------------------
wm title . $APPNAME-$collecting_data_dir
wm positionfrom  . program
wm geometry . 800x600
wm protocol . WM_DELETE_WINDOW onDestroy

menu .mainmenu -tearoff 0
menu .mainmenu.m -tearoff 0
menu .mainmenu.m1 -tearoff 0
.mainmenu add cascade -label "File" -menu .mainmenu.m -underline 0
.mainmenu add cascade -label "Configure" -menu .mainmenu.m1 -underline 0
.mainmenu add command -label "About..." -underline 0 -command {::aboutBox::show}

.mainmenu.m add command -label "Open ..." -command { ""}
.mainmenu.m add separator
.mainmenu.m add command -label "Quit" -command onDestroy
.mainmenu.m add separator

set countMenuItem [expr [.mainmenu.m index end] + 1]

.mainmenu.m1 add command -label "Select Audio Devices..." -command {::audioDevicesDialog::show}
.mainmenu.m1 add command -label "Load & Apply User Configuration..." -command {
    set file [tk_getOpenFile -parent .  -title "Load configuration file" -filetypes {{"Ini files" .ini} {"All files" *}} ]
    if [string compare $file ""] {
        ::preferences::load_and_apply $file
    }
}

.mainmenu.m1 add command -label "Save User Configuration..." -command {
    set file [tk_getSaveFile -filetypes {{"Ini files" .ini} {"All files" *}} ]
    if [string compare $file ""] {
        if [string compare [file extension $file] ".ini"] {
            append file ".ini"
        }
        ::preferences::store_preferences $file
    }
}

. configure -menu .mainmenu

pack [iwidgets::panedwindow .pw  -orient vertical -sashcursor sb_h_double_arrow -thickness 4 -showhandle 0] -side top \
        -expand yes -fill both -pady 2 -padx 2
.pw add "info" -margin 2 -minimum 30
set ::main(leftPane) [.pw childsite "info"]
.pw add "working" -margin 2 -minimum 30
set ::main(rightPane) [.pw childsite "working"]

.pw fraction 65 35

# ----------------------------------------------------------------------
# test task definition script
# ----------------------------------------------------------------------
proc clear_test {} {
    unset -nocomplain ::all_question_ids
    array unset ::types
    array unset ::choices
    array unset ::titles
}

proc load_test {filename} {
 if {[file readable $filename]} {
 
 clear_test
 
 set f [open $filename r]
 fconfigure $f -encoding utf-8
 while {![eof $f]} {
   set line [string trim [gets $f]]
   # read question
   if [regexp -- {^(Q|M|T)([0-9]+)(\(?.*\)?)\:(.+)$} $line a t_prefix t_id t_multi t_title] {
       # a question or a message
       
       set t_id $t_prefix$t_id
       lappend ::all_question_ids $t_id
       set ::titles($t_id) $t_title
       
       set ::types($t_id,has_scale) 0
       
        if {$t_prefix=={M}} {
            set ::types($t_id) message
            set ::choices($t_id) ""
            #if current line defines a message
            while {![eof $f]} {
                set line [string trim [gets $f]]
                if {$line==""} {break}
                append ::titles($t_id) "\n$line"
            }
        } elseif {$t_prefix=={T}} {
            # T 
            unset -nocomplain v_actions
            while {![eof $f]} {
               set line [string trim [gets $f]]
               if {$line==""} {break}
               if [regexp -- {^(.+)\((.*)\)$} $line a action args]  {
                    lappend v_actions [list $action $args]
                }
            }
            set ::types($t_id) action
            if [info exists v_actions] {
                set ::choices($t_id) $v_actions
            } else {
                set ::choices($t_id) ""
            }

        } else {
           # Q 
           # qcm or not
           if [regexp -nocase -- {[ \(]*multi[ \(]*} $t_multi] {
               set ::types($t_id) multi
           } else {
               set ::types($t_id) single
           }

           foreach v { from to label} {
               set $v ""
           }

           unset -nocomplain v_choices
           while {![eof $f]} {
               set line [string trim [gets $f]]
               if {$line==""} {break}
               # read choices
               if [regexp -nocase -- {^from:(.+)$} $line a v_from] {
                   lappend from $v_from
               } elseif [regexp -nocase -- {^to:(.+)$} $line a v_to] {
                   lappend to $v_to
               } elseif [regexp -nocase -- {^label:(.+)$} $line a v_label] {
                   lappend label $v_label
               } elseif [regexp -nocase -- {^comments:(.*)$} $line a prompt] {
                   lappend v_choices [list $prompt comments]
               } elseif [regexp -nocase -- {^others:(.*)$} $line a prompt] {
                   lappend v_choices [list $prompt others]
               } else {
                   lappend v_choices [list $line ""]
               }
           }
           # scale type       
           if {$from!="" && $to!="" } {           
               if {[llength $from] != [llength $to]} {
                    print_error "\[E\] number mismatch between 'from' and 'to' for line: $line"
               } else {
                set ::types($t_id,has_scale) 1
                set ::choices($t_id,label) $label
                set ::choices($t_id,from) $from
                set ::choices($t_id,to) $to           
               }
           }
           if [info exists v_choices] {
               set ::choices($t_id) $v_choices
           } else {
               set ::choices($t_id) ""
           }
       }
   }
 }
     close $f
     set ::current(Q_num) [llength $::all_question_ids]
     print_info "$filename loaded"
     print_info "  $::current(Q_num) items"
     
     } else {
         print_error "\[E\] Error while reading task $filename "
     }
}           


# ----------------------------------------------------------------------
# run a task
# ----------------------------------------------------------------------
proc run_task {subject_id} {
    set ::current(page_num) 1
    set ::current(log) [file join $::collecting_data_dir log_$subject_id]
    if [info exists ::current(log_fh)] {
        catch {close $::current(log_fh)}
    }
    if [catch {set ::current(log_fh) [open $::current(log) w]} msg] {
        tk_messageBox -message "Error while open log file: $msg" -icon error
        return
    }
    
    puts $::current(log_fh) "--- Log file for $subject_id [timeStamp] --- "
    
    ::testField::show
    foreach q $::all_question_ids {
        set ::current(id) $q
        set ::page_done 0
        
        ::testField::show_page_head $::titles($q)
        
        if {$::types($q,has_scale)} {
            ::testField::show_scale_choices $::choices($q,label) $::choices($q,from) $::choices($q,to)
        }
                
        switch -- $::types($q) {
           message {}
           single {
                ::testField::show_single_choices $::choices($q)
           }
           multi {
                ::testField::show_multi_choices $::choices($q)
           }
           action {
                ::testField::show_actions  $::choices($q)
            }
        }     
        vwait ::page_done
    }
    ::testField::close
    if [info exists ::current(log_fh)] {
        catch {close $::current(log_fh)}
    }
    print_info "$::current(subject_id) has completed the test, log in $::current(log)"
}

proc get_choice_txt {q_id c_id} {
    if [catch { set item [lindex $::choices($q_id) [expr $c_id -1]] } msg] {return ""}
    if {[lindex $item 1]=="others" || [lindex $item 1]=="comments"} {
        return "[lindex $item 1]:[::testField::get_entry $c_id]"
    } else {
        return [lindex $item 0]
    }
}

proc collect_data {} {
    if {$::types($::current(id))=={message} || $::types($::current(id))=={action} } { return 1}
    if {$::types($::current(id))=={multi}} {
        set ::current(answer) ""
    }
    if {![info exists ::current(log_fh)]} {    return    1} ; #return 1 to go to next 
    puts $::current(log_fh) "\n$::current(id): $::titles($::current(id))"
    puts $::current(log_fh) "[timeStamp]"
    
    if {$::types($::current(id),has_scale)} {
        for {set i 0} {$i < [llength $::choices($::current(id),from)]} {incr i} {
            set from [lindex $::choices($::current(id),from) $i]
            set to [lindex $::choices($::current(id),to) $i]
            set label [lindex $::choices($::current(id),label) $i]
            puts $::current(log_fh) "\t${label}: $::current(answer,$i)% ($from -> $to)"            
        }
    }
    # get numti-choices and comment(s)!  note: comments could be in single, to be changed !
    set num_choices [llength $::choices($::current(id))]
    for {set i 1} {$i<=$num_choices} {incr i} {
        if {[info exists ::current(answer,$i)] } {
           if {$::current(answer,$i)} {  append ::current(answer) "$i " }
           unset ::current(answer,$i)           
        }
    }    

    if {!$::types($::current(id),has_scale) && 
        (![info exists ::current(answer)] || [string trim $::current(answer)]=="")} {
        ::testField::disable
        set ans [tk_messageBox -title "Warning" -type yesno  -message "You didn't answer questions, still continue?" -icon warning]
        if {$ans=={no}} {
        ::testField::active
            return 0 
        } else {
            ::testField::active
            return 1
        }
    }

    foreach a [split $::current(answer)] {
        set a [string trim $a]
        if {$a==""} {continue}
        puts $::current(log_fh) "\t$a. [get_choice_txt $::current(id) $a]"
    }
    return 1
}

proc open_action {args} {
    puts $::current(log_fh) "$::current(id) starting (action: $args)\n[timeStamp]"
    if [regexp -nocase -- {^[ ]*url:(.+)$} $args a url] {
        puts "$::Prefs(browser) $url"
        catch {exec $::Prefs(browser) $url }
    } elseif [regexp -nocase -- {^[ ]*bin:(.+)$} $args a bins] {
         set bins [file normalize $bins]
         eval exec $bins & 
    }
    puts $::current(log_fh) "$::current(id) stop\n[timeStamp]"
}


# recording procs (VNC)        
proc test_VNC {} {
# test port 5900
    if [catch {set s [socket localhost 5900]} msg] {
        print_warning "Test VNC failed, screen capture function disabled"
        set ::vnc_available 0
    } else {
        close $s
        print_info "Test VNC passed"
        set ::vnc_available 1
    }
}

proc start_recording {output} {
    set output "$output.tmp.swf"
    if [catch {set ::current(recorder_pid) [exec $::Prefs(python_exe) vnc2swf.py -n \
        -o $output -t shape -P $::vncpwdfile &]} msg] {
        print_error "Error while lunching recorder: $msg"
        
    }
    puts $::current(log_fh) "[timeStamp] start recording to $output"
}

proc stop_recording {output} {
    if {$::current(recorder_pid)!=""} {
        puts -nonewline $::current(log_fh) "[timeStamp] stop recording ..."
        if [catch {kill $::current(recorder_pid)} msg] {
            puts $::current(log_fh) "Error(pid:$::current(recorder_pid)): $msg"
        } else {
            puts $::current(log_fh) OK
            set ::current(recorder_pid) ""
            lappend ::current(swf_files) $output
        }
        
    }
}

proc finalize_all_captures {} {
        # have to do that for correcting end of file
        print_info "finalize captured files ..."
        foreach output $::current(swf_files) {
            print_info "-> $output.swf"
            catch {exec $::Prefs(python_exe) edit.py -o $output.swf -t shape $output.tmp.swf}
            catch {file delete -force $output.tmp.swf}
        }
}

# ----------------------------------------------------------------------
# print a message input the left window
# ----------------------------------------------------------------------
proc print_info {text} {
    $::main(msg) issue $text INFO 
    update
}

proc print_warning {text} {
    $::main(msg) issue "WARNING: $text" WARNING 
    update
}

proc print_error {text} {
    $::main(msg) issue "ERROR: $text" ERROR 
    update
}

# ----------------------------------------------------------------------
# Displays a status <message> 
# ----------------------------------------------------------------------
proc print_status {message} {
    $::main(status) configure -text $message
    update
}

# ----------------------------------------------------------------------
# define status bar
# ----------------------------------------------------------------------
frame .msgbar
pack .msgbar -side bottom -fill x
set ::main(status) [label .msgbar.lab -bd 1 -relief sunken -justify left]
pack .msgbar.lab -side left -expand yes -fill x

# ----------------------------------------------------------------------
# define left message window
# ----------------------------------------------------------------------
set ::main(msg) [iwidgets::messagebox $main(leftPane).mb -textbackground black \
        -hscrollmode dynamic -labelpos n ]
$::main(msg) type add ERROR -background black -foreground red -bell 1
$::main(msg) type add WARNING -background black -foreground yellow
$::main(msg) type add INFO -background black -foreground green

pack $::main(msg) -expand yes -fill both -pady 5
pack $main(leftPane) -side left -expand yes -fill both -padx 5

# ----------------------------------------------------------------------
# define right working field
# ----------------------------------------------------------------------
    
#task info
labelframe $::main(rightPane).task -text "Task definition" -font $myFont(italic) -padx 2 -pady 2
iwidgets::entryfield $::main(rightPane).task.filename -labeltext "Task definition:" -labelpos nw \
    -labelfont $::myFont(bold)  -textvariable ::Prefs(task_script) \
    -command {load_test $::Prefs(task_script)}
button $::main(rightPane).task.but -text "Browse ..." -command {
        browse_task
        load_test $::Prefs(task_script)  } -font $::myFont(sbold)

pack $::main(rightPane).task.filename $::main(rightPane).task.but -side top -padx 5 -pady 5 -fill both

# -----------------------------------------------------------------------------
#but
button $main(rightPane).run -text "Run ..." -command { \
    ::subjectNameDialog::show \
    } -font $::myFont(bold) -bg white


pack $::main(rightPane).task $main(rightPane).run -side top -fill both -pady 15 -expand yes
pack $::main(rightPane) -expand yes -fill both -padx 5 -pady 5

#---------------------------------------------------------
# procedures tk
#---------------------------------------------------------

proc read_array {arrayname filename} {
    upvar 1 $arrayname arr
    set file [open $filename r]
    array set arr [read $file]
    close $file
}

proc write_array {arrayname filename} {
    upvar 1 $arrayname arr
    set file [open $filename w]
    puts $file [array get arr]
    close $file
}

proc put_entry {entry text} {
    $entry delete 0 end
    $entry insert 0 $text
    $entry xview end
}

proc file_selection {parent entry types initialdir} {
    set file [tk_getOpenFile -filetypes $types -parent $parent -initialdir $initialdir]
    if {[string compare $file ""]} {put_entry $entry $file}
}

proc browse_task {} {
    file_selection . $::main(rightPane).task.filename {{"Txt files" .txt} {"All files" *}} ""
    appendRecentDir [$::main(rightPane).task.filename get]
}



#---------------------------------------------------------
# procédures opérationnelles
#---------------------------------------------------------
proc appendRecentDir {wavdir} {
    if {[info exists ::Prefs(recents_list)]} {
        if {[lindex $::Prefs(recents_list) end] == $wavdir} {
            return
        }
    }
    lappend ::Prefs(recents_list) $wavdir
    set curnum [llength $::Prefs(recents_list)]
    if {$curnum > $::Prefs(max_recents)} {
        set ::Prefs(recents_list) [lreplace $::Prefs(recents_list) 0 [expr {$curnum - $::Prefs(max_recents) -1}]]
    }
    fillRecentDir
}

proc fillRecentDir {} {
    global .mainmenu.m countMenuItem
    if [info exists ::Prefs(recents_list)] {
        set num [llength $::Prefs(recents_list)]
        set endid [.mainmenu.m index end]
        if {$endid >= $countMenuItem} {.mainmenu.m delete $countMenuItem end}
        
        foreach wavdir $::Prefs(recents_list) {
            .mainmenu.m insert $countMenuItem command -label "$wavdir" -command "browse_wav {$wavdir}"
        }
    }
}


proc onDestroy {} {
    if [catch {::preferences::store_preferences $::ini_file} msg] {
        tk_messageBox -message $msg -title "Write error" -parent . -icon error
    }
    finalize_all_captures
    exit
}

proc timeStamp {} {
    return [clock format [clock second] -format "%X %x"]
}


# ----------------------------------------------------------------------
# Preferences
# ----------------------------------------------------------------------
namespace eval ::preferences:: {}

proc ::preferences::store_preferences {inif} {
    if [info exists ::Prefs] {
        write_array ::Prefs $inif
    }
}

proc ::preferences::load_and_apply {inif} {
    if {[file exists $inif]} {
        read_array ::Prefs $inif
    }
}

# ----------------------------------------------------------------------
# input subject nickname Dialog
# ----------------------------------------------------------------------
namespace eval ::subjectNameDialog:: {
    toplevel .subjectName_dlg -relief raised -bd 1
    #wm title .subjectName_dlg ""
    wm overrideredirect .subjectName_dlg 1    
    wm geometry .subjectName_dlg +300+300
    update idletasks
    #wm resizable .subjectName_dlg 0 0
    catch {wm attributes .subjectName_dlg -topmost yes}
    
    wm protocol .subjectName_dlg WM_DELETE_WINDOW ::subjectNameDialog::hide
    wm withdraw .subjectName_dlg
    iwidgets::entryfield .subjectName_dlg.ent -labeltext "Subject ID:" -labelpos w \
        -labelfont $::myFont(bold)  -textvariable ::current(subject_id) \
        -command {::subjectNameDialog::ok}
    
    button .subjectName_dlg.ok -text Ok -command {::subjectNameDialog::ok} -font $::myFont(bold)
    button .subjectName_dlg.cancel -text Cancel -command {::subjectNameDialog::hide} -font $::myFont(bold)
    
    pack .subjectName_dlg.ent .subjectName_dlg.ok .subjectName_dlg.cancel -fill both -expand yes -side left

}

proc ::subjectNameDialog::ok {} {
    if [file exists [file join $::collecting_data_dir log_$::current(subject_id)]] {
        tk_messageBox -message "This ID has already been used, please use another one" -icon error
        return
     }
    ::subjectNameDialog::hide
    run_task $::current(subject_id)
}

proc ::subjectNameDialog::show {} {
    if {$::current(Q_num)<=0} { return }
    wm deiconify .subjectName_dlg
    grab .subjectName_dlg
    focus .subjectName_dlg.ent.lwchildsite.entry
}
        
proc ::subjectNameDialog::hide {} {
    grab release .subjectName_dlg
    wm withdraw .subjectName_dlg
}

# ----------------------------------------------------------------------
# test field
# ----------------------------------------------------------------------
namespace eval ::testField:: {

    proc show_page_head {prompt} {
        frame .testField.page
        pack [label .testField.page.q -text $prompt \
                -wraplength [expr [winfo screenwidth  .] - 200] \
                -font $::myFont(question)] -side top -anchor c -fill x
        pack .testField.page  -fill both -pady 50 -padx 20 -anchor c
    }
    
    proc hide_entry { } {
        if ![winfo exists .testField.page] {return}
        foreach p [pack slaves .testField.page] {
        foreach w [pack slaves $p] {
            if {[string equal -nocase [winfo class $w] Entry]} {
                #puts $w
                $w configure -state disabled
            }
        }
        }
    }
    
    proc get_entry { c_id } {
        set w ".testField.page.c$c_id\.ent"
        if ![winfo exists $w] {return ""}
        if {[string equal -nocase [winfo class $w] Entry]} {
            return [$w get]
        } elseif {[string equal -nocase [winfo class $w] text]} {
            return [$w get 0.0 end]
        }
    }
    
    proc show_single_choices {choices} {
        set ::current(answer) ""
        set i 1
        foreach ch $choices {
            set prompt [lindex $ch 0]
            set t [lindex $ch 1]
            set each_c [frame .testField.page.c$i]
            if {$t=={others}} {
                set others "$each_c.ent"
                entry $others -state disabled -width [winfo screenwidth . ]
            
                radiobutton $each_c.rb -text $prompt -variable ::current(answer) \
                    -relief flat -anchor w -value $i -font $::myFont(choice) \
                    -command "$others configure -state normal"
                 
                 pack $each_c.rb $others -side left -anchor w -expand yes -fill x
                    
            } elseif {$t=={comments}} {
                set ::current(answer,$i) 1; # comment field is always logged
                set others "$each_c.ent" 
                label $each_c.lab -wraplength [expr [winfo screenwidth . ]/3] \
                    -text $prompt -font $::myFont(choice) -anchor w 
                text $others -height 3 -font $::myFont(comment) 
                pack $each_c.lab $others -padx 1 -side left -expand yes -fill x            
            } else {
                radiobutton $each_c.rb -text $prompt -variable ::current(answer) \
                   -relief flat -anchor w -value $i -font $::myFont(choice) \
                   -command {::testField::hide_entry}
                pack $each_c.rb -side left -expand yes -fill x
            }
            pack $each_c -pady 5 -padx 10 -side top -fill x
            incr i
        }
        
    }
    
    proc show_multi_choices {choices} {
        set i 1
        foreach ch $choices {
            set prompt [lindex $ch 0]
            set t [lindex $ch 1]
            set each_c [frame .testField.page.c$i]
            set ::current(answer,$i) 0
            if {$t=={others}} {
                set others "$each_c.ent"
                entry $others -state disabled -width [winfo screenwidth . ]
                checkbutton $each_c.cb -text $prompt -variable ::current(answer,$i) \
                    -relief flat -anchor w -font $::myFont(choice) \
                    -command "if {\$::current(answer,$i)} { $others configure -state normal } else { $others configure -state disabled }"
                pack $each_c.cb $others -side left -expand yes -fill x
            } else {
                checkbutton $each_c.cb -text $prompt -variable ::current(answer,$i) \
                    -relief flat -anchor w -font $::myFont(choice)
                pack $each_c.cb -side left -expand yes -fill x
            }
                pack $each_c -pady 5 -padx 10 -side top -fill x
            incr i
        }
    }
    
    proc show_actions {actions} {
        set i 1
        #disable nex page button and change possiblly prompt txt
        .testField.x.next configure -state disabled
        foreach ch $actions {
            set action [lindex $ch 0]
            set args [lindex $ch 1]
            set each_c [frame .testField.page.c$i]
            if {$action=={message}} {
                label $each_c.lab -wraplength [expr [winfo screenwidth . ] - 50 ] -text $args -font $::myFont(choice) -anchor c
                pack $each_c.lab -expand yes -fill x
            } elseif {$action =={open}} {
                button $each_c.start -text "Start $args" -font $::myFont(choice) -command "
                    ::testField::disable
                    if {$::vnc_available} {
                        start_recording [file join $::collecting_data_dir $::current(subject_id)\_$::current(id)]
                    }
                    open_action $args
                    .testField.x.next configure -state normal
                    ::testField::setNextButtonTxt { Next }
                    ::testField::active
                    if {$::vnc_available} {
                        after 1000 {stop_recording [file join $::collecting_data_dir $::current(subject_id)\_$::current(id)]}
                    }
                    "
                pack $each_c.start         
            }
            pack $each_c -pady 5 -padx 10 -side top -fill x
            incr i
        }
        
    }
    
    # scale bar procs
    proc setWidth {i w colorbar_w colorbar_h width} {
        set ::current(answer,$i) $width
        set width [expr $width * 3]
        incr width 101
        set x2 [expr {$width - 30}]
        if {$x2 < 101} {
            set x2 101
        }
        set length [expr $colorbar_w + 100]
        #$w coords poly 100 15 100 35 $x2 35 $x2 45 $width 25 $x2 5 $x2 15 100 15
        $w coords poly 100 35 $x2 35 $x2 $colorbar_h $width 25 $x2 5 $x2 15 100 15 100 0 $length 0 $length $colorbar_h 100 $colorbar_h
        $w coords line 100 15 100 35 $x2 35 $x2 $colorbar_h $width 25 $x2 5 $x2 15 100 15
    }
    
    proc show_scale_choices {labels froms tos} {
        set ::current(answer) ""
        set colorbar_height 45
        set colorbar_width 301
        #puts "$from $to"
        if {[llength $froms] != [llength $tos]} {
            print_error "\[E\] number mismatch between 'from' and 'to' for line: $line"
            return
        }
        set label ""
        for {set i 0} {$i < [llength $froms]} {incr i} {
            set from [lindex $froms $i]            
            set to [lindex $tos $i]
            if {$i < [llength $labels]} {
                set label [lindex $labels $i]
            }
            
            set pad [frame .testField.page.pad$i -bd 2 -relief groove]
            
            label $pad.label -text $label \
                   -wraplength [expr [winfo screenwidth  .] - 200] \
                   -font $::myFont(scale_label) -justify left
        
            canvas $pad.canvas -width 500 -height 75 -bd 0 -highlightthickness 0
            $pad.canvas create text 0 60 -text $from -anchor w -justify left -width 200 \
                -font $::myFont(choice) -tags txt1 
            $pad.canvas create text 500 60 -text $to -anchor e -justify right -width 200 \
                -font $::myFont(choice) -tags txt2 
            
            image create photo imin
            imin put $::colorbar_data
            image create photo im
            im copy imin -to 0 0 $colorbar_width $colorbar_height -shrink
            
            $pad.canvas create image 100 0 -image im -tags im -anchor nw
            set length [expr $colorbar_width + 100]

            $pad.canvas create polygon 0 0 $length 0 $length $colorbar_height 0 $colorbar_height -fill [$pad.canvas cget -bg] -tags poly
            $pad.canvas create line 0 0 1 1 2 2 0 0 -fill black -tags line
            scale $pad.scale -orient horizontal -length 250 -from 0 -to 100 \
                -command "::testField::setWidth $i $pad.canvas $colorbar_width $colorbar_height" -tickinterval 50
            
            pack $pad.canvas $pad.scale $pad.label -side top -expand yes -anchor n -pady 1
            pack $pad -side top -pady 10 -ipadx 20 -ipady 10
        }
    }
    
    proc next_page {} {
         set continued [collect_data]
         if {$continued} {
             clear_page
             incr ::current(page_num)
             if {$::current(page_num) ==  $::current(Q_num)} {
                ::testField::setNextButtonTxt { End }
             }
             set ::current(page_foot) "$::current(page_num) / $::current(Q_num)"
             set ::page_done 1
         }
    }
    
    proc clear_page {} {
        destroy .testField.page
    }
    

}

proc ::testField::disable {} {
     grab release .testField
     wm overrideredirect .testField no
     wm iconify .testField
}
    
proc ::testField::active { } {
    wm overrideredirect .testField yes
    grab -global .testField
    focus -force .testField
    wm deiconify .testField    
}

proc ::testField::setNextButtonTxt { txt} {
    .testField.x.next configure -text $txt
}

proc ::testField::show {} {
     toplevel .testField
     wm title .testField ""
     wm overrideredirect .testField yes      ;# removes window decorations
     #catch {wm attributes .testField -topmost yes   ;# stays on top}
     wm geometry .testField [winfo screenwidth .]x[winfo screenheight .]+0+0
     update idletasks               ;# updates the full-screen
     frame .testField.x -highlightthickness 0 -bg white ;#-bg #c8efff
     place .testField.x -x 0 -y 0 -relwidth 1 -relheight 1

     button .testField.x.min -text "Minimize" -bg #ffdbff -font "arial 10 bold" \
        -command ::testField::disable
     place  .testField.x.min -x [expr [winfo screenwidth  .] - 140] -y 10

     button .testField.x.end -text "Close" -bg #ffdbff -font "arial 10 bold" \
        -command {if {[collect_data]} { destroy .testField }}
     place  .testField.x.end -x [expr [winfo screenwidth  .] - 60] -y 10

     button .testField.x.next -text " Next " -bg white -font "arial 10 bold" -width 50 -height 5  \
        -command {::testField::next_page }
     place  .testField.x.next -anchor s -x [expr [winfo screenwidth  .]/2] -y [expr [winfo screenheight  .]-50]

    set :current(page_num) 1
    set ::current(page_foot) "$::current(page_num) / $::current(Q_num)"
     label .testField.x.foot -textvariable ::current(page_foot) -bg #ffdbff -font "arial 10 bold"
     place  .testField.x.foot -anchor se -x [expr [winfo screenwidth  .]] -y [expr [winfo screenheight  .]-50]

     ::testField::active
     
     bind .testField <Expose> "wm overrideredirect .testField yes; focus -force .testField"
     bind .testField <KeyPress-Escape> ::testField::disable
     #bind .testField <KeyRelease-space> {::testField::next_page}
}
        
proc ::testField::close {} {
    ::testField::disable
    destroy .testField
    
}
#---------------------------------------------------------
# principal
#---------------------------------------------------------
catch {wm state . zoomed}
if {[file exists $::collecting_data_dir]==0} {
    if {[catch {file mkdir $::collecting_data_dir} msg]} {
        print_error $msg 
    }
}
print_info "Collecting directory: $::collecting_data_dir"

::preferences::load_and_apply $::ini_file

fillRecentDir

#foreach item {Input Output} {
#    if {[catch {.audioDevices_dlg.cb$item selection set $::Prefs($item)} msg ]} {
#        print_error "Don't support $item device: $::Prefs($item)"
#    } else {
#        snack::audio select$item $::Prefs($item)
#    }
#}

focus .
wm deiconify .
load_test $::Prefs(task_script)

# ----------------------------------------------------------------------
# About window
# ----------------------------------------------------------------------
namespace eval ::aboutBox:: {
    set aboutMessage "This utility is used to \ndo utilisability test"
    iwidgets::dialog .about -title $::APPNAME -modality application
    .about hide "Apply"
    .about hide "Help"
    .about hide "Cancel"
    .about buttonconfigure "OK" -command ".about deactivate"
    .about default "OK"

    set win [.about childsite]
    label $win.intro -text $aboutMessage -justify left
    pack $win.intro
    catch {$win.intro configure -font myFont(sitalic) }
}
    
proc ::aboutBox::show {} {
    .about activate
}

# ----------------------------------------------------------------------
# help window
# ----------------------------------------------------------------------

namespace eval ::helpBox:: {
    set box [toplevel .helpBox -relief flat -bd 1 -bg black]
    wm withdraw $box
    wm overrideredirect $box yes
    pack [label $box.msg -bg lightyellow -wraplength 120 -justify left] -expand yes -fill both
    
    proc show {widget x_coord y_coord msg} {
        variable box
        if {![winfo viewable $box]} {
        catch {wm attributes $box -topmost yes}
        . configure -cursor question_arrow
        $box.msg configure -text $msg
        wm geometry $box "+[expr [winfo rootx $widget]+$x_coord+60]+[expr [winfo rooty $widget]+$y_coord+15]"
        wm deiconify $box
        }
    }
    
    proc hide {} {
        variable box
        wm withdraw $box
        . configure -cursor arrow
    }
}

#console show
#test_VNC

#bind . <Button-1> { puts [focus] }