Tryag File Manager

//home/cluster1/data/bu01/1121861/html/poser/prompt-ame/bin/Prompt.tcl

#!/pkg/ldc/bin/wish8.3
#/home/maeda/bin/wish8.4

# Prompter.tcl

set ready 0
puts [info script]
set dictfile [tk_getOpenFile -title "Please select a dictionary file" -initialdir [file join [file dirname [info script]] ..]]

#set dictfile  Nahuatl-june-ref.dos

if {$dictfile == ""} {exit}
set start ""
set end ""
set logfile ""

proc RandomInit {seed} {
    global randomSeed
    set randomSeed $seed
}

proc Random {} {
    global randomSeed
    set randomSeed [expr ($randomSeed*9301 + 49297) % 233280]
    return [expr $randomSeed/double(233280)]
}

proc RandomRange {range} {
    expr int([Random]*$range)
}

# initialize random seed
RandomInit [pid]

# randomize a list of length $length consisting of integers 1 to $length
proc RandomList {length} {
    set count 1
    set randlist [list] 
    while {$count <= $length} {
	set index [expr [RandomRange $count] - 1]
	set randlist [linsert $randlist $index $count]
	incr count
    }
    return $randlist
}

# createNewWindow --
#
# Arguments:
# class - 
# win -
#
# Return:
#
proc createNewWindow {class w} {
    catch {destroy $w} 
    toplevel $w -class $class
    wm title $w $class
    wm group $w .
    return $w
}

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
proc createTimerIndicator {canvas} {
    canvas $canvas -background black -width 55 -height 15
#    $canvas create oval 5 5 10 10 -fill green -tag ind1
    $canvas create oval 5 5 10 10 -fill black -tag ind1
    $canvas create oval 15 5 20 10 -fill white -tag ind2
    $canvas create oval 25 5 30 10 -fill white -tag ind3
    $canvas create oval 35 5 40 10 -fill white -tag ind4
    $canvas create oval 45 5 50 10 -fill white -tag ind5
    return $canvas
}

# FunctionName --
#
# Arguments:
# canvas - 
# num - number between 1 and 5
#
# Return:
proc updateTimerIndicator {canvas num} {
    foreach x {1 2 3 4 5} {
	$canvas delete ind$x
	set n1 [expr $x * 10 - 5]
	set n2 [expr $x * 10]
	if {$x == $num && $x == 5} {
	    #set color red
	    set color white
	} elseif {$x == $num} {
#	    set color green
	    set color black
	} else {
	    set color white
	}

$canvas create oval $n1 5 $n2 10 -fill $color -tag ind$x
    }
}

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
proc incrementTimerIndicator {canvas interval num} {
    global prompt_stop
    set x 0
    set prompt_stop 0
    updateTimerIndicator $canvas $num
    after $interval {set prompt_stop 1}
    vwait prompt_stop
}

# canvas
# time: time in msec.
# status: 0 - go, 1 - stop

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
proc runTimerIndicator {canvas time} {
    global prompt_status
    set interval [expr $time / 5]
    foreach num {1 2 3 4 5} {
	if {$prompt_status == 1} {return 0}
	incrementTimerIndicator $canvas $interval $num
    }
    return 1
}

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
proc createScale {varName min max widgetName} {
    scale $widgetName -from $min -to $max -variable $varName \
	    -orient horizontal  -showvalue true \
	    -borderwidth 0 -relief raised -background black -foreground white
    return $widgetName
}

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
# take <img src=.....gif><img src=...>..
# return a list of gif file names
#
proc parseImgTags {s base} {

while {[string length $s] > 0} {
	set s2 [string trimleft $s "<img src="]
	set s2_index [string first ">" $s2]
	set s3 [string range $s2 0 $s2_index]
	set s3 [string trimright $s3 ">"]
	set s3 [string trimleft $s3 $base]
	set s [string range $s2 [expr $s2_index + 1] end]
	lappend out $s3 
    }

return $out
}

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
# ReadShoebox
# args: 
# filename: filename
# field_list: list of fields (i.e., \id, \w, \p ...) 
# {id w p {eg gl}} (eg gl can be repeated)

