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


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 {} {
    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 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
        }
        $w coords poly 100 15 100 35 $x2 35 $x2 45 $width 25 $x2 5 $x2 15 100 15
        $w coords line 100 15 100 35 $x2 35 $x2 45 $width 25 $x2 5 $x2 15 100 15
    }
    
    proc show_scale_choices {labels froms tos} {
        set ::current(answer) ""
        #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 
            $pad.canvas create polygon 0 0 1 1 2 2 -fill DeepSkyBlue3 -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" -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 #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 lightblue -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] }