asr.plug

# -*-Mode:Tcl-*-
#
#  Copyright (c) 2012-2014 Giampiero Salvi
#
# This is a plugin that allows to run the Julius recognizer embedded
# in Wavesurfer

# Guidelines for Language Packs:
# - Language packs should be stored in directories under .../plugins/asr/
# - the directory name should match the language name
# - the language pack must contain:
#   - lang.conf (should contain the credits for the language pack, including eventual licenses)
#   - julius.jconf (Julius configurations not already contained in the LM and AM files)
#   - one or more set of acoustic models. Acoustic models should be stored in Julius format
#     they must have extension .mmf and must have a corresponding model set list file with
#     the same name and extension .lst. It is recommended that the file name gives some
#     indication of the kind of models (e.g. number of Gaussians, feature kind, sampling freq.),
#     example: tied_64_MFCC_0_D_A_Z-16kHz.mmf
#   - one or more set of language models. Language models can be either n-grams (extension .lm)
#     or regular grammars (extension .dfa). In both cases, a corresponding dictionary must be
#     provided with equal filename and extension .dict. For regular grammars, a .term file may
#     also be required depending on how the grammar was generated. It is recommended that the
#     file name gives some indication on the kind of grammar (kind of words if possible, order
#     of the number of words...), example: nst_testset_20kw.lm
#   - full.dict: large dictionary used to generate automatically the regular grammar needed for
#     forced alignment


# Register plug-in with the callbacks we want to use.
wsurf::RegisterPlugin ASR \
  -description "This plug-in adds online speech recognition support.\
  Right click on a pane and select \"Create Pane/Speech Recognition\".\
  The plugin will create a transcription pane and present there the\
  results of speech recognition. Right click and select Propeties to\
  get access to the plugin configuration under the ASR tab.\
  If you use this plugin for research, please refer to the article:\
  \n\
  Salvi, G., & Vanhainen, N. (2014). \"The WaveSurfer Automatic Speech\
  Recognition Plugin\" in Proceedings of LREC. Reykjavik, Iceland.\
  \n\
  More information and updated versions of the plugin at http://www.speech.kth.se/asr/." \
    -url "http://www.speech.kth.se/~giampi/" \
    -addmenuentriesproc   asr::addMenuEntries \
    -panecreatedproc      asr::paneCreated \
    -panedeletedproc      asr::paneDeleted \
    -propertiespageproc   asr::propertyPane \
    -applypropertiesproc  asr::applyProperties \
    -getconfigurationproc asr::getConfiguration \
    -redrawproc           asr::redraw \
    -soundchangedproc     asr::soundChanged \
    -before  transcription


#    -getboundsproc        asr::getBounds \
#    -cursormovedproc      asr::cursorMoved \


# -----------------------------------------------------------------------------
# Create own namespace in which to keep all procedures and variables, global,
# widget-specific, or pane-specific.

namespace eval asr {
  variable Info

  if [info exists ::wsurf::Info(CurrentPluginPath)] {
    set Info(dir) [file dirname $::wsurf::Info(CurrentPluginPath)]
  } else {
    set Info(dir) [file dirname [info script]]
  }

  set Info(OptionTable) [list \
		-asr:lang        lang       "Swedish" \
		-asr:grammarType grammarType "" \
		-asr:cfg         cfg        "$Info(dir)/asr/Swedish/julius.jconf" \
		-asr:amfn        amfn       "" \
		-asr:mmf         mmf        "" \
		-asr:dic         dic        "" \
		-asr:lst         lst        "" \
		-asr:lm          lm         "" \
		-asr:dfa          dfa         "" \
		-asr:extraargs   extraargs  "" \
		-asr:inspen      inspen     0.0 \
		-asr:translevel  translevel "word" \
		-asr:confidenceflag  confidenceflag   0 \
		-asr:forcedflag  forcedflag   0 \
		-asr:forcedext   forcedext  "ort" \
		   ]

  set Info(tmpfile) [file join [util::tmpdir] asrtmp.[pid]]