# return value:
# a string of formatted lexicon (for now..)

proc ReadShoebox {filename field_list} {
    set f [open $filename]
#    puts "opening $filename"

if {[gets $f line] >= 0} {
	if {[regexp {^\\_sh\s*(.*)$} $line match rest]} {
	    set lexicon_version $rest
#	    puts $lexicon_version
	}
    }
    
    # blank lines separate records (check the Shoebox manual)

set new_record_flag 1
    set line_l [gets $f line]

# loop over each record
    set counter 1;
    while {$line_l >= 0} {
	
	# out_array: r1, r2, r3...

upvar 0 r$counter out_array

# skip blank lines (record separater)

while {$line_l == 0} {
#	    puts "new_record"
	    set new_record_flag 1
	    set line_l [gets $f line]
	}

# process record
	set continuous_flag 0
	while {$line_l > 0} {
	    if {[regexp {^\\([A-Za-z]+)\s+(.*)$} $line match field_id rest]} {

set out_array($field_id) $rest
	    } else {
		# continuous line (check if a feild allows a blank line)
		append out_array($field_id) $line
	    }
	    set line_l [gets $f line]
	}

foreach i $field_list {
	    if {[info exists out_array($i)]} {
		append out_line "$out_array($i):"
	    } else {
		append out_line ":"
	    }
	}
	set out_line [string trimright $out_line ':']
	append out_line '\n'

#	lappend out_list r$counter
	incr counter
    }
    close $f
    return $out_line
}

#### from Effective TCL

# ----------------------------------------------------------------------
#  EXAMPLE: simple panedwindow facility
# ----------------------------------------------------------------------
#  Effective Tcl/Tk Programming
#    Mark Harrison, DSC Communications Corp.
#    Michael McLennan, Bell Labs Innovations for Lucent Technologies
#    Addison-Wesley Professional Computing Series
# ======================================================================
#  Copyright (c) 1996-1997  Lucent Technologies Inc. and Mark Harrison
# ======================================================================

option add *Panedwindow.grip.cursor sb_v_double_arrow widgetDefault

proc panedwindow_create {win width height} {
    global pwInfo

frame $win -class Panedwindow -width $width -height $height
    frame $win.pane1
    place $win.pane1 -relx 0.5 -rely 0 -anchor n \
        -relwidth 1.0 -relheight 0.5
    frame $win.pane2
    place $win.pane2 -relx 0.5 -rely 1.0 -anchor s \
        -relwidth 1.0 -relheight 0.5

frame $win.sash -height 4 -borderwidth 2 -relief sunken
    place $win.sash -relx 0.5 -rely 0.5 -relwidth 1.0 -anchor c

frame $win.grip -width 10 -height 10 \
        -borderwidth 2 -relief raised
    place $win.grip -relx 0.95 -rely 0.5 -anchor c

bind $win.grip <ButtonPress-1>   "panedwindow_grab $win"
    bind $win.grip <B1-Motion>       "panedwindow_drag $win %Y"
    bind $win.grip <ButtonRelease-1> "panedwindow_drop $win %Y"

return $win
}

proc panedwindow_grab {win} {
    $win.grip configure -relief sunken
}

proc panedwindow_drag {win y} {
    set realY [expr $y-[winfo rooty $win]]
    set Ymax  [winfo height $win]
    set frac [expr double($realY)/$Ymax]
    if {$frac < 0.05} {
        set frac 0.05
    }
    if {$frac > 0.95} {
        set frac 0.95
    }
    place $win.sash -rely $frac
    place $win.grip -rely $frac

return $frac
}

proc panedwindow_drop {win y} {
    set frac [panedwindow_drag $win $y]
    panedwindow_divide $win $frac
    $win.grip configure -relief raised
}

proc panedwindow_divide {win frac} {
    place $win.sash -rely $frac
    place $win.grip -rely $frac

place $win.pane1 -relheight $frac
    place $win.pane2 -relheight [expr 1-$frac]
}

