ref: 5095f44178e0cbf98419f1a4a22b5d0581813877
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 festvoxdir odir) Convert a festvox cg 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)