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