ref: 2c59c1aaab0b520d3504188987056ff3702352ca
dir: /tools/make_cg.scm/
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; Language Technologies Institute ;;;
;;; Carnegie Mellon University ;;;
;;; Copyright (c) 2007-2017 ;;;
;;; 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 ;;;
;;; (Oct 2014) support for random forests ;;;
;;; (Jun 2017) support for quantized params ;;;
;;; ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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:relevant_params nil) ;; a list of param ranges to dump
(defvar cg_reduced_order 0)
(defvar cg:quantized_params t) ;; 8 bit quantized table
(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)
(defvar num_channels_additive_constant 4)
(defvar new_min_range nil)
(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))))
(if cg:quantized_params
(if cg:rfs_models
(system (format nil "$FLITEDIR/tools/quantize_params quantize_rf_models"))
(system (format nil "$FLITEDIR/tools/quantize_params find_segments_quant festival/trees/%s_mcep.params" 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 ofd "extern const cst_phoneset %s_phoneset;\n\n" name)
(format t "cg_convert: converting F0 trees\n")
;; F0 trees
(if (and cg:rfs_models (probe_file "rf_models/mlistf0"))
(set! f0ms (load "rf_models/mlistf0" t))
(set! f0ms (list '01)))
(if (and cg:rfs_models (probe_file "rf_models/mlistf0"))
(begin ;; Random Forest F0 Models
(format t "cg_convert: converting rf F0 trees\n")
(mapcar
(lambda (f0m)
(format t "cg_convert: converting model_%02d f0 params\n" f0m)
(set! val_table nil)
(cg_convert_carts
(load (format nil "rf_models/trees_%02d/%s_f0.tree" f0m name) t)
(format nil "%02d_f0" f0m) name odir)
(format ofd "extern const cst_cart * const %s_%02d_f0_carts[];\n" name f0m))
f0ms))
(begin ;; No-random Forest F0 Models (just one model)
(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)
"01_f0" name odir)
(format ofd "\n")
(format ofd "extern const cst_cart * const %s_01_f0_carts[];\n" name )))
(if cg:spamf0
(begin
(set! acctrack (track.load "festival/trees/cb.params"))
(format ofd "extern const cst_cart %s_spamf0_phrase_cart;\n" name)
(format ofd "extern const cst_cart %s_spamf0_accent_cart;\n" name)
(format ofd "extern const float * const %s_spamf0_accent_vectors[];\n" name)
(format ofd "#define %s_spamf0_accent_num_channels %d\n" name (track.num_channels acctrack))
(format ofd "#define %s_spamf0_accent_num_frames %d\n" name (track.num_frames acctrack))
))
;; spectral trees
(set! val_table nil) ;; different val number over the two sets of carts
(if cg:rfs_models
(set! pms (load "rf_models/mlist" t))
(set! pms (list '01)))
(if cg:rfs_models
(begin ;; Random Forest Spectral Models
(format t "cg_convert: converting rf spectral trees\n")
(mapcar
(lambda (pm)
(set! old_carttoC_extract_answer carttoC_extract_answer)
(set! carttoC_extract_answer carttoC_extract_spectral_frame)
(set! val_table nil)
(cg_convert_carts
(load (format nil "rf_models/trees_%02d/%s_mcep.tree" pm name) t)
(format nil "%02d_mcep" pm) name odir)
(set! carttoC_extract_answer old_carttoC_extract_answer)
(format ofd "\n")
(format ofd "extern const cst_cart * const %s_%02d_mcep_carts[];\n" name pm)
;; spectral params
(if cg:quantized_params
;; Quantized params use 8 bit indexs -- you
;; must externally create quantized params first
(cg_convert_params_quantized
(format nil "rf_models/trees_%02d/%s_mcep.params.q_params" pm name)
(format nil "rf_models/trees_%02d/%s_mcep.params.q_table" pm name)
name (format nil "%02d" pm) odir ofd)
(cg_convert_params
(format nil "rf_models/trees_%02d/%s_mcep.params" pm name)
(format nil "festival/trees/%s_min_range.scm" name)
name (format nil "%02d" pm) odir ofd))
(format ofd "extern const unsigned short * const %s_%02d_model_vectors[];\n" name pm ))
pms))
(begin ;; Non-random forest spectral models (one model)
(format t "cg_convert: converting single spectral trees\n")
(set! old_carttoC_extract_answer carttoC_extract_answer)
(set! carttoC_extract_answer carttoC_extract_spectral_frame)
(set! val_table nil)
(cg_convert_carts
(load (format nil "festival/trees/%s_mcep.tree" name) t)
"01_mcep" name odir)
(set! carttoC_extract_answer old_carttoC_extract_answer)
(format ofd "\n")
(format ofd "extern const cst_cart * const %s_01_mcep_carts[];\n" name )
;; spectral params
(if cg:quantized_params
(cg_convert_params_quantized
(format nil "festival/trees/%s_mcep.params.q_params" name)
(format nil "festival/trees/%s_mcep.params.q_table" name)
name "01" odir ofd)
(cg_convert_params
(format nil "festival/trees/%s_mcep.params" name)
(format nil "festival/trees/%s_min_range.scm" name)
name "01" odir ofd))
(format ofd "extern const unsigned short * const %s_01_model_vectors[];\n" name )
))
(if (probe_file (format nil "festvox/%s_char_phone_map.scm" name))
(begin
(setq cpm (load (format nil "festvox/%s_char_phone_map.scm" name) t))
(format ofd "\nstatic char * const %s_char_phone_map[%s][2] =\n"
name (+ 1 (length cpm)))
(format ofd "{\n")
(mapcar
(lambda (x)
(format ofd " { %l, \"%s\" },\n" (car x) (cadr x)))
cpm)
(format ofd " { NULL, NULL }\n")
(format ofd "};\n\n")
))
(format ofd "#define %s_num_f0_models %d\n" name (length f0ms))
(format ofd "const cst_cart **%s_f0_carts_table[] = {\n" name)
(mapcar
(lambda (f0m)
(format ofd " (const cst_cart **)%s_%02d_f0_carts,\n" name f0m))
f0ms)
(format ofd "NULL};\n")
(format ofd "#define %s_num_param_models %d\n" name (length pms))
(format ofd "int %s_num_channels_table[] = {\n" name)
(mapcar
(lambda (pm)
(format ofd " %s_%02d_num_channels,\n" name pm))
pms)
(format ofd "0};\n")
(format ofd "int %s_num_frames_table[] = {\n" name)
(mapcar
(lambda (pm)
(format ofd " %s_%02d_num_frames,\n" name pm))
pms)
(format ofd "0};\n")
(format ofd "const unsigned short **%s_model_vectors_table[] = {\n" name)
(mapcar
(lambda (pm)
(format ofd " (const unsigned short **)%s_%02d_model_vectors,\n" name pm))
pms)
(format ofd "NULL};\n")
(if cg:quantized_params
(begin
(format ofd "const float **%s_model_qtable[] = {\n" name)
(mapcar
(lambda (pm)
(format ofd " (const float **)%s_%02d_qtable,\n" name pm))
pms)
(format ofd "NULL};\n"))
(begin
(format ofd "const float **%s_model_qtable[] = {NULL}; /* not used */ \n" name)
))
(format ofd "const cst_cart **%s_mcep_carts_table[] = {\n" name)
(mapcar
(lambda (pm)
(format ofd " (const cst_cart **)%s_%02d_mcep_carts,\n" name pm))
pms)
(format ofd "NULL};\n")
;; duration model (cart conversion)
(if cg:rfs_dur_models
(set! dms (load "dur_rf_models/mlist" t))
(set! dms '(01)))
(if cg:rfs_dur_models
(begin
(format t "cg_convert: converting rf duration models\n")
(mapcar
(lambda (dm)
(format t "cg_convert: converting %02d duration model\n" dm)
(set! val_table nil)
(cg_convert_durmodel
(format nil "dur_rf_models/dur_%02d/%s_durdata_cg.scm" dm name)
(format nil "%s_cg_%02d_" name dm) odir)
(format ofd "extern const dur_stat * const %s_cg_%02d_dur_stats[];\n" name dm)
(format ofd "extern const cst_cart %s_cg_%02d_dur_cart;\n" name dm))
dms))
(begin
(format t "cg_convert: converting single duration model\n")
(format t "cg_convert: converting 01 duration model\n")
(cg_convert_durmodel
(format nil "festvox/%s_durdata_cg.scm" name)
(format nil "%s_cg_%02d_" name 01) odir)
(format ofd "extern const dur_stat * const %s_cg_%02d_dur_stats[];\n" name 01)
(format ofd "extern const cst_cart %s_cg_%02d_dur_cart;\n" name 01)
))
(format ofd "#define %s_num_dur_models %d\n" name (length dms))
(format ofd "const dur_stat **%s_dur_stats_table[] = {\n" name)
(mapcar
(lambda (dm)
(format ofd " (const dur_stat **)%s_cg_%02d_dur_stats,\n" name dm))
dms)
(format ofd "NULL};\n")
(format ofd "const cst_cart *%s_dur_cart_table[] = {\n" name)
(mapcar
(lambda (dm)
(format ofd " &%s_cg_%02d_dur_cart,\n" name dm))
dms)
(format ofd "NULL};\n")
;; 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 "float %s_dynwin[] = { -0.5, 0.0, 0.5 };\n" name)
(format ofd "#define %s_dynwinsize 3\n" name)
(if cg:mixed_excitation
(begin
;; Uses filters in festvox/mef.track (from Jan 2013)
(set! n 0)
(while (< n 5)
(format ofd "const double %s_me_filter_%d[] = {\n" name n)
(set! o 0)
(while (< o 46)
(format ofd "%f, " (track.get me_filter_track n o))
(set! o (+ o 1)))
(format ofd "%f\n};\n" (track.get me_filter_track n o))
(set! n (+ n 1))
)
(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)
(if (boundp 'framerate)
(format ofd " %d,\n" framerate) ;; sample rate
(format ofd " 16000,\n")) ;; sample rate
(format ofd " %f,%f,\n" F0MEAN F0STD)
(format ofd " %s_num_f0_models,\n" name)
(format ofd " %s_f0_carts_table,\n" name)
(format ofd " %s_num_param_models,\n" name)
(format ofd " %s_mcep_carts_table,\n" name)
(if cg:spamf0
(begin
(set! mfd (fopen (path-append odir "paramfiles.mak") "a"))
(format mfd "SPAMF0=true\n")
(fclose mfd)
(format ofd " &%s_spamf0_accent_cart,\n" name)
(format ofd " &%s_spamf0_phrase_cart,\n" name)
)
(begin
(set! mfd (fopen (path-append odir "paramfiles.mak") "a"))
(format mfd "SPAMF0=false\n")
(fclose mfd)
(format ofd " NULL,NULL,\n")
)
)
(format ofd " %s_num_channels_table,\n" name)
(format ofd " %s_num_frames_table,\n" name)
(format ofd " %s_model_vectors_table,\n" name)
(if cg:spamf0
(begin
(format ofd " %s_spamf0_accent_num_channels,\n" name)
(format ofd " %s_spamf0_accent_num_frames,\n" name)
(format ofd " %s_spamf0_accent_vectors,\n" name)
)
(format ofd " 0,0,NULL,\n")
)
(format ofd " %s_model_min,\n" name)
(format ofd " %s_model_range,\n" name)
(cond
((not cg:quantized_params)
;; Simple 2 values per short
(format ofd " NULL, /* no quantization table(s) */\n")
(format ofd " CST_CG_MODEL_SHAPE_BASE_MINRANGE,\n")
)
((eq 41 cg_model_num_channels)
(format ofd " %s_model_qtable,\n" name)
(format ofd " CST_CG_MODEL_SHAPE_QUANTIZED_PARAMS_41,\n"))
(t
(format ofd " %s_model_qtable,\n" name)
(format ofd " CST_CG_MODEL_SHAPE_QUANTIZED_PARAMS,\n")))
(format ofd " %f, /* frame_advance */\n" cg:frame_shift)
(format ofd " %s_num_dur_models,\n" name)
(format ofd " %s_dur_stats_table,\n" name)
(format ofd " %s_dur_cart_table,\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" 0.4)
(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,47, /* 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")))
(if cg:spamf0
(format ofd " 1, /* cg:spamf0 */\n")
(format ofd " 0, /* cg:spamf0 */\n"))
(format ofd " 1.5 /* gain */\n")
;; If a grapheme language, add phoneset and char_phone_map
(if (probe_file (format nil "festvox/%s_char_phone_map.scm" name))
(begin
(format ofd " ,\n")
(format ofd " &%s_phoneset,\n" name)
(format ofd " &%s_char_phone_map\n" name)
))
(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 "durmodel.c")) "w"))
(set! dfdh (fopen (path-append odir (string-append name "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 \"%sdurmodel.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 %sdur_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))
(format t "cg_convert: converting model_%s spectral params\n" type)
(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))
(set! cg_model_num_channels num_channels)
(format mfd "/** Size: %d */\n" cg_model_num_channels)
;; 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:mixed_excitation
(begin
(set! num_channels_additive_constant 14)
))
(if (> cg_reduced_order 0)
(format cofd "#define %s_%s_num_channels %d\n"
name type (+ num_channels_additive_constant (* 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 (cg_convert_params_quantized mcepfn mcepqtable name type odir cofd)
(let ((param.track (track.load mcepfn))
(qtable.track (track.load mcepqtable))
(i 0) (mfd))
(format t "cg_convert: converting model_%s quantized spectral params\n" type)
(set! mfd (fopen (path-append odir (string-append name "_cg_" type "_params.c")) "w"))
(format mfd "/*****************************************************/\n")
(format mfd "/** Autogenerated model_vectors (quantized) for %s */\n" name)
(format mfd "/*****************************************************/\n")
;; This will be half the actual number of channels
;; as two vals are encoded per (16 bit) entry
(set! num_channels (track.num_channels param.track))
(set! num_frames (track.num_frames param.track))
(set! cg_model_num_channels num_channels)
(format mfd "/** Size: %d channels */\n" cg_model_num_channels)
;; Output each frame
(while (< i num_frames)
;; output vals without normalization -- its already happened
(output_param_frame_asis 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:mixed_excitation
(begin
(set! num_channels_additive_constant 14)
))
;; LIE about num channels (put in model number of channels not
;; num of channels in compressed/quantized track
(format cofd "#define %s_%s_num_channels %d\n" name type
(cond
((and cg:quantized_params (equal? 41 num_channels))
114) ;; naively assume this is the special compression
(cg:quantized_params
(* 2 num_channels))
(t
num_channels)))
(format cofd "#define %s_%s_num_frames %d\n" name type num_frames)
;; Dump the q_table too, that gives the lookup table to map values back
(set! num_channels (track.num_channels qtable.track))
(set! num_frames (track.num_frames qtable.track))
(set! i 0)
;; Output each frame
(while (< i num_frames)
(format mfd "static const float %s_%s_qtable_frame_%d[] = { \n" name type i)
(set! j 0)
(while (< j num_channels)
(format mfd " %f," (track.get qtable.track i j))
(set! j (+ 1 j)))
(format mfd " };\n")
(set! i (+ 1 i)))
(format mfd "\n\n")
;; Output each frame
(format mfd "const float * const %s_%s_qtable[] = {\n" name type)
(set! i 0)
(while (< i num_frames)
(format mfd " %s_%s_qtable_frame_%d,\n" name type i)
(set! i (+ 1 i)))
(format mfd "};\n\n")
;; add extern reference to the qtable to main file
(format cofd "extern const float * const %s_%s_qtable[];\n" name type)
(fclose mfd)
))
(define (mcepcoeff_norm c min range)
(let ((x (* (/ (- c min) range) 65535)))
(cond
((< x 0) 0.0)
((> x 65535) 65535)
(t x))))
(define (output_accent_frame name track f ofd)
"(output_accent_frame name track frame ofd)
Ouput this accent params."
(let ((i 0) (nc (track.num_channels track)))
;(format ofd "static const unsigned short %s_spamf0_accent_frame_%d[] = { \n" name f)
(format ofd "static const float %s_spamf0_accent_frame_%d[] = { \n" name f)
(while (< i nc)
(format ofd " %f," (track.get track f i))
(set! i (+ 1 i)))
(format ofd " };\n")
)
)
(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)
(if cg:relevant_params
(begin ;; specified number of parameters
)
(if cg:mixed_excitation
(begin
(while (< i nc)
(if (or (eq cg_reduced_order 0)
(< i (* 2 (+ 1 cg_reduced_order))) ;; static and static_stddev
(and (> i (- (/ (- nc 10) 2) 1)) ;; deltas and delta_stddev
(< i (+ (/ (- nc 10) 2) (* 2 cg_reduced_order))))
(> i (- nc 13)))
(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")
)
(begin
(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 (output_param_frame_asis name type track f ofd)
"(output_param_frame_asis name track frame ofd)
Ouput this frame."
;; This is (maybe) hardcoded for rf3 builds which are statics, deltas, me.
;; It assumes any fancy coding has externally been done so just dumps
;; what is there asis.
(let ((i 0) (nc (track.num_channels track)))
(format ofd "static const unsigned short %s_%s_param_frame_%d[] = { \n" name type f)
(while (< i nc)
(format ofd " %d," (track.get track f i))
(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)
(cg_normal_phone_name_base
(cg_normal_phone_name_base
(cg_normal_phone_name_base x))))
(define (cg_normal_phone_name_base x)
;; Some phone names 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 ":"))))
((string-matches x ".*=.*")
(intern
(string-append
(string-before x "=")
"eq"
(string-after x "="))))
((string-matches x ".*>.*")
(intern
(string-append
(string-before x ">")
"gt"
(string-after x ">"))))
((string-matches x ".*}.*")
(intern
(string-append
(string-before x "}")
"rb"
(string-after x "}"))))
((string-matches x ".*].*")
(intern
(string-append
(string-before x "]")
"rbk"
(string-after x "]"))))
((string-matches x ".*-.*")
(intern
(string-append
(string-before x "-")
"hyp"
(string-after x "-"))))
((string-matches x ".*\\*.*")
(intern
(string-append
(string-before x "*")
"star"
(string-after x "*"))))
((string-matches x ".*\\^.*")
(intern
(string-append
(string-before x "^")
"caret"
(string-after x "^"))))
((string-matches x ".*~.*")
(intern
(string-append
(string-before x "~")
"tilde"
(string-after x "~"))))
(t x)))
(provide 'make_cg)