  set Info(credits) "Wavesurfer ASR Plugin\n\n(c) 2012-2014 Giampiero Salvi <giampi@kth.se>\n\nContributors:\nNiklas Vanhainen\n\nFor more information consult:\nSalvi, G., & Vanhainen, N. (2014). The WaveSurfer Automatic Speech Recognition Plugin. In Proceedings of LREC. Reykjavik, Iceland.\n"

  # find Julius executable. At the moment only locally stored exe files are considered, in the future,
  # first check if Julius is already installed in the system
  # tcl_platform(os): Linux, Windows NT, Darwin
  set os [lindex $::tcl_platform(os) 0]
  switch $os {
    "Windows" { set extension ".exe" }
    "Darwin" { set extension ".dSYM" }
    default { set extension "" }
  }
  # tcl_platform(machine): x86_64, intel, x86_64
  set machine $::tcl_platform(machine)
  set Info(asrexe) [file join $Info(dir) asr bin julius-4.3.1_${os}_$machine$extension]
  # the next should be read from julius acoustic models. Problem is the models are
  # binary files and not easily parsed. Alternatively it can be read from julius
  # recognition output, but the problem is that it's needed before julius is run
  # in order to resample. Another alternative could be to rely on julius resampling
  # but it dosen't seem to support other than 48kHz resampling
  set Info(samplingrate) 16000
} 


# -----------------------------------------------------------------------------
# Add the entry "Speech Recognition" to the "Create Pane" popup-menu,
# with the command asr::createAsr

proc asr::addMenuEntries {w pane m hook x y} {
  if {[string match create $hook]} {
    $m.$hook add command -label "Speech Recognition" \
	-command [namespace code [list createAsr $w $pane]]
  }
}


# -----------------------------------------------------------------------------
# This procedure is called when a new pane is created.
# Note that we don't know at this point what will be rendered in this pane,
# so we assume that this plug-in won't handle this pane and keep track of
# that information in a variable. 

proc asr::paneCreated {w pane} {
 namespace eval [namespace current]::${pane} {
  variable var
 }
 upvar [namespace current]::${pane}::var v
 set v(drawAsr) 0

}


# -----------------------------------------------------------------------------
# This procedure is called when a pane is deleted, allowing
# the plug-in to clean-up resources used for the pane.
# The procedure deletes the pane's local namespace, which contains all
# variables allocated for the pane.

proc asr::paneDeleted {w pane} {
  namespace delete [namespace current]::${pane}
}


# Create a new pane and add graphics to it showing recognition results

proc asr::createAsr {w pane} {

  puts "createAsr: entry pane=$pane"

  ::wsurf::trans::createTranscription $w $pane
  #set pane [$w addPane -before $pane -height 20 -scrollheight 20 \
  #    -unit "" -fillcolor lightyellow -framecolor blue]

  # this is a hack to find the current pane because createTranscription does
  # not return the value
  set master [regsub {\.[^\.]*$} $pane ""]
  set panelist [pack slaves $master]
  set index -1
  foreach p $panelist {
      incr index
      if [string equal $p $pane] {
	  break
      } 
  }
  set pane [lindex $panelist [expr $index-2]]
  # end of the hack
  puts "createAsr: exit pane=$pane"

  upvar ::wsurf::trans::${pane}::var u
  set u(format) "WaveSurfer"
  set u(labext) "rec"

  addAsrStuff $w $pane
}


# Compute and draw recognition info in a given pane.

proc asr::addAsrStuff {w pane args} {
  variable Info
  upvar [namespace current]::${pane}::var v
  
  file delete -force $Info(tmpfile).wav
  
  foreach {option key default} $Info(OptionTable) {
    set a($option) $default
  }
  array set a $args
  foreach {option key default} $Info(OptionTable) {
    set v($key) $a($option)
  }
  
  _computeAsr $w $pane
  _drawAsr $w $pane
}

proc lshift listVar {
    upvar 1 $listVar l
    set r [lindex $l 0]
    set l [lreplace $l [set l 0] 0]
    return $r
}

