1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2;;;                                                                       ;;
3;;;                   Carnegie Mellon University and                      ;;
4;;;                Centre for Speech Technology Research                  ;;
5;;;                     University of Edinburgh, UK                       ;;
6;;;                       Copyright (c) 1998-2001                         ;;
7;;;                        All Rights Reserved.                           ;;
8;;;                                                                       ;;
9;;;  Permission is hereby granted, free of charge, to use and distribute  ;;
10;;;  this software and its documentation without restriction, including   ;;
11;;;  without limitation the rights to use, copy, modify, merge, publish,  ;;
12;;;  distribute, sublicense, and/or sell copies of this work, and to      ;;
13;;;  permit persons to whom this work is furnished to do so, subject to   ;;
14;;;  the following conditions:                                            ;;
15;;;   1. The code must retain the above copyright notice, this list of    ;;
16;;;      conditions and the following disclaimer.                         ;;
17;;;   2. Any modifications must be clearly marked as such.                ;;
18;;;   3. Original authors' names are not deleted.                         ;;
19;;;   4. The authors' names are not used to endorse or promote products   ;;
20;;;      derived from this software without specific prior written        ;;
21;;;      permission.                                                      ;;
22;;;                                                                       ;;
23;;;  THE UNIVERSITY OF EDINBURGH, CARNEGIE MELLON UNIVERSITY AND THE      ;;
24;;;  CONTRIBUTORS TO THIS WORK DISCLAIM ALL WARRANTIES WITH REGARD TO     ;;
25;;;  THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY   ;;
26;;;  AND FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF EDINBURGH, CARNEGIE ;;
27;;;  MELLON UNIVERSITY NOR THE CONTRIBUTORS BE LIABLE FOR ANY SPECIAL,    ;;
28;;;  INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER          ;;
29;;;  RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN  AN ACTION   ;;
30;;;  OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF     ;;
31;;;  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.       ;;
32;;;                                                                       ;;
33;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
34;;;
35;;;  Cluster Unit selection support (Black and Taylor Eurospeech '97)
36;;;
37;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
38;;;
39;;;  Run-time support, selection and synthesis and some debugging functions
40;;;
41;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
42
43(require_module 'clunits)
44
45(defvar cluster_synth_pre_hooks nil)
46(defvar cluster_synth_post_hooks nil)
47
48(defvar clunits_time time)  ;; some old voices might use this
49
50(defSynthType Cluster
51    (apply_hooks cluster_synth_pre_hooks utt)
52    (Clunits_Select utt)
53    (Clunits_Get_Units utt)
54    (Clunits_Join_Units utt)
55    (apply_hooks cluster_synth_post_hooks utt)
56    utt
57)
58
59(define (Clunits_Join_Units utt)
60  "(Clunits_Join_Units utt)
61Join the preselected and gotten units into a waveform."
62  (let ((join_method (get_param 'join_method clunits_params 'simple)))
63    ;; Choice of function to put them together
64    (cond
65     ((string-equal join_method 'windowed)
66      (Clunits_Windowed_Wave utt)
67      (clunits::fix_segs_durs utt))
68     ((string-equal join_method 'smoothedjoin)
69      (Clunits_SmoothedJoin_Wave utt)
70      (clunits::fix_segs_durs utt))
71     ((string-equal join_method 'none)
72      t)
73     ((string-equal join_method 'modified_lpc)
74      (defvar UniSyn_module_hooks nil)
75      (Param.def "unisyn.window_name" "hanning")
76      (Param.def "unisyn.window_factor" 1.0)
77      (Parameter.def 'us_sigpr 'lpc)
78      (mapcar
79       (lambda (u s)
80	 (item.set_feat s "source_end" (item.feat u "end")))
81       (utt.relation.items utt 'Unit)
82       (utt.relation.items utt 'Segment))
83      (us_unit_concat utt)
84      (if (not (member 'f0 (utt.relationnames utt)))
85	  (targets_to_f0 utt))
86      (if (utt.relation.last utt 'Segment)
87	  (set! pm_end (+ (item.feat (utt.relation.last utt 'Segment) "end")
88			  0.02))
89	  (set! pm_end 0.02))
90      (us_f0_to_pitchmarks  utt 'f0 'TargetCoef pm_end)
91      (us_mapping utt 'segment_single)
92      (us_generate_wave utt (Parameter.get 'us_sigpr)
93			'analysis_period))
94     ((string-equal join_method 'smoothed_lpc)
95;      (format t "smoothed_lpc\n")
96      (defvar UniSyn_module_hooks nil)
97      (Param.def "unisyn.window_name" "hanning")
98      (Param.def "unisyn.window_factor" 1.0)
99      (Parameter.def 'us_sigpr 'lpc)
100      (mapcar
101       (lambda (u s)
102	 (item.set_feat s "source_end" (item.feat u "end"))
103	 (item.set_feat s "unit_duration"
104			(- (item.feat u "seg_end") (item.feat u "seg_start")))
105	 )
106       (utt.relation.items utt 'Unit)
107       (utt.relation.items utt 'Segment))
108      (us_unit_concat utt)
109      (mapcar
110       (lambda (u s)
111	 (item.set_feat s "num_frames" (item.feat u "num_frames")))
112       (utt.relation.items utt 'Unit)
113       (utt.relation.items utt 'Segment))
114      (if (not (member 'f0 (utt.relationnames utt)))
115	  (targets_to_f0 utt))
116      (if (utt.relation.last utt 'Segment)
117	  (set! pm_end (+ (item.feat (utt.relation.last utt 'Segment) "end")
118			  0.02))
119	  (set! pm_end 0.02))
120      (us_f0_to_pitchmarks  utt 'f0 'TargetCoef pm_end)
121      (cl_mapping utt clunits_params)
122      (us_generate_wave utt (Parameter.get 'us_sigpr)
123			'analysis_period))
124     (t
125      (Clunits_Simple_Wave utt)))
126    utt
127  )
128)
129
130(define (clunits::units_selected utt filename)
131  "(clunits::units_selected utt filename)
132Output selected unitsfile indexes for each unit in the given utterance.
133Results saved in given file name, or stdout if filename is \"-\"."
134  (let ((fd (if (string-equal filename "-")
135		t
136		(fopen filename "w")))
137	(end 0)
138	(sample_rate
139	 (cadr (assoc 'sample_rate (wave.info (utt.wave utt))))))
140    (format fd "#\n")
141    (mapcar
142     (lambda (s)
143       (let ((dur (/ (- (item.feat s "samp_end")
144		      (item.feat s "samp_start"))
145		   sample_rate))
146	     (start (/ (item.feat s "samp_start") sample_rate)))
147	 (set! end (+ end dur))
148	 (format fd "%f 125 %s ; %s %10s %f %f %f\n"
149		 end
150		 (string-before (item.name s) "_")
151		 (item.name s)
152		 (item.feat s "fileid")
153		 (item.feat s "unit_start")
154		 (item.feat s "unit_middle")
155		 (item.feat s "unit_end"))
156	 ))
157     (utt.relation.items utt 'Unit))
158    (if (not (string-equal filename "-"))
159	(fclose fd))
160    t))
161
162(define (clunits::units_segs utt filename)
163  "(clunits::units_segs utt filename)
164Svaes the unit selections (alone) for display."
165  (let ((fd (if (string-equal filename "-")
166		t
167		(fopen filename "w")))
168	(end 0)
169	(sample_rate
170	 (cadr (assoc 'sample_rate (wave.info (utt.wave utt))))))
171    (format fd "#\n")
172    (mapcar
173     (lambda (s)
174       (let ((dur (/ (- (item.feat s "samp_end")
175		      (item.feat s "samp_start"))
176		   sample_rate))
177	     (start (/ (item.feat s "samp_start") sample_rate)))
178	 (set! end (+ end dur))
179	 (format fd "%f 125 %s \n"
180		 end
181		 (string-before (item.name s) "_")
182;		 (item.name s)
183		 )
184	 ))
185     (utt.relation.items utt 'Unit))
186    (if (not (string-equal filename "-"))
187	(fclose fd))
188    t))
189
190(define (clunits::fix_segs_durs utt)
191  "(clunits::fix_segs_durs utt)
192Takes the actual unit times and places then back on the segs."
193  (let ((end 0)
194	(sample_rate
195	 (cadr (assoc 'sample_rate (wave.info (utt.wave utt))))))
196    (mapcar
197     (lambda (u s)
198       (let ((dur (/ (- (item.feat u "samp_end")
199		      (item.feat u "samp_start"))
200		   sample_rate))
201	     (seg_start (/ (- (item.feat u "samp_seg_start")
202			    (item.feat u "samp_start"))
203			 sample_rate)))
204	 (if (item.prev s)
205	     (item.set_feat (item.prev s) "end"
206			    (+ (item.feat s "p.end") seg_start)))
207	 (set! end (+ end dur))
208	 (item.set_feat s "end" end)))
209     (utt.relation.items utt 'Unit)
210     (utt.relation.items utt 'Segment)
211     )
212    utt))
213
214(define (clunits::display utt)
215  "(clunits::display utt)
216Display utterance with emulabel.  Note this saves files in
217scratch/wav/ and scratch/lab/."
218  (let ((id "cl01"))
219    (utt.save.wave utt (format nil "scratch/wav/%s.wav" id))
220    (utt.save.segs utt (format nil "scratch/lab/%s.lab" id))
221    (system "cd scratch; emulabel ../etc/emu_lab cl01 &")
222    t))
223
224; (define (clunits::debug_resynth_units utt)
225;   "(clunits::debug_resynth_units utt)
226; Check each of the units in utt against the related label
227; files and re-synth with any given new boundaries.  Note this is
228; will only work if the segment still overlaps with its original and
229; also note that with a rebuild of the clunits db a complete different
230; set of units may be selected for this utterance."
231;   (let ()
232;     (mapcar
233;      (lambda (unit)
234;        (clunits::check_unit_boundaries unit))
235;      (utt.relation.items utt 'Unit))
236;     ;; This can't be done like this ...
237;     (Clunits_Get_Units utt)  ;; get unit signal/track stuff
238;     (Clunits_Join_Units utt) ;; make a complete waveform
239;     (apply_hooks cluster_synth_post_hooks utt)
240;     utt)
241; )
242
243(define (clunits::join_parameters utt)
244  "(clunits::join_parameters utt)
245Join selected paremeters (rather than the signal), used in F0 and
246Articulatory selection."
247  (let ((params nil)
248	(num_channels 0)
249	(num_frames 0 ))
250
251    (mapcar
252     (lambda (unit)
253       (set! num_frames
254	     (+ num_frames
255		(track.num_frames (item.feat unit "coefs"))))
256       (set! num_channels (track.num_channels (item.feat unit "coefs")))
257       (format t "coounting %d %d\n" num_frames num_channels)
258       )
259     (utt.relation.items utt 'Unit))
260
261    (set! params (track.resize nil 0 num_channels))
262
263    (mapcar
264     (lambda (unit)
265       (set! frames 0)
266       (format t "inserting \n")
267       (format t "%l %l %l %l %l\n"
268	       params (track.num_frames params)
269	       (item.feat unit "coefs") 0
270	       (track.num_frames (item.feat unit "coefs")))
271       (track.insert
272	params (track.num_frames params)
273	(item.feat unit "coefs") 0
274	(track.num_frames (item.feat unit "coefs")))
275       )
276     (utt.relation.items utt 'Unit))
277
278    (utt.relation.create utt "AllCoefs")
279    (set! coefs_item (utt.relation.append utt "AllCoefs"))
280    (item.set_feat coefs_item "name" "AllCoefs")
281    (item.set_feat coefs_item "AllCoefs" params)
282
283    utt
284))
285
286
287(provide 'clunits)
288