### From Steven's interliear program (modified)

proc info_for {win mesg} {
    global info
    set info($win) $mesg
    bind $win <Enter> {show_info %W}
    bind $win <Leave> {clear_info %W}
}
proc clear_info {w} {
    global info
    regexp {^(.[^\.]*)\.} $w match base
    $base.info.text configure -text {}
}

proc show_info {w} {
    global info
    regexp {^(.[^\.]*)\.} $w match base
    $base.info.text configure -text $info($w)
}

## Global variables and default values

set lexicon_type "shoebox"
set delimiter |
set list_font {times 12}
set display_font {times 36}
set display_font2 {times 36}

set width 300
set height 200
#set font {-adobe-courier-bold-r-normal--*-160-*}
set backgroud_color white
set char_color black

set prompter_window_height 300
set prompter_window_width 640

## Process arguments here
set startnum 1
#set prompt_num_in_session 300
if {[llength $argv] > 0} {
    set filename [lindex $argv 0]
    set startnum [lindex $argv 1]
#    set prompt_num_in_session [lindex $argv 2]
} else {
    set filename $dictfile
}

### Main program

wm title . "Prompter"

## Menu bar
frame .menubar -borderwidth 1 -relief raised
pack .menubar -fill x
 
foreach x {File Options} {
    menubutton .menubar.m$x -text $x -menu .menubar.m$x.m
    pack .menubar.m$x -side left
    menu .menubar.m$x.m -tearoff 0
}

menubutton .menubar.mHelp -text Help -menu .menubar.mHelp.m
pack .menubar.mHelp -side right
menu .menubar.mHelp.m -tearoff 0

.menubar.mFile.m add command -label "Exit" -command exit
.menubar.mOptions.m add command -label "Some options.." 
.menubar.mHelp.m add command -label "About" 
.menubar.mHelp.m add command -label "Help notes"

#.menubar add cascade -label Help -menu .menubar.mHelp

## File indicator

frame .filename

label .filename.lab -text "Imported Lexicon File Name:"
entry .filename.name -width 36 -relief sunken -textvariable filename
pack .filename.lab .filename.name -side left

frame .range
label .range.lab -text "Range:  From"
entry .range.start -width 12 -relief sunken -textvariable start
label .range.lab2 -text "To"
entry .range.end -width 12 -relief sunken -textvariable end
pack .range.lab .range.start .range.lab2 .range.end -side left

## Control panel

frame .control

button .control.properties -text "Properties" -command "importLexiconFile ."
#button .control.properties -text "Properties" -command changeProperties
#pack .control.properties -side top -anchor center

label .control.lab1 -text "Total words/phrases/sentences in the file:" 
checkbutton .control.random -text "Randomize the list?" -variable random \
	-anchor w
checkbutton .control.shownumber -text "Show number..???" -variable shownumber

# ScrolledList --
#
# Arguments:
# f - 
# font -
# Return:
# 
proc ScrolledList {f font} {
    frame $f
    eval {listbox $f.text -width 80 -height 15 \
	    -xscrollcommand [list $f.xscroll set] \
	    -yscrollcommand [list $f.yscroll set] -bg white\
	    -font $font}
    scrollbar $f.xscroll -orient horizontal \
	    -command [list $f.text xview]
    scrollbar $f.yscroll -orient vertical \
	    -command [list $f.text yview]
    grid $f.text $f.yscroll -sticky news
    grid $f.xscroll -sticky news
    grid rowconfigure $f 0 -weight 1
    grid columnconfigure $f 0 -weight 1
    return $f.text
}

# ScrolledMList --
#
# Arguments:
# args - 
#
# Return:
# 
# ScrolledMList --
#
# Arguments:
# args - 
#
# Return:
#

global ID
panedwindow_create .pw 640 400

## Original Word List

#frame .pw.pane1
label .pw.pane1.label -text "Imported Lexicon File:" -anchor w

set t [ScrolledList .pw.pane1.list $list_font]

