rhubarb-lip-sync/rhubarb/lib/flite-1.4/tools/make_cg.scm

519 lines
19 KiB
Scheme

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; Language Technologies Institute ;;;
;;; Carnegie Mellon University ;;;
;;; Copyright (c) 2007-2009 ;;;
;;; All Rights Reserved. ;;;
;;; ;;;
;;; Permission is hereby granted, free of charge, to use and distribute ;;;
;;; this software and its documentation without restriction, including ;;;
;;; without limitation the rights to use, copy, modify, merge, publish, ;;;
;;; distribute, sublicense, and/or sell copies of this work, and to ;;;
;;; permit persons to whom this work is furnished to do so, subject to ;;;
;;; the following conditions: ;;;
;;; 1. The code must retain the above copyright notice, this list of ;;;
;;; conditions and the following disclaimer. ;;;
;;; 2. Any modifications must be clearly marked as such. ;;;
;;; 3. Original authors' names are not deleted. ;;;
;;; 4. The authors' names are not used to endorse or promote products ;;;
;;; derived from this software without specific prior written ;;;
;;; permission. ;;;
;;; ;;;
;;; CARNEGIE MELLON UNIVERSITY AND THE CONTRIBUTORS TO THIS WORK ;;;
;;; DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ;;;
;;; ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT ;;;
;;; SHALL CARNEGIE MELLON UNIVERSITY NOR THE CONTRIBUTORS BE LIABLE ;;;
;;; FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES ;;;
;;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN ;;;
;;; AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ;;;
;;; ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF ;;;
;;; THIS SOFTWARE. ;;;
;;; ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Author: Alan W Black (awb@cs.cmu.edu) ;;;
;;; Date: November 2007 ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; Convert a clustergen voice to flite ;;;
;;; ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Used for getting smaller models, if non-zero this will reduce the
;; order of the dumped models from whatever it is (probably 24) to this
;; It does the right thing with statics and dynamics and stddev
(defvar cg_reduced_order 0)
(if (> cg_reduced_order 0) ;; just to remind me
(format t "\n***** CG: note reducing order to %d *****\n\n"
cg_reduced_order))
(defvar F0MEAN 0.0)
(defvar F0STD 1.0)
(define (cg_convert name festvoxdir odir)
"(cg_convert name clcatfn clcatfnordered cltreesfn festvoxdir odir)
Convert a festvox clunits (processed) voice into a C file."
(load (format nil "%s/festvox/%s_cg.scm" festvoxdir name))
(eval (list (intern (format nil "voice_%s_cg" name))))
(set! ofd (fopen (path-append odir (string-append name "_cg.c")) "w"))
(format ofd "/*****************************************************/\n")
(format ofd "/** Autogenerated clustergen voice for %s */\n" name)
(format ofd "/*****************************************************/\n")
(format ofd "\n")
(format ofd "#include \"cst_string.h\"\n")
(format ofd "#include \"cst_cg.h\"\n")
(format ofd "#include \"cst_cart.h\"\n")
(format t "cg_convert: converting F0 trees\n")
;; F0 trees
(set! val_table nil) ;; different val number over the two sets of carts
(cg_convert_carts
(load (format nil "festival/trees/%s_f0.tree" name) t)
"f0" name odir)
(format ofd "\n")
(format ofd "extern const cst_cart * const %s_f0_carts[];\n" name )
;; spectral trees
(set! val_table nil) ;; different val number over the two sets of carts
(if cg:multimodel
(begin ;; MULTIMODAL
(format t "cg_convert: converting static spectral trees\n")
(set! mfd (fopen (path-append odir "paramfiles.mak") "w"))
(format mfd "PARAMMODEL=multimodel\n")
(fclose mfd)
(set! old_carttoC_extract_answer carttoC_extract_answer)
(set! carttoC_extract_answer carttoC_extract_spectral_frame)
(cg_convert_carts
(load (format nil "festival/trees/%s_mcep_static.tree" name) t)
"static_mcep" name odir)
(set! carttoC_extract_answer old_carttoC_extract_answer)
(format ofd "\n")
(format ofd "extern const cst_cart * const %s_static_mcep_carts[];\n" name )
;; spectral params
(format t "cg_convert: converting static spectral params\n")
(cg_convert_params
(format nil "festival/trees/%s_mcep_static.params" name)
(format nil "festival/trees/%s_min_range.scm" name)
name "static" odir ofd)
(format ofd "extern const unsigned short * const %s_static_model_vectors[];\n" name )
(set! val_table nil)
(format t "cg_convert: converting delta spectral trees\n")
(set! old_carttoC_extract_answer carttoC_extract_answer)
(set! carttoC_extract_answer carttoC_extract_spectral_frame)
(cg_convert_carts
(load (format nil "festival/trees/%s_mcep_delta.tree" name) t)
"delta_mcep" name odir)
(set! carttoC_extract_answer old_carttoC_extract_answer)
(format ofd "\n")
(format ofd "extern const cst_cart * const %s_delta_mcep_carts[];\n" name )
;; spectral params
(format t "cg_convert: converting delta spectral params\n")
(cg_convert_params
(format nil "festival/trees/%s_mcep_delta.params" name)
(format nil "festival/trees/%s_min_range.scm" name)
name "delta" odir ofd)
(format ofd "extern const unsigned short * const %s_delta_model_vectors[];\n" name )
)
(begin ;; SINGLE MODEL
(format t "cg_convert: converting single spectral trees\n")
(set! mfd (fopen (path-append odir "paramfiles.mak") "w"))
(format mfd "PARAMMODEL=single\n")
(fclose mfd)
(set! old_carttoC_extract_answer carttoC_extract_answer)
(set! carttoC_extract_answer carttoC_extract_spectral_frame)
(cg_convert_carts
(load (format nil "festival/trees/%s_mcep.tree" name) t)
"single_mcep" name odir)
(set! carttoC_extract_answer old_carttoC_extract_answer)
(format ofd "\n")
(format ofd "extern const cst_cart * const %s_single_mcep_carts[];\n" name )
;; spectral params
(format t "cg_convert: converting single spectral params\n")
(cg_convert_params
(format nil "festival/trees/%s_mcep.params" name)
(format nil "festival/trees/%s_min_range.scm" name)
name "single" odir ofd)
(format ofd "extern const unsigned short * const %s_single_model_vectors[];\n" name )
))
;; duration model (car conversion)
(format t "cg_convert: converting duration model\n")
(cg_convert_durmodel
(format nil "festvox/%s_durdata_cg.scm" name)
name odir)
(format ofd "extern const dur_stat * const %s_dur_stats[];\n" name)
(format ofd "extern const cst_cart %s_dur_cart;\n" name)
;; phone to states
(format t "cg_convert: converting phone to state map\n")
(cg_phone_to_states
(format nil "festvox/%s_statenames.scm" name)
name odir)
(format ofd "extern const char * const *%s_phone_states[];\n" name)
(format ofd "\n")
(format ofd "const char * const %s_types[] = {\n" name)
(mapcar
(lambda (cart)
(format ofd " \"%s\",\n" (car cart)))
(load (format nil "festival/trees/%s_f0.tree" name) t))
(format ofd " NULL};\n")
(format ofd "#define %s_num_types %d\n\n"
name
(length (load (format nil "festival/trees/%s_f0.tree" name) t)))
(format ofd "const float %s_model_min[] = { \n" name)
(mapcar
(lambda (p)
(format ofd " %f,\n" (car p)))
(reverse new_min_range))
(format ofd "};\n")
(format ofd "const float %s_model_range[] = { \n" name)
(mapcar
(lambda (p)
(format ofd " %f,\n" (cadr p)))
(reverse new_min_range))
(format ofd "};\n")
(format ofd "const float %s_dynwin[] = { -0.5, 0.0, 0.5 };\n" name)
(format ofd "#define %s_dynwinsize 3\n" name)
(if cg:mixed_excitation
(begin
(set! memf me_mix_filters)
(set! n 0)
(while (< n 5)
(format ofd "const double %s_me_filter_%d[] = {\n" name n)
(set! o 0)
(while (< o 47)
(format ofd "%f, " (car memf))
(set! memf (cdr memf))
(set! o (+ o 1)))
(format ofd "%f\n};\n" (car memf))
(set! memf (cdr memf))
(set! n (+ n 1))
)
(if memf
(format t "Error still %d values left in me_filter\n"
(length memf)))
(format ofd "const double * const %s_me_h[] = {\n" name)
(format ofd " %s_me_filter_0,\n" name)
(format ofd " %s_me_filter_1,\n" name)
(format ofd " %s_me_filter_2,\n" name)
(format ofd " %s_me_filter_3,\n" name)
(format ofd " %s_me_filter_4\n" name)
(format ofd "};\n\n")
))
(format ofd "const cst_cg_db %s_cg_db = {\n" name)
(format ofd " \"%s\",\n" name)
(format ofd " %s_types,\n" name)
(format ofd " %s_num_types,\n" name)
(format ofd " 16000,\n") ;; sample rate
(format ofd " %f,%f,\n" F0MEAN F0STD)
(format ofd " %s_f0_carts,\n" name)
(if cg:multimodel
(begin
(format ofd " %s_static_mcep_carts,\n" name)
(format ofd " %s_delta_mcep_carts,\n" name)
(format ofd " NULL,\n")
(format ofd " %s_static_num_channels,\n" name)
(format ofd " %s_static_num_frames,\n" name)
(format ofd " %s_static_model_vectors,\n" name)
(format ofd " %s_delta_num_channels,\n" name)
(format ofd " %s_delta_num_frames,\n" name)
(format ofd " %s_delta_model_vectors,\n" name)
(format ofd " 0,0,NULL,\n")
)
(begin
(format ofd " %s_single_mcep_carts,\n" name)
(format ofd " NULL,NULL,\n")
(format ofd " %s_single_num_channels,\n" name)
(format ofd " %s_single_num_frames,\n" name)
(format ofd " %s_single_model_vectors,\n" name)
(format ofd " 0,0,NULL,\n")
(format ofd " 0,0,NULL,\n")))
(format ofd " %s_model_min,\n" name)
(format ofd " %s_model_range,\n" name)
(format ofd " %f, /* frame_advance */\n" cg:frame_shift)
(format ofd " %s_dur_stats,\n" name)
(format ofd " &%s_dur_cart,\n" name)
(format ofd " %s_phone_states,\n" name)
(format ofd " 1, /* 1 if mlpg required */\n")
(format ofd " %s_dynwin,\n" name)
(format ofd " %s_dynwinsize,\n" name)
(format ofd " %f, /* mlsa_alpha */\n" mlsa_alpha_param)
(format ofd " %f, /* mlsa_beta */\n" mlsa_beta_param)
(if cg:multimodel
(format ofd " 1, /* cg:multimodel */\n")
(format ofd " 0, /* cg:multimodel */\n"))
(if cg:mixed_excitation
(begin
(format ofd " 1, /* cg:mixed_excitation */\n")
(format ofd " 5,48, /* filter sizes */\n")
(format ofd " %s_me_h \n" name))
(begin
(format ofd " 0, /* cg:mixed_excitation */\n")
(format ofd " 0,0, /* cg:mixed_excitation */\n")
(format ofd " NULL \n")))
(format ofd "};\n")
(fclose ofd)
)
(define (unit_type u)
(apply
string-append
(reverse
(symbolexplode
(string-after
(apply
string-append
(reverse (symbolexplode u)))
"_")))))
(define (unit_occur u)
(apply
string-append
(reverse
(symbolexplode
(string-before
(apply
string-append
(reverse (symbolexplode u)))
"_")))))
(define (cg_convert_durmodel durmodelfn name odir)
(set! durmodel (load durmodelfn t))
(set! phonedurs (cadr (car (cddr (car durmodel)))))
(set! zdurtree (cadr (car (cddr (cadr durmodel)))))
(set! dfd (fopen (path-append odir (string-append name "_cg_durmodel.c")) "w"))
(set! dfdh (fopen (path-append odir (string-append name "_cg_durmodel.h")) "w"))
(format dfd "/*****************************************************/\n")
(format dfd "/** Autogenerated durmodel_cg for %s */\n" name)
(format dfd "/*****************************************************/\n")
(format dfd "#include \"cst_synth.h\"\n")
(format dfd "#include \"cst_string.h\"\n")
(format dfd "#include \"cst_cart.h\"\n")
(format dfd "#include \"%s_cg_durmodel.h\"\n\n" name)
(mapcar
(lambda (s)
(format dfd "static const dur_stat dur_state_%s = { \"%s\", %f, %f };\n"
(cg_normal_phone_name (car s))
(car s) (car (cdr s)) (car (cddr s)))
)
phonedurs)
(format dfd "\n")
(format dfd "const dur_stat * const %s_dur_stats[] = {\n" name)
(mapcar
(lambda (s)
(format dfd " &dur_state_%s,\n" (cg_normal_phone_name (car s))))
phonedurs)
(format dfd " NULL\n};\n")
(set! val_table nil)
(set! current_node -1)
(set! feat_nums nil)
(do_carttoC dfd dfdh
(format nil "%s_%s" name "dur")
zdurtree)
(fclose dfd)
(fclose dfdh)
)
(define (cg_phone_to_states phonestatefn name odir)
(set! dfd (fopen (path-append odir (string-append name "_cg_phonestate.c")) "w"))
(format dfd "/*****************************************************/\n")
(format dfd "/** Autogenerated phonestate_cg for %s */\n" name)
(format dfd "/*****************************************************/\n")
(set! phonestates (load phonestatefn t))
(mapcar
(lambda (x)
(format dfd "const char * const %s_%s_ps[] = { " name
(cg_normal_phone_name (car x)))
(mapcar
(lambda (y) (format dfd "\"%s\", " y))
x)
(format dfd " 0};\n"))
(cadr (caddr (car phonestates))))
(format dfd "const char * const * const %s_phone_states[] = {\n" name)
(mapcar
(lambda (x)
(format dfd " %s_%s_ps,\n" name
(cg_normal_phone_name (car x))))
(cadr (caddr (car phonestates))))
(format dfd " 0};\n")
(fclose dfd)
)
(define (cg_convert_params mcepfn mcepminrangefn name type odir cofd)
(let ((param.track (track.load mcepfn))
(i 0) (mfd))
(set! mfd (fopen (path-append odir (string-append name "_cg_" type "_params.c")) "w"))
(format mfd "/*****************************************************/\n")
(format mfd "/** Autogenerated model_vectors for %s */\n" name)
(format mfd "/*****************************************************/\n")
(set! num_channels (track.num_channels param.track))
(set! num_frames (track.num_frames param.track))
;; Output each frame
(set! mcep_min_range (load mcepminrangefn t))
(while (< i num_frames)
(output_param_frame name type param.track i mfd)
(set! i (+ 1 i)))
(format mfd "\n\n")
;; Output each frame
(format mfd "const unsigned short * const %s_%s_model_vectors[] = {\n" name type)
(set! i 0)
(while (< i num_frames)
(format mfd " %s_%s_param_frame_%d,\n" name type i)
(set! i (+ 1 i)))
(format mfd "};\n\n")
(if (> cg_reduced_order 0)
(format cofd "#define %s_%s_num_channels %d\n"
name type (+ 4 (* 4 cg_reduced_order)))
(format cofd "#define %s_%s_num_channels %d\n" name type num_channels))
(format cofd "#define %s_%s_num_frames %d\n" name type num_frames)
(fclose mfd)
))
(define (mcepcoeff_norm c min range)
(* (/ (- c min) range) 65535))
(define (output_param_frame name type track f ofd)
"(output_param_frame name track frame ofd)
Ouput this frame."
(let ((i 0) (nc (track.num_channels track)))
(format ofd "static const unsigned short %s_%s_param_frame_%d[] = { \n" name type f)
(set! min_range mcep_min_range)
(set! real_order (/ (- nc 4) 4))
(set! new_min_range nil)
(while (< i nc)
(if (or (eq cg_reduced_order 0)
(< i (* 2 (+ 1 cg_reduced_order))) ;; static and static_stddev
(and (> i (- (/ nc 2) 1)) ;; deltas and delta_stddev
(< i (+ (/ nc 2) (* 2 cg_reduced_order))))
(> i (- nc 3)))
(begin
; (format t "i is %d %d\n" i (+ (/ nc 2) (* 2 cg_reduced_order)))
(format ofd " %d,"
(mcepcoeff_norm
(track.get track f i)
(caar min_range)
(cadr (car min_range))))
(set! new_min_range (cons (car min_range) new_min_range))
))
(set! min_range (cdr min_range))
(set! i (+ 1 i)))
(format ofd " };\n")
)
)
(define (carttoC_extract_spectral_frame ofdh tree)
"(carttoC_extract_spectral_frame tree)
Get list of answers from leaf node."
(carttoC_val_table ofdh
(car (car tree))
'none))
(define (cg_convert_carts carts prefix name odir)
"(define cg_convert_carts cartfn name)
Output cg selection carts into odir/name_carts.c"
(let (ofd ofdh)
;; Set up to dump full list of things at leafs
;; default processing of leaf (int or float) is fine
(set! ofd (fopen (format nil "%s/%s_cg_%s_trees.c" odir name prefix) "w"))
(set! ofdh (fopen (format nil "%s/%s_cg_%s_trees.h" odir name prefix) "w"))
(format ofd "/*****************************************************/\n")
(format ofd "/** Autogenerated %s %s carts */\n" name prefix)
(format ofd "/*****************************************************/\n")
(format ofd "\n")
(format ofd "#include \"cst_string.h\"\n")
(format ofd "#include \"cst_cart.h\"\n")
(format ofd "#include \"%s_cg_%s_trees.h\"\n" name prefix)
(mapcar
(lambda (cart)
(if (string-equal "string" (typeof (car cart)))
(begin
(set! current_node -1)
(set! feat_nums nil)
(do_carttoC ofd ofdh
(format nil "%s_%s_%s" name prefix
(cg_normal_phone_name (car cart)))
(cadr cart)))))
carts)
(format ofd "\n\n")
(format ofd "const cst_cart * const %s_%s_carts[] = {\n" name prefix)
(mapcar
(lambda (cart)
(if (string-equal "string" (typeof (car cart)))
(format ofd " &%s_%s_%s_cart,\n" name prefix
(cg_normal_phone_name (car cart))))
)
carts)
(format ofd " 0 };\n")
(fclose ofd)
(fclose ofdh)
)
)
(define (cg_normal_phone_name x)
;; Some phonenames aren't valid C labels
(cond
((string-matches x ".*@.*" x)
(intern
(string-append
(string-before x "@")
"atsign"
(string-after x "@"))))
((string-matches x ".*:.*")
(intern
(string-append
(string-before x ":")
"sc"
(string-after x ":"))))
(t x)))
(provide 'make_cg)