SGC_ToneProt/SGC_ToneProt.tcl

   1 #!/bin/sh
   2 # the next line restarts using wish \
   3 exec wish8.4 "$0" "$@"
   4
   5 #tk_messageBox -message "Start"
   6
   7 package require -exact snack 2.2
   8
   9 set currentDirectory [pwd]
  10
  11 # Button and Label texts
  12 set ExampleTxt "Example"
  13 set NextTxt "Next sound"
  14 set PinyinTxt "Pinyin"
  15 set ClearTxt "Clear"
  16 set ShowTxt "Show"
  17 set QuitTxt "Quit"
  18
  19 set T1Txt "T1"
  20 set HzTxt "Hz"
  21 set FemaleTxt "Female"
  22 set MaleTxt "Male"
  23 set ChildTxt "Child"
  24 set SubmitTxt "Submit"
  25
  26 set WrongTxt "Wrong"
  27 set CorrectTxt "Correct"
  28 set InvalidTxt "Invalid"
  29 set TooLowTxt "You speak too low"
  30 set TooHighTxt "You speak too high"
  31 set TooWideTxt "Your range is too wide"
  32 set TooNarrowTxt "Your range is too narrow"
  33 set WordListTitleTxt "Open a pinyin word list (one word per line)"
  34
  35 # Initializations
  36 set RecordedSound 0
  37 set register 300
  38 set pinyin "duo1shao3"
  39 set ExamplePinyin $pinyin
  40 set precision 3
  41 set StandardWordList "SGC_protWordList.txt"
  42 set WordList {}
  43 # This list gets the files path as the second argument in the WordList file
  44 # It will force recognition of these files for debugging
  45 set AutoFileList {}
  46 set standardlogPerf 0
  47 set logPerf $standardlogPerf
  48
  49 if {[file readable $currentDirectory/lastResult.txt]} {
  50   set fileID [open $currentDirectory/lastResult.txt {RDONLY}]
  51   gets $fileID lastResult
  52   close $fileID
  53   set pinyin [lindex $lastResult 1]
  54   set ExamplePinyin $pinyin
  55   set register [lindex $lastResult 6]
  56   if {$register < 50 || $register > 900} {
  57     set register 300
  58   }
  59 }
  60
  61
  62 proc ReadWordList {filename} {
  63     global WordList
  64     global AutoFileList
  65     global currentSoundFileName
  66     global currentExampleFileName
  67     global pinyin
  68     global ExamplePinyin
  69     global logPerf
  70     global NextTxt
  71
  72     if {[file readable $filename]} {
  73         set WordList {}
  74         set AutoFileList {}
  75
  76         set f [open $filename]
  77         foreach line [split [read $f] \n] {
  78             if {[string length $line]} {
  79                 # Process log files
  80                 if {[llength $line] > 3} {
  81                     set directory ""
  82                     if {[regexp "logFile\.txt" $filename]} {set directory "log/"}
  83                     set line "[lindex $line 1] $directory[lindex $line end]"
  84                 }
  85                 # Also store any file names
  86                 if {[llength $line] > 1} {
  87                     lappend AutoFileList [lindex $line 1]
  88                 }
  89                 lappend WordList [lindex $line 0]
  90             }
  91         }
  92         close $f
  93         if {[llength $AutoFileList] > 0} {
  94             set logPerf 0
  95         }
  96
  97         # Pick first random word
  98         if {[llength $WordList] > 0} {
  99           set i [expr {int(rand()*[llength $WordList])}]
 100           set pinyin [lindex $WordList $i]
 101           if {[llength $AutoFileList] > 0} {
 102             set currentSoundFileName [lindex $AutoFileList $i]
 103             set currentExampleFileName $currentSoundFileName
 104             set ExamplePinyin $pinyin
 105             s configure -file $currentSoundFileName
 106             SetTime [s length -unit sec]
 107             .fa.b1 configure -text "$NextTxt"
 108           }
 109         }
 110     }
 111 }
 112
 113 ReadWordList "$currentDirectory/$StandardWordList"
 114
 115 # Where to find the files
 116 set standardSoundFileName "currentSound.wav"
 117 set currentSoundFileName $standardSoundFileName
 118 set standardExampleFileName "lastExample.wav"
 119 set currentExampleFileName $standardExampleFileName
 120
 121 set Platform $tcl_platform(os)
 122
 123 # Platform dependend commands
 124 switch $Platform {
 125 "Linux" {
 126 set PraatCommand "./praatLinux"
 127 set SendPraatCommand "./sendpraatLinux"
 128 set TimeOut 1000
 129 set PraatName "praatLinux"
 130     }
 131 "MacOS" {
 132 set PraatCommand "./praatMac"
 133 set SendPraatCommand "./sendpraatMac"
 134 set TimeOut 1000
 135 set PraatName "praatMac"
 136 }
 137 "Windows 95" -
 138 "Windows NT" -
 139 "Windows XP" -
 140 default {
 141     set PraatCommand "$currentDirectory/praatWin.exe"
 142     set SendPraatCommand "$currentDirectory/sendpraatWin.exe"
 143     set PraatName "Praat"
 144     set TimeOut 0
 145     }
 146 }
 147
 148 # Define commands
 149 # (watch out for trailing spaces)
 150 set QuitCommand        [list exec $SendPraatCommand "$PraatName" "Quit" "&"]
 151 if {$TimeOut > 0} {set QuitCommand [linsert $QuitCommand 2 $TimeOut]}
 152 set PlayExampleCommand [list exec $SendPraatCommand "$PraatName" "Read from file... \$currentDirectory/\$currentExampleFileName" "Play" "Remove" "&"]
 153 if {$TimeOut > 0} {set PlayExampleCommand [linsert $PlayExampleCommand 2 $TimeOut]}
 154 set HumToneCommand    [list exec $SendPraatCommand "$PraatName" {execute "$currentDirectory/HumToneContour.praat" $pinyin $register} "&"]
 155 if {$TimeOut > 0} {set HumToneCommand [linsert $HumToneCommand 2 $TimeOut]}
 156 set ShowToneCommand    [list exec $SendPraatCommand "$PraatName" {execute "$currentDirectory/DrawToneContour.praat" $pinyin $register} "&"]
 157 if {$TimeOut > 0} {set ShowToneCommand [linsert $ShowToneCommand 2 $TimeOut]}
 158 set RecognizeCommand   [list exec $SendPraatCommand "$PraatName" {execute "$currentDirectory/SGC_ToneProt.praat" "$currentDirectory/$currentSoundFileName" $pinyin $register $precision Hum $logPerf} ]
 159 if {$TimeOut > 0} {set RecognizeCommand [linsert $RecognizeCommand 2 $TimeOut]}
 160
 161 exec "$PraatCommand" "&"
 162
 163 # Start of Audio SNACK stuff
 164 file delete _tmprec.wav
 165 snack::sound t -debug 0
 166 t write _tmprec.wav
 167 snack::sound s -file _tmprec.wav -debug 0
 168
 169 # Menues
 170 set m [menu .menu]
 171 $m add cascade -label File -menu $m.file -underline 0
 172 menu $m.file -tearoff 0
 173 $m.file add command -label "Open..." -command [list OpenSound]
 174 $m.file add command -label "Save As..." -command [list SaveSound]
 175 $m.file add command -label "$QuitTxt" -command Destroy
 176
 177 $m add cascade -label Audio -menu $m.audio -underline 0
 178 menu $m.audio -tearoff 0
 179 $m.audio add command -label "Settings..." -command Settings
 180 $m.audio add command -label "Mixer..." -command snack::mixerDialog
 181
 182 $m add cascade -label Tools -menu $m.tools -underline 0
 183 menu $m.tools -tearoff 0
 184 $m.tools add command -label "Replay" -command ReplayLogFile
 185 $m.tools add command -label "Open word list..." -command GetWordList
 186 $m.tools add command -label "Close word list" -command CloseWordList
 187
 188 . config -menu $m
 189
 190 # UI frames
 191 pack [frame .fa] -pady 5
 192 button .fa.b1 -text "$ExampleTxt" -command PlayExample
 193 button .fa.b2 -text "$ShowTxt"  -command ShowTone
 194 label .fa.l1 -text "$PinyinTxt:"
 195 entry .fa.e1 -width 12 -relief sunken -bd 2 -textvariable pinyin
 196 button .fa.b3 -text "$ClearTxt" -command {set pinyin ""}
 197 button .fa.b4 -text "$QuitTxt"  -command Destroy
 198 pack .fa.b1 .fa.b2 .fa.l1 .fa.e1 .fa.b3 .fa.b4 -side left
 199
 200 pack [frame .fb] -pady 5
 201 label .fb.l1 -text "$T1Txt:"
 202 entry .fb.e1 -width 4 -relief sunken -bd 2 -textvariable register
 203 label .fb.l2 -text "$HzTxt"
 204 radiobutton .fb.r1 -text "$FemaleTxt" -variable register -value 300
 205 radiobutton .fb.r2 -text "$MaleTxt"   -variable register -value 200
 206 radiobutton .fb.r3 -text "$ChildTxt"   -variable register -value 450
 207 pack .fb.l1 .fb.e1 .fb.l2 .fb.r1 .fb.r2 .fb.r3 -side left
 208
 209
 210 snack::createIcons
 211
 212 pack [frame .f1] -pady 5
 213 button .f1.bp -bitmap snackPlay -command Play
 214 button .f1.bu -bitmap snackPause -command Pause
 215 button .f1.bs -bitmap snackStop -command Stop
 216 button .f1.br -bitmap snackRecord -command Record -fg red
 217 button .f1.b1 -text "$SubmitTxt" -command Recognize
 218 pack .f1.bp .f1.bu .f1.bs .f1.br .f1.b1 -side left
 219
 220 pack [frame .f2] -pady 5
 221 label .f2.time -text "00:00.0" -width 10
 222 snack::levelMeter .f2.lm
 223 pack .f2.time .f2.lm -side left
 224
 225 pack [frame .f5] -pady 5
 226 label .f5.l1 -text "-------"
 227 pack .f5.l1 -side left
 228
 229 pack [frame .f6] -pady 5
 230 label .f6.l1 -text ""
 231 pack .f6.l1 -side left
 232
 233
 234 wm protocol . WM_DELETE_WINDOW Destroy
 235
 236 # Procedure definitions
 237
 238 proc OpenSound {} {
 239     set filename [snack::getOpenFile]
 240     s configure -file $filename
 241     SetTime [s length -unit sec]
 242 }
 243
 244 proc SaveSound {} {
 245     set filename [snack::getSaveFile]
 246     s write $filename
 247 }
 248
 249 proc Settings {} {
 250  set ::s(rate) [s cget -rate]
 251  set ::s(enc)  [s cget -encoding]
 252  set ::s(chan) [s cget -channels]
 253
 254  set w .conv
 255  catch {destroy $w}
 256  toplevel $w
 257  wm title $w Settings
 258
 259  frame $w.q
 260  pack $w.q -expand 1 -fill both -side top
 261  pack [frame $w.q.f1] -side left -anchor nw -padx 3m -pady 2m
 262  pack [frame $w.q.f2] -side left -anchor nw -padx 3m -pady 2m
 263  pack [frame $w.q.f3] -side left -anchor nw -padx 3m -pady 2m
 264  pack [frame $w.q.f4] -side left -anchor nw -padx 3m -pady 2m
 265  pack [label $w.q.f1.l -text "Sample Rate"]
 266  foreach e [snack::audio rates] {
 267   pack [radiobutton $w.q.f1.r$e -text $e -value $e -variable ::s(rate)] \
 268           -anchor w
 269  }
 270  pack [entry $w.q.f1.e -textvariable ::s(rate) -width 6] -anchor w
 271  pack [label $w.q.f2.l -text "Sample Encoding"]
 272  foreach e [snack::audio encodings] {
 273   pack [radiobutton $w.q.f2.r$e -text $e -value $e -variable ::s(enc)] \
 274           -anchor w
 275  }
 276  pack [label $w.q.f3.l -text Channels]
 277  pack [radiobutton $w.q.f3.1 -text Mono -value 1 -variable ::s(chan)] -anchor w
 278  pack [radiobutton $w.q.f3.2 -text Stereo -value 2 -variable ::s(chan)] \
 279          -anchor w
 280  pack [entry $w.q.f3.e -textvariable ::s(chan) -width 3] -anchor w
 281
 282  pack [ frame $w.f3]
 283  pack [ button $w.f3.b1 -text OK -width 6 \
 284          -command "ApplySettings;destroy $w"] -side left
 285  pack [ button $w.f3.b2 -text Cancel -command "destroy $w"] -side left
 286 }
 287
 288 proc ApplySettings {} {
 289  s configure -file ""
 290  s configure -rate $::s(rate) -channels $::s(chan) -encoding $::s(enc)
 291  t configure -rate $::s(rate) -channels $::s(chan) -encoding $::s(enc)
 292  t write _tmprec.wav
 293  s configure -file _tmprec.wav
 294 }
 295
 296 proc SetTime {t} {
 297  set mmss [clock format [expr int($t)] -format "%M:%S"]
 298  .f2.time config -text $mmss.[format "%d" [expr int(10*($t-int($t)))]]
 299 }
 300
 301 proc Update {} {
 302  if {$::op == "p"} {
 303   set t [audio elapsed]
 304   set end   [expr int([s cget -rate] * $t)]
 305   set start [expr $end - [s cget -rate] / 10]
 306   if {$start < 0} { set start 0}
 307   if {$end >= [s length]} { set end -1 }
 308   set l [s max -start $start -end $end]
 309  } else {
 310   set l [t max]
 311   t length 0
 312   set t [s length -unit sec]
 313  }
 314  SetTime $t
 315  .f2.lm configure -level $l
 316
 317  after 100 Update
 318 }
 319
 320 proc Record {} {
 321  s stop
 322  s configure -file _tmprec.wav
 323  s record
 324  t record
 325  set ::op r
 326  .f1.bp configure -relief raised
 327  .f1.br configure -relief groove
 328
 329  global RecordedSound
 330  set RecordedSound 1
 331  }
 332
 333 proc GetWordList {} {
 334     global WordListTitleTxt
 335
 336     set filename [tk_getOpenFile -title "$WordListTitleTxt"]
 337     ReadWordList "$filename"
 338 }
 339
 340 proc ReplayLogFile {} {
 341     ReadWordList "logFile.txt"
 342 }
 343
 344 proc CloseWordList {} {
 345     global WordList
 346     global AutoFileList
 347     global currentSoundFileName
 348     global standardSoundFileName
 349     global currentExampleFileName
 350     global standardExampleFileName
 351     global logPerf
 352     global standardlogPerf
 353     global ExampleTxt
 354
 355     set WordList {}
 356     set AutoFileList {}
 357     set currentSoundFileName $standardSoundFileName
 358     set currentExampleFileName $standardExampleFileName
 359     set logPerf $standardlogPerf
 360
 361     .fa.b1 configure -text "$ExampleTxt"
 362 }
 363
 364 proc Recognize {} {
 365   global currentSoundFileName
 366   global currentExampleFileName
 367   global AutoFileList
 368   global register
 369   global pinyin
 370   global ExamplePinyin
 371   global precision
 372   global RecognizeCommand
 373   global currentDirectory
 374   global CorrectTxt
 375   global WrongTxt
 376   global WordList
 377   global TooHighTxt
 378   global TooLowTxt
 379   global TooWideTxt
 380   global TooNarrowTxt
 381   global logPerf
 382
 383   # Stop any recording etc
 384   Stop
 385
 386   set textColor blue
 387   set Evaluation "---------"
 388
 389   set currentDirectory [pwd]
 390   eval [subst $RecognizeCommand]
 391
 392   set ExamplePinyin $pinyin
 393   set fileID [open $currentDirectory/lastResult.txt {RDONLY}]
 394   gets $fileID lastResult
 395   close $fileID
 396   set Recognition [regsub -all {6} [lindex $lastResult 2] {?}]
 397
 398   set feedbackID [open $currentDirectory/feedback.txt {RDONLY}]
 399   gets $feedbackID lastFeedback
 400   close $feedbackID
 401
 402   if {[lindex $lastResult 0] == "Correct:"} {
 403     set Evaluation $CorrectTxt
 404     set textColor {dark green}
 405     set lastFeedback "----"
 406   } else {
 407     set Evaluation $WrongTxt
 408     set textColor {dark red}
 409   }
 410
 411   switch [lindex $lastResult 7] {
 412   "High" {set height $TooHighTxt}
 413   "Low"  {set height $TooLowTxt}
 414   default {set height ""}
 415   }
 416   switch [lindex $lastResult 8] {
 417   "Wide" {set range $TooWideTxt}
 418   "Narrow"  {set range $TooNarrowTxt}
 419   default {set range ""}
 420   }
 421
 422   # Skip result if spoken at wrong pitch and incorrect
 423   if {([lindex $lastResult 7] != "Low" && [lindex $lastResult 7] != "Narrow") || [lindex $lastResult 0] != "Wrong:"} {
 424     .f5.l1 configure -fg "$textColor" -text "$pinyin => $Evaluation: $Recognition"
 425   } else {
 426     .f5.l1 configure -fg "$textColor" -text "$pinyin"
 427   }
 428   .f6.l1 configure -fg "$textColor" -text "$lastFeedback"
 429
 430   if {[llength $WordList] > 0} {
 431         set i [expr {int(rand()*[llength $WordList])}]
 432         set pinyin [lindex $WordList $i]
 433         if {[llength $AutoFileList] > 0} {
 434             set currentSoundFileName [lindex $AutoFileList $i]
 435             set currentExampleFileName $currentSoundFileName
 436             set ExamplePinyin $pinyin
 437             s configure -file $currentSoundFileName
 438             SetTime [s length -unit sec]
 439         }
 440   }
 441 }
 442
 443 proc Destroy {} {
 444   global QuitCommand
 445
 446   eval [subst $QuitCommand]
 447   destroy .
 448 }
 449
 450 proc PlayExample {} {
 451   global currentExampleFileName
 452   global currentSoundFileName
 453   global PlayExampleCommand
 454   global HumToneCommand
 455   global register
 456   global pinyin
 457   global ExamplePinyin
 458   global currentDirectory
 459   # Stop any recording etc
 460   Stop
 461
 462   set currentDirectory [pwd]
 463
 464   if {$ExamplePinyin == $pinyin} {
 465     eval [subst $PlayExampleCommand]
 466      } else {
 467     eval [subst $HumToneCommand]
 468   }
 469
 470 }
 471
 472 proc ShowTone {} {
 473   global ShowToneCommand
 474   global register
 475   global pinyin
 476   global currentDirectory
 477   # Stop any recording etc
 478   Stop
 479
 480   set currentDirectory [pwd]
 481   eval [subst $ShowToneCommand]
 482
 483 }
 484
 485 #############
 486
 487 proc Play {} {
 488  t stop
 489  s stop
 490  s play -command Stop
 491  set ::op p
 492  .f1.bp configure -relief groove
 493  .f1.br configure -relief raised
 494  .f1.bu configure -relief raised
 495 }
 496
 497 proc Stop {} {
 498  s stop
 499  t record
 500  set ::op s
 501  .f1.bp configure -relief raised
 502  .f1.br configure -relief raised
 503  .f1.bu configure -relief raised
 504
 505  global RecordedSound
 506  if {$RecordedSound == 1} {
 507    global standardSoundFileName
 508    s write $standardSoundFileName
 509  }
 510  set RecordedSound 0
 511
 512 }
 513
 514 proc Pause {} {
 515  s pause
 516  if {$::op != "s"} {
 517      if {[.f1.bu cget -relief] == "raised"} {
 518          .f1.bu configure -relief groove
 519      } else {
 520          .f1.bu configure -relief raised
 521      }
 522  }
 523 }
 524
 525 t record
 526 set op s
 527 Update
 528