set f [open $filename]
fconfigure $f -encoding binary
set count 1
global startnum
#while {[gets $f line] >= 0} {
#    #puts $line
#    if {$startnum > 1} {
#	incr startnum -1
#	continue
#    }
#    set id [lindex [split $line $delimiter] 0]
#    set a [lindex [split $line $delimiter] 1]
#    set a2 [lindex [split $line $delimiter] 2]
#    set b [lindex [split $line $delimiter] 3]
#    set c [lindex [split $line $delimiter] 4]
#    puts $a
#    set prompt_array(id,$count) $id
#    set prompt_array(1,$count) "$a\n$a2"
#    set prompt_array(2,$count) $b
#    set prompt_array(7,$count) $c
#    $t insert end $line
#    incr count
#}

set lxa ""
set se ""
set se_all ""
set ref ""
set count 1
set highest_ref 00000
while {[gets $f line] >= 0} {
    if {[regexp {^\\ref (.*)$} $line match ref]} {
	if {$highest_ref < $ref} {
	    set highest_ref $ref
	}
	set prompt_array(id,$ref) $ref
	set prompt_array(1,$ref) $lxa
	set prompt_array(2,$ref) $se_all
	#puts $se_all
	set prompt_array(7,$ref) $ref
	set lxa ""
	set se ""
	set se_all ""
	set ref ""
	incr count
    } else {
	regexp {^\\lxac (.*)$} $line match lxa
	if {[regexp {^\\ss[a-z]* (.*)$} $line match se]} {
	    if {$se_all == ""} {
		set se_all $se
	   }
	}
    }
}
close $f

proc add_zeros {n} {
    if {$n < 10} {
	set out 0000$n
    } elseif {$n < 100} {
	set out 000$n
    } elseif {$n < 1000} {
	set out 00$n
   } elseif {$n < 10000} {
	set out 0$n
   } else {
       set out $n
   }
   return $out
}

for {set i 1} {[add_zeros $i] <= $highest_ref} {incr i} {
    set n [add_zeros $i]
    if {![info exists prompt_array(id,$n)]} {
	set prompt_array(id,$n) $n
	set prompt_array(1,$n) ""
	set prompt_array(2,$n) ""
	set prompt_array(7,$n) ""
    }
	set line "$prompt_array(id,$n) $prompt_array(1,$n) $prompt_array(2,$n)"
    $t insert end $line
}

set prompt_array_total $count

pack .pw.pane1.label -fill x -padx 4 -pady 4
pack .pw.pane1.list -fill both  -expand true -padx 4 -pady 4

## Prompter list

label .pw.pane2.label -text "Created List:" -anchor w

set prompt_list_text [ScrolledList .pw.pane2.list $list_font]
pack .pw.pane2.label -fill x -padx 4 -pady 4
pack .pw.pane2.list -fill both -expand true -padx 4 -pady 4

#text .pw.pane2.info -height 1 -relief sunken
#pack .pw.pane2.info -side bottom -fill x

## Action list

frame .action
button .action.viewlist -text "View List (Original Order)" -command viewList
button .action.viewOrderedList -text "View List" -command viewSelectedList
button .action.printlist -text "Print List" -command printlist
button .action.startprompter -text "Start Prompter" -command startPrompter
#pack .action.viewlist .action.viewOrderedList .action.printlist .action.startprompter -side left
pack .action.startprompter .action.viewOrderedList -side left

pack .filename .range .control .pw -side top -fill both -expand true
#pack .pw.pane1 -expand yes -fill both -padx 4 -pady 4
#pack .pw.pane2 -expand yes -fill both -padx 4 -pady 4
focus .range

