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