1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2;;; ;;; 3;;; Language Technologies Institute ;;; 4;;; Carnegie Mellon University ;;; 5;;; Copyright (c) 2000 ;;; 6;;; All Rights Reserved. ;;; 7;;; ;;; 8;;; Permission is hereby granted, free of charge, to use and distribute ;;; 9;;; this software and its documentation without restriction, including ;;; 10;;; without limitation the rights to use, copy, modify, merge, publish, ;;; 11;;; distribute, sublicense, and/or sell copies of this work, and to ;;; 12;;; permit persons to whom this work is furnished to do so, subject to ;;; 13;;; the following conditions: ;;; 14;;; 1. The code must retain the above copyright notice, this list of ;;; 15;;; conditions and the following disclaimer. ;;; 16;;; 2. Any modifications must be clearly marked as such. ;;; 17;;; 3. Original authors' names are not deleted. ;;; 18;;; 4. The authors' names are not used to endorse or promote products ;;; 19;;; derived from this software without specific prior written ;;; 20;;; permission. ;;; 21;;; ;;; 22;;; CARNEGIE MELLON UNIVERSITY AND THE CONTRIBUTORS TO THIS WORK ;;; 23;;; DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ;;; 24;;; ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT ;;; 25;;; SHALL CARNEGIE MELLON UNIVERSITY NOR THE CONTRIBUTORS BE LIABLE ;;; 26;;; FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES ;;; 27;;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN ;;; 28;;; AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ;;; 29;;; ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF ;;; 30;;; THIS SOFTWARE. ;;; 31;;; ;;; 32;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 33;;; Author: Alan W Black (awb@cs.cmu.edu) ;;; 34;;; Date: April 2001 ;;; 35;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36;;; ;;; 37;;; Convert festvox voice to flite ;;; 38;;; ;;; 39;;; clunits: catalogue, carts and param ;;; 40;;; ;;; 41;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 42 43 44(defvar lpc_min -2.709040) 45(defvar lpc_max 2.328840) 46(defvar mcep_min -5.404620) 47(defvar mcep_max 4.540220) 48 49(defvar page_size 500) ;; number of frames per page 50;;(set! page_size 1000000) ;; 1^6 means we do mmap 51 52(define (clunits_convert name clcatfnfileordered clcatfnunitordered 53 cltreesfn festvoxdir odir) 54 "(clunits_convert name clcatfn clcatfnordered cltreesfn festvoxdir odir) 55Convert a festvox clunits (processed) voice into a C file." 56 (clunitstoC clcatfnfileordered clcatfnunitordered name 57 (path-append festvoxdir "sts") 58 (path-append festvoxdir "mcep") 59 odir) 60 61 (set! ofd (fopen (path-append odir (string-append name "_clunits.c")) "a")) 62 63 (clunits_make_carts cltreesfn clcatfnunitordered name odir ofd) 64 65 (format ofd "\n\n") 66 (format ofd "static const int %s_join_weights[] = \n" name) 67 (format ofd " { 32768, 32768, 32768, 32768, 32768, 32768, 32768, 32768, 32768,\n") 68 (format ofd " 32768, 32768, 32768, 32768, 32768, 32768, 32768, 32768, 32768 };\n\n") 69 70 (format ofd "extern const cst_cart * const %s_carts[];\n" name ) 71 (format ofd "extern cst_sts_list %s_sts, %s_mcep;\n\n" name name ) 72 73 (format ofd "cst_clunit_db %s_db = {\n" name) 74 (format ofd " \"%s\",\n\n" name) 75 (format ofd " %s_unit_types,\n" name) 76 (format ofd " %s_carts,\n" name) 77 (format ofd " %s_units,\n\n" name) 78 79 (format ofd " %s_num_unit_types,\n" name) 80 (format ofd " %s_num_units,\n\n" name) 81 82 (format ofd " &%s_sts,\n\n" name) 83 84 (format ofd " &%s_mcep,\n\n" name) 85 86 (format ofd " %s_join_weights,\n\n" name) 87 (format ofd " 1, /* optimal coupling */\n") 88 (format ofd " 5, /* extend selections */\n") 89 (format ofd " 100, /* f0 weight */\n") 90 (format ofd " 0 /* unit_name function */\n") 91 92 (format ofd "};\n") 93 94 (fclose ofd) 95 96 ;; Duration model 97 (clunits_convert_durmodel 98 (format nil "%s/festvox/%s_durdata.scm" festvoxdir name) 99 name odir) 100) 101 102(define (unit_type u) 103 (apply 104 string-append 105 (reverse 106 (symbolexplode 107 (string-after 108 (apply 109 string-append 110 (reverse (symbolexplode u))) 111 "_"))))) 112 113(define (unit_occur u) 114 (apply 115 string-append 116 (reverse 117 (symbolexplode 118 (string-before 119 (apply 120 string-append 121 (reverse (symbolexplode u))) 122 "_"))))) 123 124(define (sort_clentries entries clcatfnunitorder) 125 (let ((neworder nil) (unittype nil) (q nil)) 126 (mapcar 127 (lambda (unit) 128 (set! unittype (string-before (car unit) "_")) 129 (set! q (assoc_string unittype entries)) 130 ;; only keep this unit if there is an actually tree -- 131 ;; in build3 (or other methods) it might have been pruned 132 (if q 133 (begin 134 (set! nnentry (assoc_string 135 (car unit) 136 (cdr (assoc_string unittype entries)))) 137; (format t "%s %l %l\n" unittype nnentry (assoc_string unittype entries)) 138 (set! neworder 139 (cons 140 nnentry 141 neworder))))) 142 (load clcatfnunitorder t)) 143 (format t "new order %d\n" (length neworder)) 144 (reverse neworder)) 145 ) 146 147(define (clunitstoC clcatfnfileordered clcatfnunitordered 148 name stsdir mcepdir odir) 149 "(clunitstoC clcatfnfileordered clcatfnunitordered name mcepdir stsdir odir) 150Convert a clunits catalogue and its sts representations into a 151compilable single C file." 152 (let 153 ((clindex (load clcatfnfileordered t)) 154 (lofdidx (fopen (path-append odir (string-append name "_lpc.c")) "w")) 155 (lofdh (fopen (path-append odir (string-append name "_lpc.h")) "w")) 156 (cofdidx (fopen (path-append odir (string-append name "_clunits.c")) "w")) 157 (cofdh (fopen (path-append odir (string-append name "_clunits.h")) "w")) 158 (mofdidx (fopen (path-append odir (string-append name "_mcep.c")) "w")) 159 (mofdh (fopen (path-append odir (string-append name "_mcep.h")) "w"))) 160 161 (format lofdidx "/*****************************************************/\n") 162 (format lofdidx "/** Autogenerated Clunits index for %s */\n" name) 163 (format lofdidx "/*****************************************************/\n") 164 (format lofdidx "\n") 165 (format lofdidx "#include \"cst_clunits.h\"\n") 166 (format lofdidx "#include \"%s_lpc.h\"\n" name) 167 (format mofdidx "/*****************************************************/\n") 168 (format mofdidx "/** Autogenerated Clunits index for %s */\n" name) 169 (format mofdidx "/*****************************************************/\n") 170 (format mofdidx "\n") 171 (format mofdidx "#include \"%s_mcep.h\"\n" name) 172 (format mofdidx "#include \"cst_clunits.h\"\n") 173 174 (set! pm_pos 0) 175 (set! sample_pos 0) 176 (set! times nil) 177; (set! clunits_entries nil) 178 (set! t_entries nil) 179 (set! done_files nil) 180 (set! num_unit_entries (length clindex)) 181 (set! residual_sizes nil) 182 183 (set! lpc_info nil) 184 (set! mcep_info nil) 185 186 (set! n page_size) 187 (set! f 0) 188 (while clindex 189 (if (equal? n page_size) 190 (begin 191 (if (> f 0) 192 (begin 193 (format lofdbitlpc " 0\n};\n\n") 194 (fclose lofdbitlpc) 195 (format lofdbitres " 0\n};\n\n") 196 (fclose lofdbitres) 197 (format mofdbitmcep " 0\n};\n\n") 198 (fclose mofdbitmcep) 199 )) 200 (set! lofdbitlpc 201 (if (equal? page_size 1000000) 202 (fopen (format nil "%s/%s_lpcall.c" odir name) "w") 203 (fopen (format nil "%s/%s_lpc_%03d.c" odir name f) "w"))) 204 205 (format lofdbitlpc 206 "const unsigned short %s_sts_lpc_page_%d[] = { \n" 207 name f ) 208 (format lofdh "extern const unsigned short %s_sts_lpc_page_%d[];\n" 209 name f ) 210 211 (set! lofdbitres 212 (if (equal? page_size 1000000) 213 (fopen (format nil "%s/%s_resall.c" odir name) "w") 214 (fopen (format nil "%s/%s_res_%03d.c" odir name f) "w"))) 215 (format lofdbitres 216 "const unsigned char %s_sts_res_page_%d[] = { \n" 217 name f ) 218 (format lofdh "extern const unsigned char %s_sts_res_page_%d[];\n" 219 name f ) 220 221 (set! mofdbitmcep 222 (if (equal? page_size 1000000) 223 (fopen (format nil "%s/%s_mcepall.c" odir name) "w") 224 (fopen (format nil "%s/%s_mcep_%03d.c" odir name f) "w"))) 225 (format mofdbitmcep 226 "const unsigned short %s_sts_mcep_page_%d[] = {\n" 227 name f ) 228 (format mofdh "extern const unsigned short %s_sts_mcep_page_%d[];\n" 229 name f ) 230 (set! n 0) 231 (set! lpc_page f) 232 (set! mcep_page f) 233 (set! lpc_page_pos 0) 234 (set! res_page_pos 0) 235 (set! mcep_page_pos 0) 236 (set! f (+ 1 f)))) 237 (set! n (+ 1 n)) 238 (set! pms (find_pm_pos 239 name 240 (car clindex) 241 stsdir 242 mcepdir 243 lofdbitlpc 244 lofdbitres 245 mofdbitmcep 246 )) 247 248 ;; Output unit_entry for this unit 249 (set! entry 250 (list 251 (nth 0 (car clindex)) 252 (nth 2 pms) ; start_pm 253 (nth 3 pms) ; phone_boundary_pm 254 (nth 4 pms) ; end_pm 255 (nth 5 (car clindex)) 256 (nth 6 (car clindex)) 257 )) 258 (set! q_entries (assoc_string (string-before (car entry) "_") t_entries)) 259 (if q_entries 260 (set-cdr! q_entries (cons entry (cdr q_entries))) 261 (set! t_entries 262 (cons 263 (list 264 (string-before (car entry) "_") 265 entry) 266 t_entries))) 267; (set! clunits_entries 268; (cons 269; (list 270; (nth 0 (car clindex)) 271; (nth 2 pms) ; start_pm 272; (nth 3 pms) ; phone_boundary_pm 273; (nth 4 pms) ; end_pm 274; (nth 5 (car clindex)) 275; (nth 6 (car clindex)) 276; ) 277; clunits_entries)) 278 (set! clindex (cdr clindex))) 279 280 (format t "Sorting cl entries\n") 281; (format t "%l\n" (caar t_entries)) 282; (format t "%l\n" (car t_entries)) 283 (set! clunits_entries 284 (sort_clentries t_entries clcatfnunitordered)) 285 (format t "End Sorting cl entries %d %d\n" 286 (length clunits_entries) 287 (length clcatfnunitordered) 288 ) 289 (format lofdidx "\n\n") 290 (format mofdidx "\n\n") 291 292 (begin ;; Close of last pages 293 (format lofdbitlpc " 0\n};\n\n") 294 (fclose lofdbitlpc) 295 (format lofdbitres " 0\n};\n\n") 296 (fclose lofdbitres) 297 (format mofdbitmcep " 0\n};\n\n") 298 (fclose mofdbitmcep) 299 ) 300 301 (if (equal? page_size 1000000) 302 (begin ;; mmap 303 (set! resofdidx (fopen (path-append odir (string-append name "_residx.c")) "w")) 304 (set! i 0) 305 (format resofdidx "const unsigned int %s_sts_residx[] = { \n" name) 306 (mapcar 307 (lambda (info) 308 (format 309 resofdidx " %d,\n" (nth 3 info)) 310 (set! i (+ 1 i))) 311 (reverse lpc_info)) 312 (format resofdidx " 0\n};\n\n") 313 (fclose resofdidx) 314 315 (set! resofdidx (fopen (path-append odir (string-append name "_ressize.c")) "w")) 316 (format resofdidx "const unsigned char %s_sts_ressize[] = { \n" name) 317 (mapcar 318 (lambda (info) 319 (format 320 resofdidx " %d,\n" (nth 2 info))) 321 (reverse lpc_info)) 322 (format resofdidx " 0\n};\n\n") 323 (fclose resofdidx) 324 325; (format lofdh "extern const unsigned int %s_sts_residx[];\n" name) 326; (format lofdh "extern const unsigned char %s_sts_ressize[];\n" name) 327 328 ) 329 (begin ;; normal paging 330 (format lofdidx "const cst_sts_paged %s_sts_paged_vals[] = { \n" name) 331 (set! i 0) 332 (mapcar 333 (lambda (info) 334 (format 335 lofdidx " {%d,%d,%d,%s_sts_lpc_page_%d,%s_sts_res_page_%d},\n" 336 (nth 1 info) (nth 2 info) (nth 3 info) 337 name (nth 0 info) 338 name (nth 0 info)) 339 (set! i (+ 1 i))) 340 (reverse lpc_info)) 341 (format lofdidx " { 0, 0, 0, 0, 0 }};\n\n") 342 )) 343 344 (format lofdidx "cst_sts_list %s_sts = {\n" name) 345 (format lofdidx " NULL, ") 346 (if (equal? page_size 1000000) 347 (begin 348 (format lofdidx " NULL,\n") 349; (format lofdidx " %s_sts_lpc_page_0,\n" name) 350; (format lofdidx " %s_sts_res_page_0,\n" name) 351; (format lofdidx " %s_sts_residx,\n" name) 352; (format lofdidx " %s_sts_ressize,\n" name) 353 (format lofdidx " NULL, NULL, NULL, NULL,\n") 354 ) 355 (begin 356 (format lofdidx " %s_sts_paged_vals,\n" name) 357 (format lofdidx " NULL, NULL, NULL, NULL,\n"))) 358 (format lofdidx " %d, /* number of frames */ \n" i) 359 (format lofdidx " %d, /* lpc order */ \n" lpc_order) 360 (format lofdidx " %d, /* sample rate */ \n" sample_rate) 361 (format lofdidx " %f, /* lpc min */ \n" lpc_min) 362 (format lofdidx " %f, /* lpc range */ \n" lpc_range) 363 (if (probe_file "flite/codec") 364 (set! codec (car (load "flite/codec" t))) 365 (set! codec "ulaw")) 366 (format lofdidx " \"%s\" /* residual codec */ \n" codec) 367 (format lofdidx "};\n\n") 368 369 (if (not (equal? page_size 1000000)) 370 (begin ;; mmap 371 (format mofdidx "const cst_sts_paged %s_mcep_paged_vals[] = { \n" name) 372 (set! i 0) 373 (mapcar 374 (lambda (info) 375 (format mofdidx " { %d, 0, 0, %s_sts_mcep_page_%d, 0 }, \n" 376 (nth 1 info) 377 name (nth 0 info)) 378 (set! i (+ 1 i))) 379 (reverse mcep_info)) 380 (format mofdidx " { 0, 0, 0 }};\n\n") 381 )) 382 383 (format mofdidx "cst_sts_list %s_mcep = {\n" name) 384 (format mofdidx " NULL, ") 385 (if (equal? page_size 1000000) 386 (begin 387 (format mofdidx " NULL,\n") 388; (format mofdidx " %s_sts_mcep_page_0,\n" name) 389; (format mofdidx " NULL,NULL,NULL,\n") 390 (format mofdidx " NULL, NULL, NULL, NULL,\n") 391 ) 392 (begin 393 (format mofdidx " %s_mcep_paged_vals,\n" name) 394 (format mofdidx " NULL, NULL, NULL, NULL,\n"))) 395 (format mofdidx " %d, /* number of frames */ \n" i) 396 (format mofdidx " %d, /* mcep order */ \n" mcep_order) 397 (format mofdidx " %d, /* sample rate */ \n" sample_rate) 398 (format mofdidx " %f, /* mcep min */ \n" mcep_min) 399 (format mofdidx " %f, /* mcep range */ \n" (- mcep_max mcep_min)) 400 (format mofdidx " NULL /* residual codec */ \n") 401 (format mofdidx "};\n\n") 402 403 (format cofdidx "/*****************************************************/\n") 404 (format cofdidx "/** Autogenerated Clunits index for %s */\n" name) 405 (format cofdidx "/*****************************************************/\n") 406 (format cofdidx "\n") 407 (format cofdidx "#include \"cst_clunits.h\"\n") 408 (format cofdidx "#include \"%s_clunits.h\"\n" name) 409 (format cofdidx "#include \"%s_cltrees.h\"\n" name) 410 411 (format cofdidx "\n\n") 412 (set! unitbase_count 0) 413 (set! unitbases nil) 414 (mapcar 415 (lambda (p) 416 (if (and (not (string-matches (car p) ".*#.*")) 417 (not (member_string (string-before (car p) "_") unitbases))) 418 (begin 419 (format cofdidx "#define unitbase_%s %d\n" 420 (clunits_normal_phone_name 421 (string-before (car p) "_")) 422 unitbase_count) 423 (set! unitbases (cons (string-before (car p) "_") unitbases)) 424 (set! unitbase_count (+ 1 unitbase_count))))) 425 clunits_entries) 426 (format cofdidx "\n\n") 427 428 (format cofdidx "const cst_clunit %s_units[] = { \n" name) 429 (set! num_entries 0) 430 (set! this_ut "") 431 (set! this_ut_count 0) 432 (set! unit_name_to_idx nil) 433 (set! all_unit_name_to_idx nil) 434 (mapcar 435 (lambda (e) 436 (if (not (string-equal this_ut (unit_type (nth 0 e)))) 437 (begin 438 (if (> this_ut_count 0) 439 (format cofdh "#define unit_%s_num %d\n" 440 (clunits_normal_phone_name this_ut) 441 this_ut_count)) 442 (format cofdh "#define unit_%s_start %d\n" 443 (clunits_normal_phone_name (unit_type (nth 0 e))) 444 num_entries) 445 (if unit_name_to_idx 446 (set! all_unit_name_to_idx 447 (cons 448 (reverse unit_name_to_idx) 449 all_unit_name_to_idx))) 450 (set! unit_name_to_idx (list (unit_type (nth 0 e)))) 451 (set! current_unit_start num_entries) 452 (set! this_ut (unit_type (nth 0 e))) 453 (set! this_ut_count 0) 454 )) 455 (format cofdh "#define unit_%s %d\n" 456 (clunits_normal_phone_name (nth 0 e)) num_entries) 457 ;; need to preserver name to idx number as some units might pruned 458 (set! unit_name_to_idx 459 (cons 460 (list (unit_occur (nth 0 e)) (- num_entries current_unit_start)) 461 unit_name_to_idx)) 462 (set! num_entries (+ 1 num_entries)) 463 (set! this_ut_count (+ 1 this_ut_count)) 464 (format cofdidx " { /* %s */ unit_type_%s, unitbase_%s, %d,%d, %s, %s },\n" 465 (nth 0 e) 466 (clunits_normal_phone_name (unit_type (nth 0 e))) 467 (clunits_normal_phone_name (string-before (nth 0 e) "_")) 468 (nth 1 e) ; start_pm 469 (nth 3 e) ; end_pm 470 (clunits_normal_phone_name (nth 4 e)) ; prev 471 (clunits_normal_phone_name (nth 5 e)) ; next 472 )) 473 clunits_entries) 474 (if unit_name_to_idx 475 (set! all_unit_name_to_idx 476 (cons 477 (reverse unit_name_to_idx) 478 all_unit_name_to_idx))) 479 (format cofdidx " { 0,0,0,0 } };\n\n") 480 (format cofdidx "#define %s_num_units %d\n" name num_entries) 481 (if (> this_ut_count 0) 482 (format cofdh "#define unit_%s_num %d\n" 483 this_ut this_ut_count)) 484 (fclose lofdh) 485 (fclose lofdidx) 486 (fclose mofdh) 487 (fclose mofdidx) 488 (fclose cofdh) 489 (fclose cofdidx) 490 )) 491 492(defvar sts_coeffs_fname nil) 493 494(define (find_pm_pos name entry stsdir mcepdir lofdlpc lofdres mofdmcep) 495 "(find_pm_pos entry lpddir) 496Diphone dics give times in seconds here we want them as indexes. This 497function converts the lpc to ascii and finds the pitch marks that 498go with this unit. These are written to ofdsts with ulaw residual 499as short term signal." 500 (let ((start_time (nth 2 entry)) 501 (phoneboundary_time (nth 3 entry)) 502 (end_time (nth 4 entry)) 503 start_pm pb_pm end_pm 504 (ltime 0)) 505 (format t "%l\n" entry) 506 (if (not (string-equal (cadr entry) sts_coeffs_fname)) 507 (begin 508 ;; Only load when when we have a new filename 509 (set! sts_coeffs 510 (load (format nil "%s/%s.sts" stsdir (cadr entry)) t)) 511 (set! mcep_coeffs 512 (load_ascii_track 513 (format nil "%s/%s.mcep" mcepdir (cadr entry)) 514 (nth 2 entry) ;; from this start time 515 )) 516 (set! sts_info (car sts_coeffs)) 517 (set! sts_coeffs (cdr sts_coeffs)) 518 (set! sts_coeffs_fname (cadr entry)) 519 )) 520 (set! ltime 0) 521 (set! size_to_now 0) 522 ;; Flip through the sts's and mceps to find the right one -- 523 (while (and sts_coeffs (cdr sts_coeffs) 524 (> (absdiff start_time (car (car sts_coeffs))) 525 (absdiff start_time (car (cadr sts_coeffs))))) 526 (set! ltime (car (car sts_coeffs))) 527 (set! mcep_coeffs (cdr mcep_coeffs)) 528 (set! sts_coeffs (cdr sts_coeffs))) 529 (set! sample_rate (nth 2 sts_info)) 530 (set! lpc_order (nth 1 sts_info)) 531 (set! lpc_min (nth 3 sts_info)) 532 (set! lpc_range (nth 4 sts_info)) 533 (set! start_pm pm_pos) 534 (while (and sts_coeffs (cdr sts_coeffs) 535 mcep_coeffs (cdr mcep_coeffs) 536 (> (absdiff phoneboundary_time (car (car sts_coeffs))) 537 (absdiff phoneboundary_time (car (cadr sts_coeffs))))) 538 (output_mcep name (car mcep_coeffs) mofdmcep) 539 (output_sts name (car sts_coeffs) (nth 1 entry) lofdlpc lofdres) 540 (set! mcep_coeffs (cdr mcep_coeffs)) 541 (set! sts_coeffs (cdr sts_coeffs))) 542 (set! pb_pm pm_pos) 543 (while (and sts_coeffs (cdr sts_coeffs) 544 mcep_coeffs (cdr mcep_coeffs) 545 (> (absdiff end_time (car (car sts_coeffs))) 546 (absdiff end_time (car (cadr sts_coeffs))))) 547 (output_mcep name (car mcep_coeffs) mofdmcep) 548 (output_sts name (car sts_coeffs) (nth 1 entry) lofdlpc lofdres) 549 (set! mcep_coeffs (cdr mcep_coeffs)) 550 (set! sts_coeffs (cdr sts_coeffs))) 551 (set! end_pm pm_pos) 552 553 (list 554 (car entry) 555 (cadr entry) 556 start_pm 557 pb_pm 558 end_pm))) 559 560(define (output_sts name frame fname ofdlpc ofdres) 561 "(output_sts frame residual ofd) 562Ouput this LPC frame." 563 (let ((time (nth 0 frame)) 564 (coeffs (nth 1 frame)) 565 (size (nth 2 frame)) 566 (r (nth 3 frame))) 567 (set! times (cons time times)) 568 569 (set! l_n lpc_page_pos) 570 (while coeffs 571 (format ofdlpc " %d," (car coeffs)) 572 (set! coeffs (cdr coeffs))) 573 (format ofdlpc "\n") 574 (set! lpc_page_pos (+ 1 lpc_page_pos)) ;; we know the frame size 575 576 (set! r_n res_page_pos) 577 (while r 578 (format ofdres " %d," (car r)) 579 (set! res_page_pos (+ 1 res_page_pos)) 580 (set! r (cdr r))) 581 (format ofdres "\n") 582 583 (set! lpc_info 584 (cons 585 (list lpc_page l_n size r_n) 586 lpc_info)) 587 (set! pm_pos (+ 1 pm_pos)) 588)) 589 590(define (lpccoeff_norm c) 591 (* (/ (- c lpc_min) (- lpc_max lpc_min)) 592 65535)) 593 594(define (mcepcoeff_norm c) 595 (* (/ (- c mcep_min) (- mcep_max mcep_min)) 596 65535)) 597 598(define (output_mcep name frame ofd) 599 "(output_mcep frame duration residual ofd) 600Ouput this MCEP frame." 601 (let ((i 0)) 602 (set! mcep_order (- (length frame) (+ 3 1))) 603 604 (set! frame (cddr frame)) ;; skip time and the "1" 605 (set! frame (cdr frame)) ;; skip the energy 606 (set! m_n mcep_page_pos) 607 (set! i 0) 608; (format ofd " %d," (mcepcoeff_norm (/ (car frame) 2))) 609; (set! frame (cdr frame)) 610 (while (< i mcep_order) 611 (format ofd " %d," (mcepcoeff_norm (car frame))) 612 (set! frame (cdr frame)) 613 (set! i (+ 1 i)) 614 ) 615 (format ofd "\n") 616 (set! mcep_page_pos (+ 1 mcep_page_pos)) 617 618 (set! mcep_info 619 (cons 620 (list mcep_page m_n) 621 mcep_info)) 622 623)) 624 625(define (load_ascii_track trackfilename starttime) 626 "(load_ascii_track trackfilename) 627Coverts trackfilename to simple ascii representation." 628 (let ((tmpfile (make_tmp_filename)) 629 (nicestarttime (if (> starttime 0.100) 630 (- starttime 0.100) 631 starttime)) 632 b) 633 (system (format nil "$ESTDIR/bin/ch_track -otype est -start %f %s | 634 awk '{if ($1 == \"EST_Header_End\") 635 header=1; 636 else if (header == 1) 637 printf(\"( %%s )\\n\",$0)}'>%s" 638 nicestarttime trackfilename tmpfile)) 639 (set! b (load tmpfile t)) 640 (delete-file tmpfile) 641 b)) 642 643 644(define (absdiff a b) 645 (let ((d (- a b ))) 646 (if (< d 0) 647 (* -1 d) 648 d))) 649 650(define (carttoC_extract_answer_list ofdh tree) 651 "(carttoC_extract_answer_list tree) 652Get list of answers from leaf node." 653; (carttoC_val_table ofdh 654; (car (last (car tree))) 655; 'none) 656; (format t "%l\n" (car tree)) 657 ;; These should be sorted first (which may or may not make a difference) 658 (cellstovals "cl" (mapcar car (caar tree)) ofdh) 659; (cellstovals 660; "cl" 661; (mapcar 662; (lambda (x) 663; (set! xxx (cadr (assoc_string (car x) (cdr current_unit_name_to_idx)))) 664; ) 665; (clunits_sort_candidates (caar tree))) 666; ofdh) 667 (format nil "cl_%04d" cells_count)) 668 669(define (sorted_cand_add cand s) 670 (cond 671 ((null s) (list cand)) 672 ((< (cadr cand) (cadr (car s))) 673 (cons cand s)) 674 (t 675 (cons (car s) 676 (sorted_cand_add cand (cdr s)))))) 677 678(define (clunits_sort_candidates cands) 679 (let ((s nil)) 680 (mapcar 681 (lambda (x) 682 (set! s (sorted_cand_add x s)) 683 ) 684 cands) 685 s 686 ) 687) 688 689(define (sort_cltrees trees clcatfn) 690 (let ((neworder nil) (ut nil)) 691 (mapcar 692 (lambda (unit) 693 (set! ut (unit_type (car unit))) 694 (if (not (assoc_string ut neworder)) 695 (set! neworder (cons (assoc_string ut trees) neworder)))) 696 (load clcatfn t)) 697 (reverse neworder))) 698 699(define (clunits_make_carts cartfn clcatfn name odir cofd) 700 "(define clunits_make_carts cartfn name) 701Output clunit selection carts into odir/name_carts.c" 702 (let (ofd ofdh) 703 ;; Set up to dump full list of things at leafs 704 (set! carttoC_extract_answer carttoC_extract_answer_list) 705 (load cartfn) 706 707 (set! ofd (fopen (format nil "%s/%s_cltrees.c" odir name) "w")) 708 (set! ofdh (fopen (format nil "%s/%s_cltrees.h" odir name) "w")) 709 (format ofd "\n") 710 (format ofd "#include \"cst_string.h\"\n") 711 (format ofd "#include \"cst_cart.h\"\n") 712 (format ofd "#include \"cst_regex.h\"\n") 713 (format ofd "#include \"%s_cltrees.h\"\n" name) 714 715 (set! val_table nil) 716 717 (format t "new order3 %d\n" (length clunits_selection_trees)) 718 (set! clunits_selection_trees (sort_cltrees clunits_selection_trees clcatfn)) 719 (format t "new order4 %d\n" (length clunits_selection_trees)) 720 721 (mapcar 722 (lambda (cart) 723 (set! current_node -1) 724 (set! feat_nums nil) 725 ;; The name to idx mapping (in case of pruning) 726 (set! current_unit_name_to_idx 727 (assoc_string (car cart) all_unit_name_to_idx)) 728; (format t "awb-debug current_unit_name_to_idx %l %l %d\n" (car cart) (car all_unit_name_to_idx) (length all_unit_name_to_idx)) 729 (do_carttoC ofd ofdh 730 (format nil "%s_%s" name 731 (clunits_normal_phone_name (car cart))) 732 (cadr cart))) 733 clunits_selection_trees) 734 735 (format ofd "\n\n") 736 (format ofd "const cst_cart * const %s_carts[] = {\n" name) 737 (mapcar 738 (lambda (cart) 739 (format ofd " &%s_%s_cart,\n" name 740 (clunits_normal_phone_name (car cart))) 741 ) 742 clunits_selection_trees) 743 (format ofd " 0 };\n") 744 745 (format cofd "\n\n") 746 (format cofd "#define %s_num_unit_types %d\n" 747 name (length clunits_selection_trees)) 748 749 (format cofd "\n\n") 750 (format cofd "const cst_clunit_type %s_unit_types[] = {\n" name) 751 (set! n 0) 752 (format t "new order2 %d\n" (length clunits_selection_trees)) 753 (mapcar 754 (lambda (cart) 755 (format ofdh "#define unit_type_%s %d\n" 756 (clunits_normal_phone_name (car cart)) n) 757 (format cofd " { \"%s\", unit_%s_start, unit_%s_num},\n" 758 (car cart) 759 (clunits_normal_phone_name (car cart) ) 760 (clunits_normal_phone_name (car cart)) ) 761 (set! n (+ 1 n)) 762 ) 763 clunits_selection_trees) 764 (format cofd " { NULL, CLUNIT_NONE, CLUNIT_NONE } };\n") 765 766 (fclose ofd) 767 (fclose ofdh) 768 769 ) 770) 771 772(define (clunits_convert_durmodel durmodelfn name odir) 773 774 (set! durmodel (load durmodelfn t)) 775 (set! phonedurs (cdr (cadr (car (cddr (car durmodel)))))) 776 (set! zdurtree (cadr (car (cddr (cadr durmodel))))) 777 778 (set! carttoC_extract_answer basic_carttoC_extract_answer) 779 780 (set! dfd (fopen (path-append odir (string-append name "_cl_durmodel.c")) "w")) 781 (set! dfdh (fopen (path-append odir (string-append name "_cl_durmodel.h")) "w")) 782 (format dfd "/*****************************************************/\n") 783 (format dfd "/** Autogenerated durmodel_cl for %s */\n" name) 784 (format dfd "/*****************************************************/\n") 785 786 (format dfd "#include \"cst_synth.h\"\n") 787 (format dfd "#include \"cst_string.h\"\n") 788 (format dfd "#include \"cst_cart.h\"\n") 789 (format dfd "#include \"%s_cl_durmodel.h\"\n\n" name) 790 791 (mapcar 792 (lambda (s) 793 (format dfd "static const dur_stat dur_state_%s = { \"%s\", %f, %f };\n" 794 (clunits_normal_phone_name (car s)) 795 (car s) (car (cdr s)) (car (cddr s))) 796 ) 797 phonedurs) 798 (format dfd "\n") 799 800 (format dfd "const dur_stat * const %s_dur_stats[] = {\n" name) 801 (mapcar 802 (lambda (s) 803 (format dfd " &dur_state_%s,\n" (clunits_normal_phone_name (car s)))) 804 phonedurs) 805 (format dfd " NULL\n};\n") 806 807 (set! val_table nil) 808 (set! current_node -1) 809 (set! feat_nums nil) 810 (do_carttoC dfd dfdh 811 (format nil "%s_%s" name "dur") 812 zdurtree) 813 814 (fclose dfd) 815 (fclose dfdh) 816) 817 818(define (clunits_normal_phone_name x) 819 ;; Some phonenames aren't valid C labels 820 (cond 821 ((string-matches x ".*@.*" x) 822 (intern 823 (string-append 824 (string-before x "@") 825 "atsign" 826 (string-after x "@")))) 827 ((string-matches x ".*#.*" x) 828 (intern 829 (string-append 830 (string-before x "#") 831 "hash" 832 (string-after x "#")))) 833 ((string-matches x ".*:.*") 834 (intern 835 (string-append 836 (string-before x ":") 837 "sc" 838 (string-after x ":")))) 839 (t x))) 840 841;;; 842;;; Usage count prune 843;;; 844 845(define (clunits_prune_tree tree units_used) 846 (let ((treey nil) (treen nil)) 847 (cond 848 ((cdr tree) ;; question 849 (format t "question %l\n" (car tree)) 850 (set! treey (clunits_prune_tree (car (cdr tree)) units_used)) 851 (set! treen (clunits_prune_tree (car (cddr tree)) units_used)) 852 (cond 853 ((null treen) 854 (format t "pruned whole cluster for n %l\n" (car tree)) 855 treey) 856 ((null treey) ;; nothing left 857 (format t "pruned whole cluster for y %l\n" (car tree)) 858 treen) ;; could be nil too, but higher level deals with it 859 (t 860 (list (car tree) treey treen)))) 861 (t ;; leaf 862 (let ((nn nil)) 863 (mapcar 864 (lambda (c) 865; (format t "checking %s in %l\n" (car c) units_used) 866 (if (member_string (car c) units_used) 867 (set! nn (cons c nn)) 868 (format t "pruning %s\n" (car c)) 869 )) 870 (caar tree)) 871 (if nn 872 (list (list (reverse nn) (cadr (car tree)))) 873 nil)))) 874 )) 875 876(define (clunits_prune treesfile units_used_file otreefile) 877 (load treesfile) 878 (set! units_used (load units_used_file t)) 879 (set! new_trees 880 (mapcar 881 (lambda (tree) 882 (format t "tree print %s\n" (car tree)) 883 (list 884 (car tree) 885 (clunits_prune_tree 886 (cadr tree) 887 (cdr (assoc_string (car tree) units_used))))) 888 clunits_selection_trees)) 889 890 (set! ofd (fopen otreefile "w")) 891 (format ofd "(set! clunits_selection_trees '(\n") 892 (mapcar 893 (lambda (x) ;; this is faster 894 (pprintf x ofd)) 895 new_trees) 896 (format ofd "))\n") 897 (fclose ofd) 898 899) 900 901(provide 'make_clunits) 902 903