pack .action -side top -padx 2 -pady 2 -fill x -expand true

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
proc viewList {} {
    global prompt_array prompt_array_total prompt_list_text
#    puts "New session"
    $prompt_list_text delete 0 end
    set count 1
    while {$count < $prompt_array_total} {
	set n [add_zeros $count]
	set line "$count $prompt_array(1,$n) $prompt_array(2,$n) $prompt_array(7,$n)"
	$prompt_list_text insert end $line
	incr count
    }
}

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
proc viewOrderedList {} {
    global prompt_array prompt_array_total prompt_list_text
#    puts "Viewing the thing"
    $prompt_list_text delete 0 end
    set randomlist [RandomList [expr $prompt_array_total - 1]]
    set count 1
    while {$count < $prompt_array_total} {
	set index [lindex $randomlist [expr $count - 1]] 
	set line "$index $prompt_array(1,$index) $prompt_array(2,$index) $prompt_array(7,$index)"
#	puts $line
	$prompt_list_text insert end $line
	incr count
    }
}

proc viewSelectedList {} {
    global start end prompt_list_text prompt_array prompt_num_in_session ready
    set prompt_num_in_session [expr $end - $start + 1]
    $prompt_list_text delete 0 end

if {$start == ""} {
	return
    }
    
    for {set i $start} {$i <= $end} {incr i} {
	set n [add_zeros $i]
	set line "$n $prompt_array(1,$n) $prompt_array(2,$n)"
	$prompt_list_text insert end $line
    }
    set ready 1
}
# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
proc printlist {} {
    global filename random
    puts "Printing the thing"
    puts $random
}

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
proc changeProperties {} {
    global randomize shownumber delimiter column_num set_num file_format
    set w [createNewWindow Properties .prop]
    frame $w.top
    pack $w.top -side top -expand true -fill both
    frame $w.top.list -background white
    label $w.top.list.label -text "List Format" -background white
    pack $w.top.list.label -side top -padx 10 -pady 10

frame $w.top.list.format -background white
    label $w.top.list.format.lab -text "File format: " -background white
    tk_optionMenu $w.top.list.format.option file_format "shoebox" "text"
    pack $w.top.list.format.lab $w.top.list.format.option -side left 
    
    frame $w.top.list.del -background white
    label $w.top.list.del.lab -text "Delimiter: " -background white
    entry $w.top.list.del.char -width 3 -relief sunken -textvariable delimiter
    set delimiter |
    pack $w.top.list.del.lab $w.top.list.del.char -side left

frame $w.top.list.col -background white
    label $w.top.list.col.lab -text "Which fields to use: " -background white
    entry $w.top.list.col.num -width 3 -relief sunken -textvariable column_num
    set column_num "2,3"
    pack $w.top.list.col.lab $w.top.list.col.num -side left

frame $w.top.list.set -background white
    label $w.top.list.set.lab -text "How many at a time?: " -background white
    entry $w.top.list.set.num -width 5 -relief sunken -textvariable set_num
    set set_num 600
    pack $w.top.list.set.lab $w.top.list.set.num -side left

pack $w.top.list.format $w.top.list.del $w.top.list.col $w.top.list.set -side top -padx 4 -pady 4
    
    ## Viewing properties

frame $w.top.view -background white
    label $w.top.view.lab -text "test test test test test" -background white
#    pack $w.top.view.lab -side top

frame $w.top.sep -width 2 -borderwidth 1 -relief sunken -background white
    pack $w.top.list -side left -fill both -expand true
    pack $w.top.sep -side left -fill y 
    pack $w.top.view -side left -fill both -expand true
    
#    checkbutton $w.top.randomize -text "Randomize lines" -variable randomize
#    checkbutton $w.top.shownumber -text "Show numbers" -variable shownumber
#    pack $w.top.label $w.top.randomize $w.top.shownumber -side top

frame $w.sep -height 2 -borderwidth 1 -relief sunken -background white
pack $w.sep -side top -fill x
    frame $w.bottom -background white
    pack $w.bottom -side bottom -fill x
    frame $w.bottom.exit -background white 
    button $w.bottom.exit.ok -text "Dismiss" -command "destroy $w" 
    pack $w.bottom.exit.ok -side right
    pack $w.bottom.exit -side right -padx 4 -pady 4
}

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
proc startPrompter {} {
    global prompt_count
    global prompt_session
    global prompt_num_in_session
    global prompt_status
    global prompter_window_height
    global prompter_window_width prompt_array
    global prompt_interval start
    global logfile ready

if {$ready == 0} {
	return
    }
    set file [tk_getSaveFile -title "Please name a log file" -initialdir [file join [file dirname [info script]] ..]]
    set logfile [open $file w 0644]
    set prompt_interval 5
    set prompter_on 1
    set prompt_session 1
#    puts "Start the prompter" 
    set w [createNewWindow prompter .prompter]
    set prompter_num_fields 3
    set root_width [winfo screenwidth .]
    set prompter_window_width $root_width
    set root_height [winfo screenheight .]
    set control_panel_height 1
    set status_panel_height 30
    set prompter_window_height [expr int ($root_height / $prompter_num_fields) - 30]
    set prompter_overall_height [expr $prompter_window_height * \
	    $prompter_num_fields + $control_panel_height + $status_panel_height]

wm geometry $w ${prompter_window_width}x${prompter_overall_height}+0+0
    #    wm geometry $w +0+0
    wm minsize . 50 50

### Main panel
    
    frame $w.main
    pack $w.main -side top -fill both -expand true

$w configure -width $prompter_window_width
    $w configure -height $prompter_overall_height

canvas $w.main.entry -width $prompter_window_width \
	    -background white
    canvas $w.main.entry2 -width $prompter_window_width \
	    -background white
    canvas $w.main.entry7 -width $prompter_window_width \
	    -background white

pack $w.main.entry -side top -anchor center -fill both -expand true
    pack $w.main.entry2 -side top -anchor center -fill both -expand true
    pack $w.main.entry7 -side top -anchor center -fill both -expand true

# prompt_status: 0 -- auto, 1 -- stop
    set prompt_status 1
    set prompt_count 1
    set entry_id 0

showPrompt $w

### Key bind information

frame $w.info 
    label $w.info.text -relief sunken -height 1 
    pack $w.info.text -fill x -expand true
    pack $w.info -fill x -expand true
    info_for $w.main "Test"

### Status indicator

frame $w.status -height $status_panel_height -background black
    pack $w.status -side top -fill x
    createTimerIndicator $w.status.timer
    pack $w.status.timer -side left -fill both -padx 2 -pady 2 
    label $w.status.l1 -text "Count " -background black -foreground white
    label $w.status.count -textvariable prompt_count -background white \
	    -foreground black -relief sunken
    label $w.status.l2 -text " out of " -background black -foreground white
    label $w.status.count2 -textvariable prompt_num_in_session -background white -foreground black -relief sunken
    label $w.status.l3 -text " in Session " -background black -foreground white
    label $w.status.count3 -textvariable prompt_session -background white \
	    -foreground black -relief sunken
    pack $w.status.l1 $w.status.count $w.status.l2 $w.status.count2 -side left -fill both -padx 2 -pady 2
 
    ### Control panel

frame $w.control -background black -borderwidth 0
    createScale prompt_interval 1 20 $w.control.scale
    $w.control.scale set $prompt_interval
    #    $w.control.scale configure -background black -foreground white

#    puts $prompt_interval

button $w.control.go -text "Auto" -command "autoPrompt $w" -bg white -fg black
    button $w.control.pause -text "Pause" -command "pausePrompt" -bg white -fg black
#button $w.control.exit -text "Exit" -command "puts LAST\t$prompt_count\t$prompt_array(id,$prompt_count);destroy $w;destroy ." -bg white -fg black
button $w.control.exit -text "Exit" -command "close $logfile;destroy $w;destroy ." -bg white -fg black
    button $w.control.back -text "Prev" -command "prevPrompt $w" -bg white -fg black
    button $w.control.forward -text "Next" -command "nextPrompt $w" -bg white -fg black
    pack $w.control.exit -side right -padx 4 -pady 4
    pack $w.control.forward $w.control.back -side left -padx 4 -pady 4
    pack $w.control.pause $w.control.go $w.control.scale -side right \
	    -padx 4 -pady 4
    pack $w.control -side bottom -fill x

### Key bindings
    ### using KeyRelease so that key-releasing noise won't overlap with speech
    
    bind $w <KeyRelease-n> {nextPrompt %W}
    bind $w <KeyRelease-Right> {nextPrompt %W}
    #bind $w <KeyRelease-Return> {nextPrompt %W}
    #bind $w <KeyRelease-space> {nextPrompt %W}
    bind $w <KeyRelease-r> {nextIsUsed}
    bind $w <KeyRelease-BackSpace> {prevPrompt %W}
    #bind $w <KeyRelease-p> {prevPrompt %W}
    bind $w <KeyRelease-Left> {prevPrompt %W}
#    bind $w <KeyRelease-Escape> {destroy %W}
    #bind $w <KeyRelease-Escape> {
#	puts LAST\t$prompt_count\t$prompt_array(id,$prompt_count) 
#	destroy %W
#	destroy .
#    }

focus $w
grab $w
}

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
# w - window
# id_list - a list of 
# entry_id - the first tag ...
proc showPrompt {w} {
    global prompter_window_width
    global prompter_window_height
    global display_font
    global display_font2
    global prompt_array
    global prompt_count
    global start logfile
    set count [expr $prompt_count + $start - 1]

set n [add_zeros $count]
    $w.main.entry delete all
    $w.main.entry2 delete all
    $w.main.entry7 delete all

# place entries in the middle of each canvas
    set height [expr int($prompter_window_height / 2)]
    set width [expr int($prompter_window_width / 2)]
    set entry_id [$w.main.entry create text $width $height -text $prompt_array(1,$n) -font $display_font2 -width $prompter_window_width]
    set entry_id2 [$w.main.entry2 create text $width $height -text $prompt_array(2,$n) -font $display_font2 -width $prompter_window_width]
    set entry_id7 [$w.main.entry7 create text $width $height -text $prompt_array(7,$n) -font $display_font2 -width $prompter_window_width]

puts -nonewline $logfile "ORIG\t"
    puts -nonewline $logfile "$n\t"

puts -nonewline $logfile "$prompt_array(1,$n)\t"
    puts -nonewline $logfile [clock clicks -milliseconds]\t
    puts $logfile [clock format [clock seconds]]
    flush $logfile
}

