1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2;;;                                                                     ;;;
3;;;                  Language Technologies Institute                    ;;;
4;;;                     Carnegie Mellon University                      ;;;
5;;;                      Copyright (c) 2007-2017                        ;;;
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: November 2007                                   ;;;
35;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36;;;                                                                     ;;;
37;;; Convert a clustergen voice to flite                                 ;;;
38;;; (Oct 2014) support for random forests                               ;;;
39;;; (Jun 2017) support for quantized params                             ;;;
40;;;                                                                     ;;;
41;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
42
43;; Used for getting smaller models, if non-zero this will reduce the
44;; order of the dumped models from whatever it is (probably 24) to this
45;; It does the right thing with statics and dynamics and stddev
46(defvar cg:relevant_params nil) ;; a list of param ranges to dump
47(defvar cg_reduced_order 0)
48(defvar cg:quantized_params t) ;; 8 bit quantized table
49(if (> cg_reduced_order 0) ;; just to remind me
50    (format t "\n***** CG: note reducing order to %d *****\n\n"
51            cg_reduced_order))
52(defvar F0MEAN 0.0)
53(defvar F0STD 1.0)
54(defvar num_channels_additive_constant 4)
55(defvar new_min_range nil)
56
57(define (cg_convert name festvoxdir odir)
58  "(cg_convert name clcatfn clcatfnordered cltreesfn festvoxdir odir)
59Convert a festvox clunits (processed) voice into a C file."
60
61   (load (format nil "%s/festvox/%s_cg.scm" festvoxdir name))
62   (eval (list (intern (format nil "voice_%s_cg" name))))
63
64  (if cg:quantized_params
65      (if cg:rfs_models
66          (system (format nil "$FLITEDIR/tools/quantize_params quantize_rf_models"))
67          (system (format nil "$FLITEDIR/tools/quantize_params find_segments_quant festival/trees/%s_mcep.params" name))))
68
69   (set! ofd (fopen (path-append odir (string-append name "_cg.c")) "w"))
70   (format ofd "/*****************************************************/\n")
71   (format ofd "/**  Autogenerated clustergen voice for %s    */\n" name)
72   (format ofd "/*****************************************************/\n")
73   (format ofd "\n")
74   (format ofd "#include \"cst_string.h\"\n")
75   (format ofd "#include \"cst_cg.h\"\n")
76   (format ofd "#include \"cst_cart.h\"\n")
77
78   (format t "cg_convert: converting F0 trees\n")
79   ;; F0 trees
80   (if (and cg:rfs_models (probe_file "rf_models/mlistf0"))
81       (set! f0ms (load "rf_models/mlistf0" t))
82       (set! f0ms (list '01)))
83
84   (if (and cg:rfs_models (probe_file "rf_models/mlistf0"))
85       (begin ;; Random Forest F0 Models
86         (format t "cg_convert: converting rf F0 trees\n")
87         (mapcar
88          (lambda (f0m)
89            (format t "cg_convert:    converting model_%02d f0 params\n" f0m)
90            (set! val_table nil)
91            (cg_convert_carts
92             (load (format nil "rf_models/trees_%02d/%s_f0.tree" f0m name) t)
93             (format nil "%02d_f0" f0m) name odir)
94            (format ofd "extern const cst_cart * const %s_%02d_f0_carts[];\n" name f0m))
95          f0ms))
96       (begin ;; No-random Forest F0 Models (just one model)
97         (set! val_table nil) ;; different val number over the two sets of carts
98         (cg_convert_carts
99          (load (format nil "festival/trees/%s_f0.tree" name) t)
100          "01_f0" name odir)
101         (format ofd "\n")
102         (format ofd "extern const cst_cart * const %s_01_f0_carts[];\n" name )))
103
104   (if cg:spamf0
105	(begin
106	  (set! acctrack (track.load "festival/trees/cb.params"))
107	  (format ofd "extern const cst_cart %s_spamf0_phrase_cart;\n" name)
108	  (format ofd "extern const cst_cart %s_spamf0_accent_cart;\n" name)
109	  (format ofd "extern const float * const %s_spamf0_accent_vectors[];\n" name)
110	  (format ofd "#define %s_spamf0_accent_num_channels %d\n" name (track.num_channels acctrack))
111	  (format ofd "#define %s_spamf0_accent_num_frames %d\n" name (track.num_frames acctrack))
112	))
113
114   ;; spectral trees
115   (set! val_table nil) ;; different val number over the two sets of carts
116
117   (if cg:rfs_models
118       (set! pms (load "rf_models/mlist" t))
119       (set! pms (list '01)))
120
121   (if cg:rfs_models
122       (begin ;; Random Forest Spectral Models
123         (format t "cg_convert: converting rf spectral trees\n")
124         (mapcar
125          (lambda (pm)
126            (set! old_carttoC_extract_answer carttoC_extract_answer)
127            (set! carttoC_extract_answer carttoC_extract_spectral_frame)
128            (set! val_table nil)
129            (cg_convert_carts
130             (load (format nil "rf_models/trees_%02d/%s_mcep.tree" pm name) t)
131             (format nil "%02d_mcep" pm) name odir)
132            (set! carttoC_extract_answer old_carttoC_extract_answer)
133            (format ofd "\n")
134            (format ofd "extern const cst_cart * const %s_%02d_mcep_carts[];\n" name pm)
135
136            ;; spectral params
137            (if cg:quantized_params
138                  ;; Quantized params use 8 bit indexs -- you
139                  ;; must externally create quantized params first
140                  (cg_convert_params_quantized
141                   (format nil "rf_models/trees_%02d/%s_mcep.params.q_params" pm name)
142                   (format nil "rf_models/trees_%02d/%s_mcep.params.q_table" pm name)
143                   name (format nil "%02d" pm) odir ofd)
144                  (cg_convert_params
145                   (format nil "rf_models/trees_%02d/%s_mcep.params" pm name)
146                   (format nil "festival/trees/%s_min_range.scm" name)
147                   name (format nil "%02d" pm) odir ofd))
148            (format ofd "extern const unsigned short * const %s_%02d_model_vectors[];\n" name pm ))
149          pms))
150       (begin ;; Non-random forest spectral models (one model)
151         (format t "cg_convert: converting single spectral trees\n")
152         (set! old_carttoC_extract_answer carttoC_extract_answer)
153         (set! carttoC_extract_answer carttoC_extract_spectral_frame)
154         (set! val_table nil)
155         (cg_convert_carts
156          (load (format nil "festival/trees/%s_mcep.tree" name) t)
157          "01_mcep" name odir)
158         (set! carttoC_extract_answer old_carttoC_extract_answer)
159         (format ofd "\n")
160         (format ofd "extern const cst_cart * const %s_01_mcep_carts[];\n" name )
161         ;; spectral params
162         (if cg:quantized_params
163               (cg_convert_params_quantized
164                (format nil "festival/trees/%s_mcep.params.q_params" name)
165                (format nil "festival/trees/%s_mcep.params.q_table" name)
166                name "01" odir ofd)
167               (cg_convert_params
168                (format nil "festival/trees/%s_mcep.params" name)
169                (format nil "festival/trees/%s_min_range.scm" name)
170                name "01" odir ofd))
171         (format ofd "extern const unsigned short * const %s_01_model_vectors[];\n" name )
172         ))
173
174   (format ofd "#define %s_num_f0_models %d\n" name (length f0ms))
175   (format ofd "const cst_cart **%s_f0_carts_table[] = {\n" name)
176   (mapcar
177    (lambda (f0m)
178      (format ofd "   (const cst_cart **)%s_%02d_f0_carts,\n" name f0m))
179    f0ms)
180   (format ofd "NULL};\n")
181
182   (format ofd "#define %s_num_param_models %d\n" name (length pms))
183   (format ofd "int %s_num_channels_table[] = {\n" name)
184   (mapcar
185    (lambda (pm)
186      (format ofd "   %s_%02d_num_channels,\n" name pm))
187    pms)
188   (format ofd "0};\n")
189   (format ofd "int %s_num_frames_table[] = {\n" name)
190   (mapcar
191    (lambda (pm)
192      (format ofd "   %s_%02d_num_frames,\n" name pm))
193    pms)
194   (format ofd "0};\n")
195   (format ofd "const unsigned short **%s_model_vectors_table[] = {\n" name)
196   (mapcar
197    (lambda (pm)
198      (format ofd "   (const unsigned short **)%s_%02d_model_vectors,\n" name pm))
199    pms)
200   (format ofd "NULL};\n")
201   (if cg:quantized_params
202       (begin
203         (format ofd "const float **%s_model_qtable[] = {\n" name)
204         (mapcar
205          (lambda (pm)
206            (format ofd "   (const float **)%s_%02d_qtable,\n" name pm))
207          pms)
208         (format ofd "NULL};\n"))
209       (begin
210         (format ofd "const float **%s_model_qtable[] = {NULL}; /* not used */ \n" name)
211         ))
212   (format ofd "const cst_cart **%s_mcep_carts_table[] = {\n" name)
213   (mapcar
214    (lambda (pm)
215      (format ofd "   (const cst_cart **)%s_%02d_mcep_carts,\n" name pm))
216    pms)
217   (format ofd "NULL};\n")
218
219   ;; duration model (cart conversion)
220   (if cg:rfs_dur_models
221       (set! dms (load "dur_rf_models/mlist" t))
222       (set! dms '(01)))
223
224   (if cg:rfs_dur_models
225       (begin
226         (format t "cg_convert: converting rf duration models\n")
227         (mapcar
228             (lambda (dm)
229               (format t "cg_convert:    converting %02d duration model\n" dm)
230               (set! val_table nil)
231               (cg_convert_durmodel
232                (format nil "dur_rf_models/dur_%02d/%s_durdata_cg.scm" dm name)
233                (format nil "%s_cg_%02d_" name dm) odir)
234               (format ofd "extern const dur_stat * const %s_cg_%02d_dur_stats[];\n" name dm)
235              (format ofd "extern const cst_cart %s_cg_%02d_dur_cart;\n" name dm))
236             dms))
237       (begin
238         (format t "cg_convert: converting single duration model\n")
239         (format t "cg_convert:    converting 01 duration model\n")
240         (cg_convert_durmodel
241          (format nil "festvox/%s_durdata_cg.scm" name)
242          (format nil "%s_cg_%02d_" name 01) odir)
243         (format ofd "extern const dur_stat * const %s_cg_%02d_dur_stats[];\n" name 01)
244         (format ofd "extern const cst_cart %s_cg_%02d_dur_cart;\n" name 01)
245       ))
246
247   (format ofd "#define %s_num_dur_models %d\n" name (length dms))
248   (format ofd "const dur_stat **%s_dur_stats_table[] = {\n" name)
249   (mapcar
250    (lambda (dm)
251      (format ofd "   (const dur_stat **)%s_cg_%02d_dur_stats,\n" name dm))
252    dms)
253   (format ofd "NULL};\n")
254   (format ofd "const cst_cart *%s_dur_cart_table[] = {\n" name)
255   (mapcar
256    (lambda (dm)
257      (format ofd "   &%s_cg_%02d_dur_cart,\n" name dm))
258    dms)
259   (format ofd "NULL};\n")
260
261   ;; phone to states
262   (format t "cg_convert: converting phone to state map\n")
263   (cg_phone_to_states
264    (format nil "festvox/%s_statenames.scm" name)
265    name odir)
266   (format ofd "extern const char * const *%s_phone_states[];\n" name)
267
268   (format ofd "\n")
269   (format ofd "const char * const %s_types[] = {\n" name)
270   (mapcar
271    (lambda (cart)
272      (format ofd "   \"%s\",\n" (car cart)))
273    (load (format nil "festival/trees/%s_f0.tree" name) t))
274   (format ofd "   NULL};\n")
275   (format ofd "#define %s_num_types  %d\n\n"
276           name
277           (length (load (format nil "festival/trees/%s_f0.tree" name) t)))
278
279   (format ofd "const float %s_model_min[] = { \n" name)
280   (mapcar
281    (lambda (p)
282      (format ofd "   %f,\n" (car p)))
283    (reverse new_min_range))
284   (format ofd "};\n")
285   (format ofd "const float %s_model_range[] = { \n" name)
286   (mapcar
287    (lambda (p)
288      (format ofd "   %f,\n" (cadr p)))
289    (reverse new_min_range))
290   (format ofd "};\n")
291
292   (format ofd "float %s_dynwin[] = { -0.5, 0.0, 0.5 };\n" name)
293   (format ofd "#define %s_dynwinsize 3\n" name)
294
295   (if cg:mixed_excitation
296       (begin
297         ;; Uses filters in festvox/mef.track (from Jan 2013)
298         (set! n 0)
299         (while (< n 5)
300            (format ofd "const double %s_me_filter_%d[] = {\n" name n)
301            (set! o 0)
302            (while (< o 46)
303               (format ofd "%f, " (track.get me_filter_track n o))
304               (set! o (+ o 1)))
305            (format ofd "%f\n};\n" (track.get me_filter_track n o))
306            (set! n (+ n 1))
307         )
308         (format ofd "const double * const %s_me_h[] = {\n" name)
309         (format ofd "   %s_me_filter_0,\n" name)
310         (format ofd "   %s_me_filter_1,\n" name)
311         (format ofd "   %s_me_filter_2,\n" name)
312         (format ofd "   %s_me_filter_3,\n" name)
313         (format ofd "   %s_me_filter_4\n" name)
314         (format ofd "};\n\n")
315         ))
316
317   (format ofd "const cst_cg_db %s_cg_db = {\n" name)
318   (format ofd "  \"%s\",\n" name)
319   (format ofd "  %s_types,\n" name)
320   (format ofd "  %s_num_types,\n" name)
321   (if (boundp 'framerate)
322       (format ofd "  %d,\n" framerate) ;; sample rate
323       (format ofd "  16000,\n"))       ;; sample rate
324
325   (format ofd "  %f,%f,\n" F0MEAN F0STD)
326
327   (format ofd "  %s_num_f0_models,\n" name)
328   (format ofd "  %s_f0_carts_table,\n" name)
329   (format ofd "  %s_num_param_models,\n" name)
330   (format ofd "  %s_mcep_carts_table,\n" name)
331   (if cg:spamf0
332       (begin
333         (set! mfd (fopen (path-append odir "paramfiles.mak") "a"))
334         (format mfd "SPAMF0=true\n")
335         (fclose mfd)
336         (format ofd "  &%s_spamf0_accent_cart,\n" name)
337         (format ofd "  &%s_spamf0_phrase_cart,\n" name)
338         )
339       (begin
340         (set! mfd (fopen (path-append odir "paramfiles.mak") "a"))
341         (format mfd "SPAMF0=false\n")
342         (fclose mfd)
343         (format ofd "  NULL,NULL,\n")
344         )
345       )
346   (format ofd "  %s_num_channels_table,\n" name)
347   (format ofd "  %s_num_frames_table,\n" name)
348   (format ofd "  %s_model_vectors_table,\n" name)
349
350   (if cg:spamf0
351       (begin
352         (format ofd "  %s_spamf0_accent_num_channels,\n" name)
353         (format ofd "  %s_spamf0_accent_num_frames,\n" name)
354         (format ofd "  %s_spamf0_accent_vectors,\n" name)
355         )
356       (format ofd "  0,0,NULL,\n")
357       )
358   (format ofd "  %s_model_min,\n" name)
359   (format ofd "  %s_model_range,\n" name)
360
361   (cond
362    ((not cg:quantized_params)
363     ;; Simple 2 values per short
364     (format ofd "  NULL, /* no quantization table(s) */\n")
365     (format ofd "  CST_CG_MODEL_SHAPE_BASE_MINRANGE,\n")
366     )
367    ((eq 41 cg_model_num_channels)
368     (format ofd "  %s_model_qtable,\n" name)
369     (format ofd "  CST_CG_MODEL_SHAPE_QUANTIZED_PARAMS_41,\n"))
370    (t
371     (format ofd "  %s_model_qtable,\n" name)
372     (format ofd "  CST_CG_MODEL_SHAPE_QUANTIZED_PARAMS,\n")))
373
374   (format ofd "  %f, /* frame_advance */\n" cg:frame_shift)
375
376   (format ofd "  %s_num_dur_models,\n" name)
377   (format ofd "  %s_dur_stats_table,\n" name)
378   (format ofd "  %s_dur_cart_table,\n" name)
379   (format ofd "  %s_phone_states,\n" name)
380
381   (format ofd "  1, /* 1 if mlpg required */\n")
382   (format ofd "  %s_dynwin,\n" name)
383   (format ofd "  %s_dynwinsize,\n" name)
384
385   (format ofd "  %f, /* mlsa_alpha */\n" mlsa_alpha_param)
386   (format ofd "  %f, /* mlsa_beta */\n" 0.4)
387
388   (if cg:multimodel
389       (format ofd "  1, /* cg:multimodel */\n")
390       (format ofd "  0, /* cg:multimodel */\n"))
391
392   (if cg:mixed_excitation
393       (begin
394         (format ofd "  1, /* cg:mixed_excitation */\n")
395         (format ofd "  5,47, /* filter sizes */\n")
396         (format ofd "  %s_me_h, \n" name))
397       (begin
398         (format ofd "  0, /* cg:mixed_excitation */\n")
399         (format ofd "  0,0, /* cg:mixed_excitation */\n")
400         (format ofd "  NULL, \n")))
401   (if cg:spamf0
402	(format ofd "  1, // cg:spamf0\n")
403	(format ofd "  0, // cg:spamf0\n"))
404   (format ofd "  1.5 /* gain */\n")
405   (format ofd "};\n")
406
407   (fclose ofd)
408)
409
410(define (unit_type u)
411  (apply
412   string-append
413   (reverse
414    (symbolexplode
415     (string-after
416      (apply
417       string-append
418       (reverse (symbolexplode u)))
419      "_")))))
420
421(define (unit_occur u)
422  (apply
423   string-append
424   (reverse
425    (symbolexplode
426     (string-before
427      (apply
428       string-append
429       (reverse (symbolexplode u)))
430      "_")))))
431
432(define (cg_convert_durmodel durmodelfn name odir)
433
434  (set! durmodel (load durmodelfn t))
435  (set! phonedurs (cadr (car (cddr (car durmodel)))))
436  (set! zdurtree (cadr (car (cddr (cadr durmodel)))))
437
438  (set! dfd (fopen (path-append odir (string-append name "durmodel.c")) "w"))
439  (set! dfdh (fopen (path-append odir (string-append name "durmodel.h")) "w"))
440  (format dfd "/*****************************************************/\n")
441  (format dfd "/**  Autogenerated durmodel_cg for %s    */\n" name)
442  (format dfd "/*****************************************************/\n")
443
444  (format dfd "#include \"cst_synth.h\"\n")
445  (format dfd "#include \"cst_string.h\"\n")
446  (format dfd "#include \"cst_cart.h\"\n")
447  (format dfd "#include \"%sdurmodel.h\"\n\n" name)
448
449  (mapcar
450   (lambda (s)
451     (format dfd "static const dur_stat dur_state_%s = { \"%s\", %f, %f };\n"
452             (cg_normal_phone_name (car s))
453             (car s) (car (cdr s)) (car (cddr s)))
454     )
455   phonedurs)
456  (format dfd "\n")
457
458  (format dfd "const dur_stat * const %sdur_stats[] = {\n" name)
459  (mapcar
460   (lambda (s)
461     (format dfd "   &dur_state_%s,\n" (cg_normal_phone_name (car s))))
462   phonedurs)
463  (format dfd "   NULL\n};\n")
464
465  (set! val_table nil)
466  (set! current_node -1)
467  (set! feat_nums nil)
468  (do_carttoC dfd dfdh
469              (format nil "%s%s" name "dur")
470              zdurtree)
471
472  (fclose dfd)
473  (fclose dfdh)
474)
475
476(define (cg_phone_to_states phonestatefn name odir)
477
478  (set! dfd (fopen (path-append odir (string-append name "_cg_phonestate.c")) "w"))
479  (format dfd "/*****************************************************/\n")
480  (format dfd "/**  Autogenerated phonestate_cg for %s    */\n" name)
481  (format dfd "/*****************************************************/\n")
482
483  (set! phonestates (load phonestatefn t))
484
485  (mapcar
486   (lambda (x)
487     (format dfd "const char * const %s_%s_ps[] = { " name
488             (cg_normal_phone_name (car x)))
489     (mapcar
490      (lambda (y) (format dfd "\"%s\", " y))
491      x)
492     (format dfd " 0};\n"))
493   (cadr (caddr (car phonestates))))
494
495  (format dfd "const char * const * const %s_phone_states[] = {\n" name)
496  (mapcar
497   (lambda (x)
498     (format dfd "   %s_%s_ps,\n" name
499             (cg_normal_phone_name (car x))))
500   (cadr (caddr (car phonestates))))
501  (format dfd "   0};\n")
502
503  (fclose dfd)
504)
505
506(define (cg_convert_params mcepfn mcepminrangefn name type odir cofd)
507  (let ((param.track (track.load mcepfn))
508        (i 0) (mfd))
509    (format t "cg_convert:    converting model_%s spectral params\n" type)
510
511    (set! mfd (fopen (path-append odir (string-append name "_cg_" type "_params.c")) "w"))
512    (format mfd "/*****************************************************/\n")
513    (format mfd "/**  Autogenerated model_vectors for %s    */\n" name)
514    (format mfd "/*****************************************************/\n")
515    (set! num_channels (track.num_channels param.track))
516    (set! num_frames (track.num_frames param.track))
517    (set! cg_model_num_channels num_channels)
518    (format mfd "/**  Size: %d */\n" cg_model_num_channels)
519    ;; Output each frame
520    (set! mcep_min_range (load mcepminrangefn t))
521    (while (< i num_frames)
522       (output_param_frame name type param.track i mfd)
523       (set! i (+ 1 i)))
524    (format mfd "\n\n")
525    ;; Output each frame
526    (format mfd "const unsigned short * const %s_%s_model_vectors[] = {\n" name type)
527    (set! i 0)
528    (while (< i num_frames)
529       (format mfd "   %s_%s_param_frame_%d,\n" name type i)
530       (set! i (+ 1 i)))
531    (format mfd "};\n\n")
532
533    (if cg:mixed_excitation
534	(begin
535	  (set! num_channels_additive_constant 14)
536	  ))
537
538    (if (> cg_reduced_order 0)
539      (format cofd "#define %s_%s_num_channels %d\n"
540              name type (+ num_channels_additive_constant (* 4 cg_reduced_order)))
541      (format cofd "#define %s_%s_num_channels %d\n" name type num_channels))
542
543    (format cofd "#define %s_%s_num_frames %d\n" name type num_frames)
544
545    (fclose mfd)
546
547    ))
548
549(define (cg_convert_params_quantized mcepfn mcepqtable name type odir cofd)
550  (let ((param.track (track.load mcepfn))
551        (qtable.track (track.load mcepqtable))
552        (i 0) (mfd))
553    (format t "cg_convert:    converting model_%s quantized spectral params\n" type)
554    (set! mfd (fopen (path-append odir (string-append name "_cg_" type "_params.c")) "w"))
555    (format mfd "/*****************************************************/\n")
556    (format mfd "/**  Autogenerated model_vectors (quantized) for %s    */\n" name)
557    (format mfd "/*****************************************************/\n")
558    ;; This will be half the actual number of channels
559    ;; as two vals are encoded per (16 bit) entry
560    (set! num_channels (track.num_channels param.track))
561    (set! num_frames (track.num_frames param.track))
562    (set! cg_model_num_channels num_channels)
563    (format mfd "/**  Size: %d channels */\n" cg_model_num_channels)
564    ;; Output each frame
565    (while (< i num_frames)
566           ;; output vals without normalization -- its already happened
567       (output_param_frame_asis name type param.track i mfd)
568       (set! i (+ 1 i)))
569    (format mfd "\n\n")
570    ;; Output each frame
571    (format mfd "const unsigned short * const %s_%s_model_vectors[] = {\n" name type)
572    (set! i 0)
573    (while (< i num_frames)
574       (format mfd "   %s_%s_param_frame_%d,\n" name type i)
575       (set! i (+ 1 i)))
576    (format mfd "};\n\n")
577
578    (if cg:mixed_excitation
579	(begin
580	  (set! num_channels_additive_constant 14)
581	  ))
582
583    ;; LIE about num channels (put in model number of channels not
584    ;; num of channels in compressed/quantized track
585    (format cofd "#define %s_%s_num_channels %d\n" name type
586            (cond
587             ((and cg:quantized_params (equal? 41 num_channels))
588              114) ;; naively assume this is the special compression
589             (cg:quantized_params
590              (* 2 num_channels))
591             (t
592              num_channels)))
593
594    (format cofd "#define %s_%s_num_frames %d\n" name type num_frames)
595
596    ;; Dump the q_table too, that gives the lookup table to map values back
597    (set! num_channels (track.num_channels qtable.track))
598    (set! num_frames (track.num_frames qtable.track))
599    (set! i 0)
600    ;; Output each frame
601    (while (< i num_frames)
602       (format mfd "static const float %s_%s_qtable_frame_%d[] = { \n" name type i)
603       (set! j 0)
604       (while (< j num_channels)
605          (format mfd " %f," (track.get qtable.track i j))
606          (set! j (+ 1 j)))
607       (format mfd " };\n")
608       (set! i (+ 1 i)))
609    (format mfd "\n\n")
610    ;; Output each frame
611    (format mfd "const float * const %s_%s_qtable[] = {\n" name type)
612    (set! i 0)
613    (while (< i num_frames)
614       (format mfd "   %s_%s_qtable_frame_%d,\n" name type i)
615       (set! i (+ 1 i)))
616    (format mfd "};\n\n")
617    ;; add extern reference to the qtable to main file
618    (format cofd "extern const float * const %s_%s_qtable[];\n" name type)
619    (fclose mfd)
620
621    ))
622
623(define (mcepcoeff_norm c min range)
624  (let ((x (* (/ (- c min) range) 65535)))
625    (cond
626     ((< x 0) 0.0)
627     ((> x 65535) 65535)
628     (t x))))
629
630(define (output_accent_frame name track f ofd)
631  "(output_accent_frame name track frame ofd)
632Ouput this accent params."
633  (let ((i 0) (nc (track.num_channels track)))
634    ;(format ofd "static const unsigned short %s_spamf0_accent_frame_%d[] = { \n" name f)
635    (format ofd "static const float %s_spamf0_accent_frame_%d[] = { \n" name f)
636	  (while (< i nc)
637                       (format ofd " %f," (track.get track f i))
638                 (set! i (+ 1 i)))
639          (format ofd " };\n")
640)
641)
642
643(define (output_param_frame name type track f ofd)
644  "(output_param_frame name track frame ofd)
645Ouput this frame."
646  (let ((i 0) (nc (track.num_channels track)))
647    (format ofd "static const unsigned short %s_%s_param_frame_%d[] = { \n" name type f)
648    (set! min_range mcep_min_range)
649    (set! real_order (/ (- nc 4) 4))
650    (set! new_min_range nil)
651
652    (if cg:relevant_params
653        (begin ;; specified number of parameters
654          )
655    (if cg:mixed_excitation
656	(begin
657
658	  (while (< i nc)
659		 (if (or (eq cg_reduced_order 0)
660			 (< i (* 2 (+ 1 cg_reduced_order))) ;; static and static_stddev
661			 (and (> i (- (/ (- nc 10) 2) 1))  ;; deltas and delta_stddev
662			      (< i (+ (/ (- nc 10) 2) (* 2 cg_reduced_order))))
663			 (> i (- nc 13)))
664		     (begin
665					; (format t "i is %d %d\n" i (+ (/ nc 2) (* 2 cg_reduced_order)))
666		       (format ofd " %d,"
667			       (mcepcoeff_norm
668				(track.get track f i)
669				(caar min_range)
670				(cadr (car min_range))))
671		       (set! new_min_range (cons (car min_range) new_min_range))
672		       ))
673		 (set! min_range (cdr min_range))
674		 (set! i (+ 1 i)))
675	  (format ofd " };\n")
676	  )
677	(begin
678	  (while (< i nc)
679                 (if (or (eq cg_reduced_order 0)
680                         (< i (* 2 (+ 1 cg_reduced_order))) ;; static and static_stddev
681                         (and (> i (- (/ nc 2) 1))  ;; deltas and delta_stddev
682                              (< i (+ (/ nc 2) (* 2 cg_reduced_order))))
683                         (> i (- nc 3)))
684                     (begin
685                                        ; (format t "i is %d %d\n" i (+ (/ nc 2) (* 2 cg_reduced_order)))
686                       (format ofd " %d,"
687                               (mcepcoeff_norm
688                                (track.get track f i)
689                                (caar min_range)
690                                (cadr (car min_range))))
691                       (set! new_min_range (cons (car min_range) new_min_range))
692                       ))
693                 (set! min_range (cdr min_range))
694                 (set! i (+ 1 i)))
695          (format ofd " };\n")
696          )))
697    )
698  )
699
700(define (output_param_frame_asis name type track f ofd)
701  "(output_param_frame_asis name track frame ofd)
702Ouput this frame."
703  ;; This is (maybe) hardcoded for rf3 builds which are statics, deltas, me.
704  ;; It assumes any fancy coding has externally been done so just dumps
705  ;; what is there asis.
706  (let ((i 0) (nc (track.num_channels track)))
707    (format ofd "static const unsigned short %s_%s_param_frame_%d[] = { \n" name type f)
708    (while (< i nc)
709       (format ofd " %d," (track.get track f i))
710       (set! i (+ 1 i)))
711    (format ofd " };\n")
712    ))
713
714(define (carttoC_extract_spectral_frame ofdh tree)
715  "(carttoC_extract_spectral_frame tree)
716Get list of answers from leaf node."
717  (carttoC_val_table ofdh
718		     (car (car tree))
719		     'none))
720
721(define (cg_convert_carts carts prefix name odir)
722 "(define cg_convert_carts cartfn name)
723Output cg selection carts into odir/name_carts.c"
724 (let (ofd ofdh)
725   ;; Set up to dump full list of things at leafs
726   ;; default processing of leaf (int or float) is fine
727
728   (set! ofd (fopen (format nil "%s/%s_cg_%s_trees.c" odir name prefix) "w"))
729   (set! ofdh (fopen (format nil "%s/%s_cg_%s_trees.h" odir name prefix) "w"))
730   (format ofd "/*****************************************************/\n")
731   (format ofd "/**  Autogenerated %s %s carts    */\n" name prefix)
732   (format ofd "/*****************************************************/\n")
733   (format ofd "\n")
734   (format ofd "#include \"cst_string.h\"\n")
735   (format ofd "#include \"cst_cart.h\"\n")
736   (format ofd "#include \"%s_cg_%s_trees.h\"\n" name prefix)
737
738   (mapcar
739    (lambda (cart)
740      (if (string-equal "string" (typeof (car cart)))
741          (begin
742            (set! current_node -1)
743            (set! feat_nums nil)
744            (do_carttoC ofd ofdh
745                        (format nil "%s_%s_%s" name prefix
746                                (cg_normal_phone_name (car cart)))
747                        (cadr cart)))))
748    carts)
749
750   (format ofd "\n\n")
751   (format ofd "const cst_cart * const %s_%s_carts[] = {\n" name prefix)
752   (mapcar
753    (lambda (cart)
754      (if (string-equal "string" (typeof (car cart)))
755          (format ofd " &%s_%s_%s_cart,\n" name prefix
756                  (cg_normal_phone_name (car cart))))
757      )
758    carts)
759   (format ofd " 0 };\n")
760
761   (fclose ofd)
762   (fclose ofdh)
763
764   )
765)
766
767(define (cg_normal_phone_name x)
768  (cg_normal_phone_name_base
769   (cg_normal_phone_name_base
770    (cg_normal_phone_name_base x))))
771
772(define (cg_normal_phone_name_base x)
773  ;; Some phone names aren't valid C labels
774  (cond
775   ((string-matches x ".*@.*" x)
776    (intern
777     (string-append
778      (string-before x "@")
779      "atsign"
780      (string-after x "@"))))
781   ((string-matches x ".*:.*")
782    (intern
783     (string-append
784      (string-before x ":")
785      "sc"
786      (string-after x ":"))))
787   ((string-matches x ".*=.*")
788    (intern
789     (string-append
790      (string-before x "=")
791      "eq"
792      (string-after x "="))))
793   ((string-matches x ".*>.*")
794    (intern
795     (string-append
796      (string-before x ">")
797      "gt"
798      (string-after x ">"))))
799   ((string-matches x ".*}.*")
800    (intern
801     (string-append
802      (string-before x "}")
803      "rb"
804      (string-after x "}"))))
805   ((string-matches x ".*~.*")
806    (intern
807     (string-append
808      (string-before x "~")
809      "tilde"
810      (string-after x "~"))))
811   (t x)))
812
813(provide 'make_cg)
814