proc asr::getJuliusTranscription {juliusres level} {
  # first extract relevant information
  set lines [split $juliusres \n]
  set len [llength $lines]
  set idx 0
  while {(![regexp "-- $level alignment --" [lindex $lines $idx]]) && ($idx<$len)} {
    incr idx
  }
  if $idx==$len {
    puts "error: beginning of $level transcrition not found"
  }
  # here we have found the beginning, skip the next two lines
  incr idx 3
  set idxstart $idx
  while {(![regexp {re[-]computed AM score} [lindex $lines $idx]]) && ($idx<$len)} {
    incr idx
  }
  if $idx==$len {
    puts "error: end of word transcrition not found"
  }
  incr idx -1
  set idxend $idx

  return [join [lrange $lines $idxstart $idxend] \n]
}

# convert Julius to HTK format
proc asr::juliusTransToHTK {transcription stripTriphones} {
  variable Info
  set transHTK ""
    foreach line [split $transcription \n] {
    if ![regexp {\[\s*([^\s]*)\s*([^\s]*)\s*\]\s*([^\s]*)\s*([^\s]*)} $line dummy start end score symbol] {
      puts "format error: $line"
      continue
    }
    if $start!=0 {
      set start "${start}00000"
    }
    set end "${end}00000"
    if $stripTriphones {
      regsub {^.*\-} $symbol "" symbol
      regsub {\+.*$} $symbol "" symbol
    }
    set transHTK "${transHTK}$start $end $symbol $score\n"
  }
  return $transHTK 
}

# convert Julius to Wavesurfer format
proc asr::juliusTransToWavesurfer {juliusTrans windowSize frameShift stripTriphones} {
  set trans ""
  foreach line [split $juliusTrans \n] {
    if ![regexp {\[\s*([^\s]*)\s*([^\s]*)\s*\]\s*([^\s]*)\s*([^\s]*)(\s\[([^\s]*)\])?} $line dummy start end score symbol1 dummy symbol2] {
      puts "format error: $line"
      continue
    }
    if {$start != 0} {
      set start [expr ${start}*$frameShift+$windowSize]
    }
    set end [expr ${end}*$frameShift+$windowSize]
    if { $symbol2!="" } {
      set symbol $symbol2
    } else {
      set symbol $symbol1
    }
    if $stripTriphones {
      regsub {^.*\-} $symbol "" symbol
      regsub {\+.*$} $symbol "" symbol
    }
    set trans "${trans}$start $end $symbol $score\n"
  }
  return $trans
}

# convert Julius to Wavesurfer format
proc asr::getJuliusCMScores {juliusOutput} {

  regexp {cmscore1\: ([^\n]*)} $juliusOutput dummy scores

  return [split $scores " "]
}

# convert Julius to Wavesurfer format
proc asr::getJuliusParameters {juliusOutput} {

  # feature extraction:
  regexp {sample frequency =\s*([0-9]*) Hz} $juliusOutput dummy samplingFrequency
  regexp {window size =\s*[0-9]* samples \(([0-9.]*) ms\)} $juliusOutput dummy windowSizeMs
  regexp {frame shift =\s*[0-9]* samples \(([0-9.]*) ms\)} $juliusOutput dummy frameShiftMs

  set faParams(samplingFrequency) $samplingFrequency
  set faParams(windowSize) [expr $windowSizeMs/1000.0]
  set faParams(frameShift) [expr $frameShiftMs/1000.0]

  return [array get faParams]
}

# removes comments and other problematic aspects of dictionaries
# tested with a special version of the cmu dictionary available for English
# in the future more formats will be supported
proc asr::cleanDictionary { dictlines } {
  set cleandict {}
  foreach line $dictlines {
    if {[regexp {^\\\;\;\;} $line] } { continue }
    lappend cleandict [regsub -all {\(1\)} $line {}]
  }
  return $cleandict
}

# note that this ignores lines that don't fit the format specified by the regexp
proc asr::readDictionary { filename } {
  set dictionary [dict create]
  set fh [open $filename]
  set cleandict [cleanDictionary [split [read $fh] \n]]
  close $fh
  foreach line $cleandict {
    set res [regexp -all {^([^\s\t]*)[\s\t]*(\[.*\])?[\s\t]*([^\s].*[^\s])[\s]*$} $line all word dummy pron]
    if { ! $res } { continue }
    dict lappend dictionary $word $pron
  }
  dict lappend dictionary <s> sil
  dict lappend dictionary </s> sil

  return $dictionary
}