proc nextIsUsed {} {
    global logfile 
    bell

puts -nonewline $logfile "REDO\t"
    puts -nonewline $logfile [clock clicks -milliseconds]\t
    puts $logfile [clock format [clock seconds]]
#    puts $logfile [exec date]
    flush $logfile
}
# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
proc nextPrompt {w} {
    global prompt_count prompt_num_in_session
    incr prompt_count
    if {$prompt_count > $prompt_num_in_session} {
	incr prompt_count -1
    }
    showPrompt $w
}

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
proc prevPrompt {w} {
    global prompt_count
    if {$prompt_count > 1} {
	incr prompt_count -1
    }
    showPrompt $w
}

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
proc autoPrompt {w} {
    global prompt_interval
    global prompt_count
    global prompt_status
    set prompt_status 0
    while {$prompt_count < 40} {
	if {[runTimerIndicator $w.status.timer [expr $prompt_interval * 1000]]} {
	set prompt_interval [$w.control.scale get]
	    nextPrompt $w
	} else {
	    break
	}
    }
}

# FunctionName --
#
# Arguments:
# args - 
#
# Return:
# 
proc pausePrompt {} {
    global prompt_stop
    global prompt_status 
    set prompt_stop 1
    set prompt_status 1
}

# part of code borrowed from tk8.3/demos/filebox.tcl
proc importLexiconFile {parent} {
    set types {
	{"Shoebox lexicons" {.sh .shoebox .shoe .sho}}
	{"Text files" {.txt .text} TEXT}
	{"All files" *}
    }
    set file [tk_getOpenFile -filetypes $types -parent $parent]
    #puts $file
    return $file
#    if [string compare $file ""] {
#	$ent delete 0 end
#	$ent insert 0 $file
#	$ent xview end
#    }

}

#viewList
#startPrompter