1#!/bin/sh 2# the next line restarts using wish \ 3exec wish8.4 "$0" "$@" 4 5# Prompted sentence recording application 6 7package require -exact snack 2.2 8 9set rate 16000 10snack::sound t -rate $rate 11snack::sound s -rate $rate 12 13 14# dbrec.tcl menus 15 16set m [menu .menu] 17$m add cascade -label File -menu $m.file -underline 0 18menu $m.file -tearoff 0 19$m.file add command -label "New session..." -command [list NewSession] 20$m.file add command -label "Open script..." -command [list OpenScriptFile] 21$m.file add command -label "Database browser..." -command [list OpenBrowser] 22$m.file add command -label "Show speaker info..." -command OpenSpeakerDialog 23$m.file add command -label "Exit" -command exit 24$m add cascade -label Audio -menu $m.audio -underline 0 25menu $m.audio -tearoff 0 26$m.audio add command -label "Mixer..." -command snack::mixerDialog 27. config -menu $m 28 29 30# Initialize some global variables 31 32set needsave 0 33set replay 0 34set feedback 1 35set fontsize 20 36set prompt "Please load a recording script and start a new session" 37set ::name "" 38set ::imax 0 39 40 41# Draw waveform and prompt boxes 42 43pack [canvas .c -height 80 -width 1000 -relief sunken -bd 3] 44.c create waveform 0 0 -sound s -height 80 -width 1000 -limit 32768 -tags wave 45pack [frame .f2 -relief sunken -bd 3] -pady 15 46pack [label .f2.l1 -text Prompt: -anchor w] -fill x 47pack [label .f2.l2 -textvar prompt -font "Helvetica $fontsize bold"] \ 48 -expand yes -fill x 49 50 51# Buttons, time, and level meter 52 53snack::createIcons 54pack [frame .f1] -pady 5 55button .f1.bp -bitmap snackPlay -width 40 -command Play -state disabled 56#button .f1.bu -bitmap snackPause -command Pause 57#button .f1.bs -bitmap snackStop -command Stop 58button .f1.br -bitmap snackRecord -width 40 -fg red -state disabled 59button .f1.pr -text Prev -command Prev -state disabled 60button .f1.ne -text Next -command Next -state disabled 61frame .f1.cbf 62checkbutton .f1.cbf.be -text replay -variable replay -anchor w 63checkbutton .f1.cbf.bf -text feedback -variable feedback -command ToggleGraphics\ 64 -anchor w 65label .f1.time -text "00:00.0" -width 10 66snack::levelMeter .f1.lm -width 20 -length 200 67label .f1.level -textvariable level 68 69# Arrow key descriptions 70 71frame .f1.f 72grid [frame .f1.f.g] 73grid [label .f1.f.g.lc -text <Space>=Play -relief raised -bd 3] -row 2 \ 74 -column 1 -padx 20 75grid [label .f1.f.g.lu -text <Up>=Record -relief raised -bd 3] -row 1 -column 3 76grid [label .f1.f.g.ll -text <Left>=Prev -relief raised -bd 3] -row 2 -column 2 77grid [label .f1.f.g.ld -text <Down>=Stop -relief raised -bd 3] -row 2 -column 3 78grid [label .f1.f.g.lr -text <Right>=Next -relief raised -bd 3] -row 2 \ 79 -column 4 80 81pack .f1.cbf.be .f1.cbf.bf -fill x 82pack .f1.bp .f1.br .f1.pr .f1.ne .f1.cbf .f1.time .f1.lm .f1.level \ 83 .f1.f -side left 84bind .f1.br <ButtonPress-1> Record 85bind .f1.br <ButtonRelease-1> Stop 86 87 88# Database browser 89 90frame .db -relief raised -bd 3 91pack [label .db.l -text "Note! Recording is disabled when the database browser is displayed."] 92pack [frame .db.f0] -expand true -fill x 93pack [label .db.f0.l1 -text Session: -anchor w] -side left -fill x \ 94 -expand true 95pack [label .db.f0.l2 -text Sentence: -anchor w] -side left -fill x \ 96 -expand true 97pack [frame .db.f1] -expand true -fill both 98pack [listbox .db.f1.l1 -yscrollcommand [list .db.f1.s1 set]] \ 99 -side left -fill both -expand true 100pack [scrollbar .db.f1.s1 -orient vertical -command [list .db.f1.l1 yview]] \ 101 -side left -fill y 102pack [listbox .db.f1.l2 -yscrollcommand [list .db.f1.s2 set]] \ 103 -side left -fill both -expand true 104pack [scrollbar .db.f1.s2 -orient vertical -command [list .db.f1.l2 yview]] \ 105 -side left -fill y 106bind .db.f1.l1 <ButtonRelease-1> BrowseSession 107bind .db.f1.l2 <ButtonRelease-1> BrowseSentence 108pack [button .db.f1.b -text Goto -command Goto] -side left 109 110pack [frame .db.f2] 111pack [button .db.f2.b -text Save -command SaveTrans] -side right 112pack [entry .db.f2.e -width 100 -textvariable ::editprompt] -side right 113pack [button .db.b -text "Hide" -command CloseBrowser] 114 115 116# Message bar 117 118pack [frame .bf] -side bottom -fill x 119entry .bf.lab -font {Helvetica 18 bold} -textvar msg -width 1 \ 120 -relief sunken -bd 1 -state disabled 121pack .bf.lab -side left -expand yes -fill x 122 123wm protocol . WM_DELETE_WINDOW exit 124 125proc OpenBrowser {} { 126 wm geometry . {} 127 pack .db -before .bf -expand true -fill both 128 .f1.br configure -state disabled 129 bind . <KeyRelease-Up> {} 130 bind . <KeyPress-Down> {} 131} 132 133proc CloseBrowser {} { 134 wm geometry . {} 135 pack forget .db 136 .f1.br configure -state normal 137 bind . <KeyRelease-Up> Record 138 bind . <KeyPress-Down> Stop 139} 140 141proc BrowseSession {} { 142 set cur [.db.f1.l1 curselection] 143 if {$cur != ""} { 144 set ::bsession [lindex [split [.db.f1.l1 get $cur] :] 0] 145 set dir [format "sn%04d" $::bsession] 146 set filelist [lsort [glob -nocomplain [file join $dir sent???.wav]]] 147 .db.f1.l2 delete 0 end 148 foreach file $filelist { 149 .db.f1.l2 insert end $file 150 } 151 set ::msg "Recorded [llength $filelist]/$::imax" 152 } 153} 154 155proc BrowseSentence {} { 156 set cur [.db.f1.l2 curselection] 157 if {$cur != ""} { 158 s read [.db.f1.l2 get $cur] 159 SetTime [s length -unit sec] 160 if [catch {open [file rootname [.db.f1.l2 get $cur]].txt} in] { 161 set msg $in 162 } else { 163 set ::editprompt [lindex [split [read $in] \n] 0] 164 close $in 165 } 166 Play 167 } 168} 169 170proc SaveTrans {} { 171 set cur [.db.f1.l2 curselection] 172 if {$cur != ""} { 173 if [catch {open [file rootname [.db.f1.l2 get $cur]].txt w} out] { 174 error $out 175 } else { 176 puts $out $::editprompt 177 close $out 178 } 179 } 180} 181 182proc Goto {} { 183 CloseBrowser 184 if {![info exists ::bsession]} return 185 set ::session $::bsession 186 GetSpeakerInfo $::session 187 DoOpenScriptFile $::script 188 set ::dir [format "sn%04d" $::session] 189 set cur [.db.f1.l2 curselection] 190 if {$cur != ""} { 191 scan [.db.f1.l2 get $cur] "sn%d/sent%d" dummy n 192 set ::sentence $n 193 } else { 194 set ::sentence 1 195 } 196 set ::prompt $::prompts($::sentence) 197 GetSentence 198 if {$::sentence == $::imax} { 199 ConfigPrev normal 200 ConfigNext disabled 201 } elseif {$::sentence == 1} { 202 ConfigPrev disabled 203 ConfigNext normal 204 } else { 205 ConfigPrev normal 206 ConfigNext normal 207 } 208 wm title . "Session $::session ($::script)" 209 set ::msg "Session $::session, sentence 1/$::imax" 210} 211 212proc OpenSpeakerDialog {} { 213 set w .si 214 catch {destroy $w} 215 toplevel $w -class Dialog 216 GetSpeakerInfo $::session 217 pack [label $w.nl -text Name:] 218 pack [entry $w.ne -textvariable ::name -width 40] 219 pack [label $w.al -text Age:] 220 pack [entry $w.ae -textvariable ::age -width 4] 221 pack [label $w.rl -text Region:] 222 pack [entry $w.re -textvariable ::region -width 40] 223 pack [radiobutton $w.gf -text Female -value Female -variable ::gender] \ 224 -anchor w 225 pack [radiobutton $w.gm -text Male -value Male -variable ::gender] \ 226 -anchor w 227 pack [label $w.ol -text Other:] 228 pack [entry $w.oe -textvariable ::other -width 40] 229 pack [frame $w.bf -relief raised -bd 1] -expand yes -fill x 230 snack::makeDialogBox $w -title "Speaker information" -type ok 231 SaveSpeakerInfo 232} 233 234proc GetSpeakerInfo {n} { 235 set ::name "" 236 set ::age "" 237 set ::region "" 238 set ::gender Female 239 set ::other "" 240 set dir [format "sn%04d" $n] 241 catch {source [file join $dir info.txt]} 242} 243 244proc SaveSpeakerInfo {} { 245 set dir [format "sn%04d" $::session] 246 if {[catch {open [file join $dir info.txt] w} out]} { 247 error $out 248 } else { 249 puts $out "set ::name \"$::name\"" 250 puts $out "set ::age \"$::age\"" 251 puts $out "set ::region \"$::region\"" 252 puts $out "set ::gender \"$::gender\"" 253 puts $out "set ::other \"$::other\"" 254 puts $out "set ::script \"$::script\"" 255 close $out 256 } 257 catch {destroy .si} 258 set i 0 259 while {[lindex [split [.db.f1.l1 get $i] :] 0] < $::session} { 260 if {[.db.f1.l1 get $i] == ""} break 261 incr i 262 } 263 .db.f1.l1 delete $i 264 .db.f1.l1 insert $i "$::session: $::name, d $::script" 265} 266 267proc OpenScriptFile {} { 268 set types { 269 {{Script Files} {.scr}} 270 {{All Files} * } 271 } 272 set file [tk_getOpenFile -title "Open prompt file" -filetypes $types] 273 if {$file == ""} return 274 set ::script $file 275 if {$::name != ""} SaveSpeakerInfo 276 DoOpenScriptFile $file 277 wm title . "Session $::session ($::script)" 278 set msg "Session $::session, sentence 1/$::imax" 279 set ::sentence 1 280 GetSentence 281 ConfigNext normal 282 ConfigPrev disabled 283} 284 285proc SetTime {t} { 286 set mmss [clock format [expr int($t)] -format "%M:%S"] 287 .f1.time config -text $mmss.[format "%d" [expr int(10*($t-int($t)))]] 288} 289 290proc Update {} { 291 if {$::op == "p"} { 292 set t [audio elapsed] 293 set end [expr int([s cget -rate] * $t)] 294 set start [expr $end - [s cget -rate] / 10] 295 if {$start < 0} { set start 0} 296 if {$end >= [s length]} { set end -1 } 297 if {[s length] > 0 && $start < [s length]} { 298 if [catch {set l [s max -start $start -end $end]}] { 299 puts [s length],$start,$end 300 } 301 } else { 302 set l 0 303 } 304 } else { 305 set l [t max] 306 t length 0 307 set t [s length -unit sec] 308 SetTime $t 309 } 310 if {$::feedback} { 311 .f1.lm configure -level $l 312 } 313 314 after 100 Update 315} 316 317proc ToggleGraphics {} { 318 if {$::feedback} { 319 .c create waveform 0 0 -sound s -height 80 -width 1000 -limit 32768 -tags wave 320 } else { 321 .c delete wave 322 } 323} 324 325proc Record {} { 326 if {$::op == "r"} return 327 ConfigPrev disabled 328 ConfigNext disabled 329 s stop 330 s record 331 t record 332 set ::op r 333 set ::needsave 1 334 .f1.bp configure -relief raised 335# .f1.br configure -relief groove 336 .c itemconfig wave -fill darkgreen 337 if {$::feedback == 0} { 338 .c delete wave 339 } 340 341} 342 343proc Play {} { 344 t stop 345 s stop 346 s play -command Stop 347 set ::op p 348 .f1.bp configure -relief groove 349# .f1.br configure -relief raised 350 ConfigPrev disabled 351 ConfigNext disabled 352 # .f1.bu configure -relief raised 353} 354 355proc Stop {} { 356 if {$::op == "s"} return 357 s stop 358 t record 359 .f1.bp configure -relief raised 360# .f1.br configure -relief raised 361 362 if {[winfo ismapped .db] == 0} { 363 if {[info exists ::sentence] && $::sentence > 1} { 364 ConfigPrev normal 365 } 366 if {[info exists ::sentence] && $::sentence < $::imax} { 367 ConfigNext normal 368 } 369 } 370 if {$::op == "p"} { 371 set ::op s 372 if {[info exists ::sentence] && $::sentence == $::imax} { 373 tk_messageBox -message "The script is finished" 374 } 375 return 376 } 377 set ::op s 378 # .f1.bu configure -relief raised 379 if {[s length -unit sec] < 0.8} { 380 tk_messageBox -message "Note! Pressing the record button starts recording. Releasing it stops recording. You can not just click on it." -icon warning 381 return 382 } 383 set arg [expr {[s max] / 32767.0}] 384 if {$arg < 0.00001} { set arg 0.00001 } 385 set ::level [format "%.1fdB" [expr {20.0 * log($arg)}]] 386 if {[s max] < 10000} { 387 .c itemconfig wave -fill red 388 tk_messageBox -message "Low volume!" -icon warning 389 } 390 if {[s max] == 32767 || [s min] == -32768} { 391 .c itemconfig wave -fill red 392 tk_messageBox -message "Signal clipped!" -icon warning 393 } 394 if {$::feedback == 0} { 395 .c create waveform 0 0 -sound s -height 80 -width 1000 -limit 32768 -tags wave 396 } 397 if {$::needsave && [info exists ::dir]} { 398 s write [file join $::dir [format "sent%03d" $::sentence].wav] 399 if {[catch {open [file join $::dir [format "sent%03d" $::sentence].txt] \ 400 w} out]} { 401 error $out 402 } else { 403 puts $out $::prompt 404 close $out 405 } 406 set ::needsave 0 407 if {$::replay} { 408 Play 409 } else { 410 if {$::sentence == $::imax} { 411 tk_messageBox -message "The script is finished" 412 } 413 } 414 .menu.file entryconfigure "Open script..." -state disabled 415 } 416} 417 418proc Pause {} { 419 s pause 420 if {$::op != "s"} { 421 if {[.f1.bu cget -relief] == "raised"} { 422 .f1.bu configure -relief groove 423 } else { 424 .f1.bu configure -relief raised 425 } 426 } 427} 428 429proc GetSentence {} { 430 if {[info exists ::dir]} { 431 if {[file exists [file join $::dir [format "sent%03d" $::sentence].wav]]} { 432 s read [file join $::dir [format "sent%03d" $::sentence].wav] 433 SetTime [s length -unit sec] 434 } 435 } 436 set ::prompt $::prompts($::sentence) 437 set ::msg "Session $::session, sentence $::sentence/$::imax" 438 439 set size 20 440 while {[font measure "Helvetica $size bold" $::prompt] > 1024} { 441 incr size -2 442 } 443 .f2.l2 configure -font "Helvetica $size bold" 444} 445 446proc Next {} { 447 incr ::sentence 448 s flush 449 GetSentence 450 if {$::sentence == $::imax} { 451 ConfigNext disabled 452 } 453 ConfigPrev normal 454} 455 456proc Prev {} { 457 incr ::sentence -1 458 s flush 459 GetSentence 460 if {$::sentence == 1} { 461 ConfigPrev disabled 462 } 463 ConfigNext normal 464} 465 466proc DoOpenScriptFile {script} { 467 set i 1 468 if [catch {open $script} in] { 469 set ::msg $in 470 } else { 471 set promptfile [read $in] 472 close $in 473 foreach row [split $promptfile \n] { 474 if {$row != ""} { 475 set ::prompts($i) $row 476 incr i 477 } 478 } 479 set ::imax [expr $i - 1] 480 } 481 .f1.bp configure -state normal 482 bind . <space> Play 483 .f1.br configure -state normal 484 bind . <KeyRelease-Up> Record 485 bind . <KeyPress-Down> Stop 486} 487 488proc FirstSession {} { 489 set declist [lsort -decreasing $::dirlist] 490 if {$::dirlist != ""} { 491 set lastdir [lindex $declist 0] 492 set lastsession [string trimleft $lastdir sn0] 493 if {[llength [glob -nocomplain [file join $lastdir sent???.wav]]] > 0} { 494 incr lastsession 495 } 496 set ::session $lastsession 497 } else { 498 set ::session 1 499 } 500 incr ::session -1 501 # Uncomment to make Speaker window pop-op immediately 502 # NewSession 503} 504 505set ::next(normal) Next 506set ::next(disabled) "" 507set ::prev(normal) Prev 508set ::prev(disabled) "" 509 510proc ConfigNext { arg } { 511 .f1.ne configure -state $arg 512 bind . <Key-Right> $::next($arg) 513} 514 515proc ConfigPrev { arg } { 516 .f1.pr configure -state $arg 517 bind . <Key-Left> $::prev($arg) 518} 519 520proc NewSession {} { 521 set ::name "" 522 set ::age "" 523 set ::region "" 524 set ::gender Female 525 set ::other "" 526 incr ::session 527 set ::dir [format "sn%04d" $::session] 528 file mkdir $::dir 529 if {$::script != ""} { 530 set ::sentence 1 531 set ::prompt $::prompts($::sentence) 532 GetSentence 533 ConfigNext normal 534 ConfigPrev disabled 535 } 536 .menu.file entryconfigure "Open script..." -state normal 537 wm title . "Session $::session ($::script)" 538 set msg "Session $::session, sentence 1/$::imax" 539 update 540 OpenSpeakerDialog 541 # while {$::name == ""} OpenSpeakerDialog 542} 543 544# Create a list with all sessions so far 545 546set ::script "" 547set dirlist [lsort [glob -type d -nocomplain {sn[0-9][0-9][0-9][0-9]}]] 548foreach sn $dirlist { 549 set n [string trimleft $sn sn0] 550 GetSpeakerInfo $n 551 set l $script 552 if {[string length $l] > 30} { 553 set l ...[string range $l [expr {[string length $l]-30}] end] 554 } 555 .db.f1.l1 insert end "$n: $::name, $::l" 556} 557 558 559# Uncomment these lines to open default script at start-up 560#set script tests2.txt 561#DoOpenScriptFile $script 562 563 564# Uncomment these line to use built-in script 565#set script "Built-in" 566#set sentlist [list \ 567# "This is sentence one" \ 568# "This is sentence two" \ 569# "This is sentence three" \ 570# "This is sentence four" 571#] 572#set i 0 573#foreach sent $sentlist { set prompts([incr i]) $sent } 574#set ::imax $i 575#.f1.bp configure -state normal 576#.f1.br configure -state normal 577#bind . <KeyRelease-Up> Record 578#bind . <KeyPress-Down> Stop 579 580 581# Use session number specified on command line, otherwise use next slot 582 583if {[info exists argv] && $argv != ""} { 584 if {[string match "-b" [lindex $argv 0]]} { 585 OpenBrowser 586 set argv [lreplace $argv 0 0] 587 } 588 set session [lindex $argv end] 589 if {$session != ""} { 590 set ::dir [format "sn%04d" $session] 591 file mkdir $::dir 592 } 593} else { 594 FirstSession 595} 596 597t record 598set op s 599Update 600