1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2;;;                                                                     ;;;
3;;;                     Carnegie Mellon University                      ;;;
4;;;                  and Alan W Black and Kevin Lenzo                   ;;;
5;;;                      Copyright (c) 1998-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;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
34;;;                                                                     ;;;
35;;; Support Code for building prosody models                            ;;;
36;;;                                                                     ;;;
37;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
38
39(defvar feat_float_types
40  '(segment_duration
41    lisp_zscore_dur
42    R:SylStructure.parent.syl_onsetsize
43    R:SylStructure.parent.syl_codasize
44    R:SylStructure.parent.R:Syllable.n.syl_onsetsize
45    R:SylStructure.parent.R:Syllable.p.syl_codasize
46    R:SylStructure.parent.parent.word_numsyls
47    pos_in_syl
48    R:SylStructure.parent.pos_in_word
49    R:SylStructure.parent.syl_in
50    R:SylStructure.parent.syl_out
51    R:SylStructure.parent.ssyl_in
52    R:SylStructure.parent.ssyl_out
53    R:SylStructure.parent.asyl_in
54    R:SylStructure.parent.asyl_out
55    R:SylStructure.parent.last_accent
56    R:SylStructure.parent.next_accent
57    R:SylStructure.parent.sub_phrases
58    syl_startpitch
59    syl_midpitch
60    syl_endpitch
61    syl_numphones
62    pos_in_word
63    syl_in
64    syl_out
65    ssyl_in
66    ssyl_out
67    sub_phrases
68    ))
69(defvar feat_int_types
70  '())
71
72
73(define (build_dur_feats_desc)
74  "(build_dur_feats_desc)
75Replaces the huge list of numbers in the dur.desc file with
76floats as appropriate."
77  (build_fix_desc_file "festival/dur/etc/dur.desc"))
78
79(define (build_f0_feats_desc)
80  "(build_f0_feats_desc)
81Replaces the huge list of numbers in the f0.desc file with
82floats as appropriate."
83  (build_fix_desc_file "festival/f0/etc/f0.desc"))
84
85(define (build_fix_desc_file descfile)
86  (let ((desc (car (load descfile t)))
87	(ofd (fopen descfile "w")))
88    (format ofd "(\n")
89    (mapcar
90     (lambda (fd)
91       (if (not (cddr fd))
92	   (set-cdr! fd (cons 'ignore)))
93       (cond
94	((member_string (car fd) feat_float_types)
95	 (set-cdr! fd (cons 'float)))
96	((member_string (car fd) feat_int_types)
97	 (set-cdr! fd (cons 'float)))
98	)
99       (format ofd "%l\n" fd)
100       t)
101     desc)
102    (format ofd ")\n")
103    (fclose ofd)))
104
105(define (finalize_dur_model modelname treename)
106  "(finalize_dur_model modelname treename)
107Take the tree and means/dur and create a scheme file which can
108be useds as a duration model."
109  (let ((ofd (fopen (format nil "festvox/%s_dur.scm" modelname) "w"))
110	(silence (car (cadr (car (PhoneSet.description '(silences)))))))
111    (if (string-matches modelname "^(.*")
112	(set! modelname (string-after modelname "(")))
113    (if (string-matches modelname ".*)$")
114	(set! modelname (string-before modelname ")")))
115    (format ofd ";; Duration models autotrained by festvox\n")
116    (format ofd ";; %s\n" treename)
117    (format ofd "(set! %s::phone_durs '\n" modelname)
118    (pprintf
119     (cons
120      (list silence 0.200 0.100)
121      (mapcar
122       (lambda (x)
123         (if (string-equal (car (cddr x)) "nan")
124             (list (car x) (cadr x) 0.001)
125             x)
126         )
127       (load "festival/dur/etc/durs.meanstd" t)))
128     ofd)
129    (format ofd ")\n")
130    (format ofd "\n\n")
131    ;; The tree wasn't trained with silence so we need to add that
132    (format ofd "(set! %s::zdur_tree '\n" modelname)
133    (format ofd "((name is %s)\n" silence)
134    (format ofd " ((p.R:SylStructure.parent.parent.pbreak is BB)\n")
135    (format ofd "  ((0.0 2.0))\n")
136    (format ofd "  ((0.0 0.0)))\n")
137    (pprintf
138     (car (load (format nil "festival/dur/tree/%s" treename) t)) ofd)
139    (format ofd ")\n")
140    (format ofd ")\n")
141    (format ofd "\n\n")
142    (format ofd "(provide '%s)\n" (string-append modelname "_dur"))
143    (format ofd "\n\n")
144    (fclose ofd)
145    )
146)
147
148(define (finalize_f0_model modelname treename)
149  "(finalize_f0_model modelname treename)
150Take the F0 trees and create a scheme file which can
151be used as a F0 model."
152  (let ((ofd (fopen (format nil "festvox/%s_f0.scm" modelname) "w")))
153    (format ofd ";; F0 models autotrained by festvox\n")
154    (format ofd ";; %s\n" treename)
155    (format ofd "(set! %s::start_f0 '\n" modelname)
156    (pprintf
157     (car (load (format nil "festival/f0/tree/start.%s" treename) t)) ofd)
158    (format ofd ")\n")
159    (format ofd "\n\n")
160
161    (format ofd "(set! %s::mid_f0 '\n" modelname)
162    (pprintf
163     (car (load (format nil "festival/f0/tree/mid.%s" treename) t)) ofd)
164    (format ofd ")\n")
165    (format ofd "\n\n")
166
167    (format ofd "(set! %s::end_f0 '\n" modelname)
168    (pprintf
169     (car (load (format nil "festival/f0/tree/end.%s" treename) t)) ofd)
170    (format ofd ")\n")
171    (format ofd "\n\n")
172    (format ofd "(provide '%s)\n" (string-append modelname "_f0"))
173    (format ofd "\n\n")
174    (fclose ofd)
175    )
176)
177
178(provide 'build_prosody)