proc asr::TranscriptionToJuliusGrammar {tran fulldict} {
  set tran "<s> [string toupper $tran] </s>"
  set dict "0 \[sil\] sil\n"
  set gram ""
  set wid 1
  # generate dictionary
  foreach word $tran {
    if { ! [dict exists $fulldict $word] } {
      error "missing word $word"
    }
    foreach pron [dict get $fulldict $word] {
      set dict "$dict$wid \[$word\] $pron\n"
    }
    incr wid
  }
  # generate grammar
  set nodei 0
  set tranlen [llength $tran]
  set islastnode 1
  for {set wordidx [expr $tranlen]} {$wordidx>0} {incr wordidx -1} {
    set nextnodei [expr $nodei+1]
    set gram "$gram$nodei $wordidx $nextnodei 0 $islastnode\n"
    set gram "$gram$nextnodei 0 $nextnodei 0 $islastnode\n"
    incr nodei
    set islastnode 0
  }
  set gram "$gram$nodei -1 -1 1 0\n"

  set grammar(gram) $gram
  set grammar(dict) $dict

  return [array get grammar]
}

# Compute recognition info in a given pane.
proc asr::_computeAsr {w pane} {
  variable Info
  upvar [namespace current]::${pane}::var v
  upvar ::wsurf::trans::${pane}::var u

  # ACOUSTIC MODELS
  set v(mmf) [file join $Info(dir) asr $v(lang) $v(amfn)]
  set v(lst) [regsub {.mmf$} $v(mmf) {.lst}]

  # these are flags that are used regardless if it is forced alignment or recognition
  set commonFlags "-C $v(cfg) -nosectioncheck -hlist $v(lst) -h $v(mmf) -input rawfile -iwsp -filelist $Info(tmpfile).lst"

  set snd [sound] 
  $snd copy [$w cget -sound]
  if {[$snd length] == 0} {
    return
  }
  # set channels to 1 if necessary
  set channels [$snd cget -channels]
  if {$channels != 1} {
    $snd convert -channels 1
  }
  # resample if necessary. NOTE: snack has very low quality resampling
  set rate [$snd cget -rate]
  set resamplingFlag ""
  if { $rate != $Info(samplingrate) } {
    if { $rate == 48000 } {
      set resamplingFlag "-48"
    } else {
      tk_messageBox -message "Warning: using low quality snack resampler. Check sampling rate to avoid this"
      $snd convert -rate $Info(samplingrate)
    }
  }

  $w messageProc "Running recognizer..."
  $snd write $Info(tmpfile).wav
  set fo [open $Info(tmpfile).lst "w"]
  puts $fo $Info(tmpfile).wav
  close $fo
  # create right flags depending on type of recognition
  if { $v(forcedflag) } {
    # read transcription
    set ortFileName [regsub {[^\.]*$} [file normalize [$w getInfo fileName]] $v(forcedext)]
    if {! [file exists $ortFileName]} {
      error "Missing orthographic transcription"
    }
    set fi [open $ortFileName "r"]
    set tran [regexp -all -inline {\S+} [string trim [read $fi]]]
    close $fi
    # read full dictionary if necessary
    if {! [info exists v($v(lang),fulldict)] } {
      set v($v(lang),fulldict) [readDictionary [file join $Info(dir) asr $v(lang) full.dic]]
    }
    array set fagram [TranscriptionToJuliusGrammar $tran $v($v(lang),fulldict)]
    set fo [open $Info(tmpfile).dict "w"]
    puts $fo $fagram(dict)
    close $fo
    set fo [open $Info(tmpfile).dfa "w"]
    puts $fo $fagram(gram)
    close $fo
    # -v $Info(tmpfile).dict 
    set v(lm) ""
    set v(dic) ""
    set v(dfabn) $Info(tmpfile)
    set grammarFlags "-gram $v(dfabn)"
  } else {
    switch [file extension $v(grammarType)] {
      .lm {
	set v(lm) [file join $Info(dir) asr $v(lang) $v(grammarType)]
	set v(dic) [regsub {.lm$} $v(lm) {.dict}]
	set v(dfabn) ""
	set grammarFlags "-d $v(lm) -v $v(dic)"
      }
      .dfa {
	set v(lm) ""
	set v(dic) ""
	set v(dfabn) [file join $Info(dir) asr $v(lang) [regsub {.dfa$} $v(grammarType) {}]]
	set grammarFlags "-gram $v(dfabn)"
      }
      default {
	set v(lm) ""
	set v(dic) ""
	set v(dfabn) ""
	set grammarFlags ""
      }	
    }
    #set asrcommand "$Info(asrexe) -walign -palign $resamplingFlag"
  }
  if { $grammarFlags != "" } {
    set asrcommand "$Info(asrexe) $commonFlags $grammarFlags -fallback1pass -palign $resamplingFlag"
    # for debugging
    puts "$asrcommand"
    if {[catch {eval exec $asrcommand} ret]} {

      # User probably aborted this computation (or an error occurred)
      if {(![regexp {1 files processed} $ret]) || ([regexp {search failed} $ret])} {
	$w messageProc "Recognition Failed"
	error "Recognition Failed, more details below\n\n$ret"
      }
    } else {
      $w messageProc "Done recognizing"
    }

    # get feature extraction parameters
    array set feParams [getJuliusParameters $ret]

    # convert julius results into transcription data
    set juliusTrans [getJuliusTranscription $ret $v(translevel)]
    set trans [juliusTransToWavesurfer $juliusTrans $feParams(windowSize) $feParams(frameShift) 0]
    set i 0
    set map {}
    set theend 0
    foreach row [split $trans \n] {
      if {[scan $row {%f %f %s %f} start end label score] >= 3} {
	set u(t1,$i,end) $end
	set u(t1,$i,label) $label
	set u(t1,$i,rest) $score
	if {$i == 0} {
	  set u(t1,start) $start
	}
	lappend map $i
	incr i
      }
    }
    set u(t1,end) $end
    set u(nLabels) $i
    set u(map) $map
    set u(header) ""
    set u(headerFmt) WaveSurfer
    puts "u(nLabels) = $u(nLabels)"

    # add background color in case
    if {$v(confidenceflag) && $v(translevel) == "word"} {
      set cmscores [getJuliusCMScores $ret]
      puts "cmscores $cmscores"
      for {set i 0} {$i<$u(nLabels)} {incr i} {
	puts "cmscore [lindex $cmscores $i]"
	set u(t1,$i,bgColor) [format #%04X%04X%04X [expr int((1.0-[lindex $cmscores $i])*65535)] 0 0]
      }
    } else {
      for {set i 0} {$i<$u(nLabels)} {incr i} {
	set u(t1,$i,bgColor) $u(bdColor)
      }
    }
  }
}


# Draw asr result info in a given pane.

proc asr::_drawAsr {w pane} {

  ::wsurf::trans::redraw $w $pane
  upvar [namespace current]::${pane}::var v
  upvar ::wsurf::trans::${pane}::var u

  # add confidence specific background colors
  set c [$pane canvas]
  for {set i 0} {$i<$u(nLabels)} {incr i} {
    $c itemconfigure lab$i -fill $u(t1,$i,bgColor)
  }
  set v(drawAsr) 1
}


# -----------------------------------------------------------------------------
# This procedure is called whenever the widget needs to redraw all panes.
# For example, when the user zooms.

proc asr::redraw {w pane} {
  upvar [namespace current]::${pane}::var v

  if {$v(drawAsr)} {
    _drawAsr $w $pane
  }
}


# -----------------------------------------------------------------------------
# This procedure is called whenever the widget needs to know the limits
# of the information this plug-in shows in this particular pane.
# Typically returns a list: start_time min_value end_time max_value

# proc asr::getBounds {w pane} {
#   upvar [namespace current]::${pane}::var v

#   if {$v(drawAsr)} {
#     set snd [$w cget -sound]
#     list 0 0 [$snd length -unit seconds] 0
#   } else {
#     list
#   }
# }


# -----------------------------------------------------------------------------
# This procedure is called whenever the cursor is moved within the widget.

# proc asr::cursorMoved {w pane time value} {
#   upvar [namespace current]::${pane}::var v

#   if {$v(drawAsr)} {
#     set i [expr {int($time*100 + .5)}]
#     set pitch [lindex $v(pitchList) $i]
#     if {$pitch == ""} return
#     if {$pitch != 0.0} {
#       set str "voiced segment"
#     } else {
#       set str "unvoiced segment"
#     }
#     $w messageProc [format "HVite - %s %s" [$w formatTime $time] $str]
#   }
# }


# -----------------------------------------------------------------------------
# This procedure is called whenever the properties dialog is opened for
# this pane. It adds the tab "Asr" and calls asr::drawAsrPage
# to render the properties notebook-page.

proc asr::propertyPane {w pane} {
  upvar [namespace current]::${pane}::var v
  
  if {$pane==""} return
  if {$v(drawAsr)} {
    return [list "ASR" [namespace code drawAsrPage]]
#    return [list "ASR" [namespace code drawAsrPage] "ASR Adv" [namespace code drawAsrAdvancedPage]]
  }
}

# This procedure is called when the user clicks "OK" or "Apply" in the 
# "Asr" notebook-page.

proc asr::applyProperties {w pane} {
  if {[string match *wavebar $pane]} return
  variable Info
  upvar [namespace current]::${pane}::var v

  if {[info exists v(drawAsr)]} {
    if {$v(drawAsr)} {
      foreach {option var default} $Info(OptionTable) {
	if {[string compare $v(t,$var) $v($var)] != 0} {
	  set v($var) $v(t,$var)
	  set doRedraw 1
	}
      }
      if {[info exists doRedraw]} {
        _computeAsr $w $pane
        _drawAsr $w $pane
	#$w _redrawPane $pane
      }
    }
  }
}

proc asr::fileChooserEntry {w label var ext} {
    set types "{ \
	{{$label} {$ext} } \
	{{All Files} * } \
		 }"

  pack [ttk::frame $w] -anchor w -ipady 2
  
  label $w.l -text $label -anchor w -wi 15
  entry $w.e -textvariable $var -wi 25
  button $w.b -text Browse... -command [namespace code "set $var \[tk_getOpenFile -defaultextension $ext -filetypes $types\]"] 
    
  pack $w.l $w.e $w.b -side left -padx 3
}

# this is used to update comboboxes dynamically when the Language is changed
proc asr::updateComboboxes {langcombobox destExtList} {
  variable Info

  set lang [$langcombobox get]
  foreach {destcombobox extensions} $destExtList {
    set destFiles [glob -directory [file join $Info(dir) asr $lang] *.$extensions]
    set destValues {}
    foreach destFile $destFiles {
      lappend destValues [lindex [file split $destFile] end]
    }
    $destcombobox configure -values $destValues
    $destcombobox set [lindex $destValues 0]
  }
}

# This procedure draws the properties notebook-page for the "Asr" tab.
proc asr::drawAsrPage {w pane p} {
  variable Info
  upvar [namespace current]::${pane}::var v

  set credits ""

  foreach f [winfo children $p] {
    destroy $f
  }

  #foreach var [list lang amfn grammarType translevel confidenceflag forcedflag forcedext]
  foreach {option var default} $Info(OptionTable) {
    set v(t,$var) $v($var)
  }

  set languageConfFiles [glob -nocomplain -directory [file join $Info(dir) asr] [file join * lang.conf]]
  set v(availableLanguages) {}
  foreach langConfFile $languageConfFiles {
    set langName [lindex [file split $langConfFile] end-1]
    lappend v(availableLanguages) $langName
    set fh [open $langConfFile "r"]
    set langcredits [read $fh]
    close $fh
    set credits "$credits\nCredits for $langName language pack\n\n$langcredits\n"
  }
  if [llength $v(availableLanguages)]==0 {
      tk_messageBox -title "Missing Language Packs" -message "At least one language pack muse be installed. Check http://www.speech.kth.se/asr/ for more details"
    return
  }
  # if current language no longer in the list, switch to first in list
  if [lsearch -exact $v(availableLanguages) $v(t,lang)]==-1 {
    set firstlang [lindex $v(availableLanguages) 0]
    set v(t,lang) $firstlang
    set v(t,cfg) "$Info(dir)/asr/$firstlang/julius.jconf"
  }

  pack [ttk::frame $p.f1] -anchor w
  ttk::label $p.f1.l -text "ASR Language:" -width 20 -anchor w
  ttk::combobox $p.f1.om -textvariable [namespace current]::${pane}::var(t,lang) -values $v(availableLanguages) -state readonly -width 33
  pack $p.f1.l $p.f1.om -side left -padx 3

  pack [ttk::frame $p.f1_5] -anchor w
  ttk::label $p.f1_5.l -text "Acoustic Models:" -width 20 -anchor w
  ttk::combobox $p.f1_5.om -textvariable [namespace current]::${pane}::var(t,amfn) -values $v(availableLanguages) -state readonly -width 33
  pack $p.f1_5.l $p.f1_5.om -side left -padx 3

  #updateCombobox $p.f1.om $p.f1_5.om "mmf"
  # change the values of $p.f2.om dynamically based on the selection in $p.f1.om
  # find a way to send $p.f2.om instead of .props.nb.asr.f2.om
  #bind $p.f1.om <<ComboboxSelected>> [namespace code {updateCombobox %W .props.nb.asr.f1_5.om "mmf"}]

  pack [ttk::frame $p.f2] -anchor w
  ttk::label $p.f2.l -text "Grammar type:" -width 20 -anchor w
  #ttk::combobox $p.f2.om -textvariable [namespace current]::${pane}::var(t,grammarType) -values {digits 1kwords 1Mwords} -state readonly
  ttk::combobox $p.f2.om -textvariable [namespace current]::${pane}::var(t,grammarType) -state readonly -width 33
  pack $p.f2.l $p.f2.om -side left -padx 3

  updateComboboxes $p.f1.om [list $p.f1_5.om "mmf" $p.f2.om "\{lm,dfa\}"]
  # change the values of $p.f2.om dynamically based on the selection in $p.f1.om
  # find a way to send $p.f2.om instead of .props.nb.asr.f2.om
  bind $p.f1.om <<ComboboxSelected>> [namespace code {updateComboboxes %W [list .props.nb.asr.f1_5.om "mmf" .props.nb.asr.f2.om "\{lm,dfa\}"]}]

  pack [ttk::frame $p.f3] -anchor w
  ttk::label $p.f3.l -text "Transcription level:" -width 20 -anchor w
    ttk::combobox $p.f3.om -textvariable [namespace current]::${pane}::var(t,translevel) -values {word phoneme} -state readonly -width 33
  pack $p.f3.l $p.f3.om -side left -padx 3

  pack [ttk::frame $p.f4] -anchor w
  ttk::label $p.f4.l -text "Show confidence:" -anchor w
  ttk::checkbutton $p.f4.om -variable [namespace current]::${pane}::var(t,confidenceflag)
  pack $p.f4.om $p.f4.l -side left -padx 0

  pack [ttk::separator $p.f5 -orient horizontal] -anchor w -fill x

  pack [ttk::frame $p.f6] -anchor w
  ttk::label $p.f6.l -text "Forced alignment:" -width 30 -anchor w
  ttk::checkbutton $p.f6.om -variable [namespace current]::${pane}::var(t,forcedflag)
  pack $p.f6.om $p.f6.l -side left -padx 0

  pack [ttk::frame $p.f7] -anchor w
  ttk::label $p.f7.l -text "Orthographic transcription extension:" -width 30 -anchor w
  ttk::entry $p.f7.om -textvariable [namespace current]::${pane}::var(t,forcedext)
  pack $p.f7.l $p.f7.om -side left -padx 3

  pack [ttk::separator $p.f6sep -orient horizontal] -anchor w -fill x

  pack [ttk::frame $p.f8] -anchor w
  ttk::button $p.f8.b1 -text Credits -command [list tk_messageBox -title "About ASR Plugin" -message $Info(credits) -detail $credits]
  pack $p.f8.b1 -side left -padx 3


#  foreach var [list onColor offColor] {
#    set v(t,$var) $v($var)
#  }

# colorPropItem $p.f1 "Voiced segment color:" 23 \
#     [namespace current]::${pane}::var(t,onColor)
# colorPropItem $p.f2 "Unvoiced segment color:" 23 \
#     [namespace current]::${pane}::var(t,offColor)


}

proc asr::drawAsrAdvancedPage {w pane p} {
  variable Info
  upvar [namespace current]::${pane}::var v

  foreach f [winfo children $p] {
    destroy $f
  }

  foreach var [list cfg lm dic dfa mmf lst extraargs inspen] {
    set v(t,$var) $v($var)
  }

  fileChooserEntry $p.f1 "Config File:" [namespace current]::${pane}::var(t,cfg) .cfg
  pack [ttk::frame $p.f2] -anchor w -ipady 2
  label $p.f2.l -text "Statistical Language Models:" -anchor w -wi 30
  pack $p.f2.l -side left -padx 3
  fileChooserEntry $p.f3 "N-gram File (.lm):" [namespace current]::${pane}::var(t,lm) .lm
  fileChooserEntry $p.f4 "Dictionary (.dict):" [namespace current]::${pane}::var(t,dic) .dict
  pack [ttk::frame $p.f5] -anchor w -ipady 2
  label $p.f5.l -text "Regular Grammar (.dfa, .dict, .term):" -anchor w -wi 30
  pack $p.f5.l -side left -padx 3
  fileChooserEntry $p.f6 "DFA File:" [namespace current]::${pane}::var(t,dfa) .dfa
  fileChooserEntry $p.f7 "Acoustic Models File:" [namespace current]::${pane}::var(t,mmf) .mmf
  fileChooserEntry $p.f8 "Acoustic Models List:" [namespace current]::${pane}::var(t,lst) .lst
    
  pack [ttk::frame $p.f10] -anchor w -ipady 2
  label $p.f10.l -text "Insertion Penalty" -anchor w -wi 15
  entry $p.f10.e -textvariable [namespace current]::${pane}::var(t,inspen) -wi 10
  pack $p.f10.l $p.f10.e -side left -padx 3

  pack [ttk::frame $p.f11] -anchor w -ipady 2
  label $p.f11.l -text "Extra Arguments" -anchor w -wi 15
  entry $p.f11.e -textvariable [namespace current]::${pane}::var(t,extraargs) -wi 25
  pack $p.f11.l $p.f11.e -side left -padx 3

  pack [ttk::frame $p.f12] -anchor w -ipady 2
  label $p.f12.l -text "Current Command:" -anchor w -wi 15
  pack $p.f12.l -side left -padx 3
  pack [ttk::frame $p.f13] -anchor w -ipady 2
  text $p.f13.t -width 60 -height 4
  $p.f13.t insert 1.0 "$Info(asrexe) -C $v(cfg) -nosectioncheck -hlist $v(lst) -input stdin -d $v(lm) -v $v(dic) -h $v(mmf) -fallback1pass -spsegment < $Info(tmpfile).wav" 

  $p.f13.t configure -state disabled
  pack $p.f13.t -side left -padx 3
}


# -----------------------------------------------------------------------------
# This procedure returns the code needed to re-create this pane.

proc asr::getConfiguration {w pane} {
 variable Info
 upvar [namespace current]::${pane}::var v
 
 set result {}
 if {$pane != "" && $v(drawAsr)} {
  append result "\$widget asr::addAsrStuff \$pane"
  
  foreach {option key default} $Info(OptionTable) {
   if {$v($key) != $default} {
    append result " $option \"$v($key)\""
   }
  }
 }
 append result "\n"
 
 return $result
}


# -----------------------------------------------------------------------------
# This procedure is called whenever the sound of this widget has changed.
# For example, after a record operation.

proc asr::soundChanged {w flag} {
  foreach pane [$w _getPanes] {
    upvar [namespace current]::${pane}::var v
    if {$v(drawAsr)} {
puts "soundChanged redrawing pane $pane"

      _computeAsr $w $pane
      _drawAsr $w $pane
      # $w _redrawPane $pane
    }
  }
}