;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                     ;;;
;;;                  Language Technologies Institute                    ;;;
;;;                     Carnegie Mellon University                      ;;;
;;;                         Copyright (c) 2000                          ;;;
;;;                        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: April 2001                                      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                     ;;;
;;; Convert festvox voice to flite                                      ;;;
;;;                                                                     ;;;
;;;   clunits: catalogue, carts and param                               ;;;
;;;                                                                     ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defvar lpc_min -2.709040)
(defvar lpc_max 2.328840)
(defvar mcep_min -5.404620)
(defvar mcep_max 4.540220)

(define (clunits_convert name clcatfnfileordered clcatfnunitordered 
			 cltreesfn festvoxdir odir)
  "(clunits_convert name clcatfn clcatfnordered cltreesfn festvoxdir odir)
Convert a festvox clunits (processed) voice into a C file."
   (clunitstoC clcatfnfileordered clcatfnunitordered name 
	       (path-append festvoxdir "sts")
	       (path-append festvoxdir "mcep")
	       odir)

   (set! ofd (fopen (path-append odir (string-append name "_clunits.c")) "a"))

   (clunits_make_carts cltreesfn clcatfnunitordered name odir ofd)

   (format ofd "\n\n")
   (format ofd "static const int %s_join_weights[] = \n" name)
   (format ofd " { 32768, 32768, 32768, 32768, 32768, 32768, 32768, 32768, 32768,\n")
   (format ofd "   32768, 32768, 32768, 32768, 32768, 32768, 32768, 32768, 32768 };\n\n")

   (format ofd "extern const cst_cart * const %s_carts[];\n" name )
   (format ofd "extern cst_sts_list %s_sts, %s_mcep;\n\n" name name )

   (format ofd "cst_clunit_db %s_db = {\n" name)
   (format ofd "  \"%s\",\n\n" name)
   (format ofd "  %s_unit_types,\n" name)
   (format ofd "  %s_carts,\n" name)
   (format ofd "  %s_units,\n\n" name)

   (format ofd "  %s_num_unit_types,\n" name)
   (format ofd "  %s_num_units,\n\n" name)

   (format ofd "  &%s_sts,\n\n" name)

   (format ofd "  &%s_mcep,\n\n" name)

   (format ofd "  %s_join_weights,\n\n" name)
   (format ofd "  1, /* optimal coupling */\n")
   (format ofd "  5, /* extend selections */\n")
   (format ofd "  100, /* f0 weight */\n")
   (format ofd "  0  /* unit_name function */\n")
   
   (format ofd "};\n")

   (fclose ofd)

   ;; Duration model
   (clunits_convert_durmodel  
    (format nil "%s/festvox/%s_durdata.scm" festvoxdir name)
    name odir)
)

(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 (sort_clentries entries clcatfnunitorder)
  (let ((neworder nil))
    (mapcar
     (lambda (unit)
       (set! neworder 
             (cons (assoc (car unit) entries)
                   neworder)))
     (load clcatfnunitorder t))
    (reverse neworder))
  )

(define (clunitstoC clcatfnfileordered clcatfnunitordered 
		    name stsdir mcepdir odir)
  "(clunitstoC clcatfnfileordered clcatfnunitordered name mcepdir stsdir odir)
Convert a clunits catalogue and its sts representations into a
compilable single C file."
  (let 
    ((clindex (load clcatfnfileordered t))
     (lofdidx (fopen (path-append odir (string-append name "_lpc.c")) "w"))
     (lofdh (fopen (path-append odir (string-append name "_lpc.h")) "w"))
     (cofdidx (fopen (path-append odir (string-append name "_clunits.c")) "w"))
     (cofdh (fopen (path-append odir (string-append name "_clunits.h")) "w"))
     (mofdidx (fopen (path-append odir (string-append name "_mcep.c")) "w"))
     (mofdh (fopen (path-append odir (string-append name "_mcep.h")) "w")))

    (format lofdidx "/*****************************************************/\n")
    (format lofdidx "/**  Autogenerated Clunits index for %s    */\n" name)
    (format lofdidx "/*****************************************************/\n")
    (format lofdidx "\n")
    (format lofdidx "#include \"cst_clunits.h\"\n")
    (format lofdidx "#include \"%s_lpc.h\"\n" name)
    (format mofdidx "/*****************************************************/\n")
    (format mofdidx "/**  Autogenerated Clunits index for %s    */\n" name)
    (format mofdidx "/*****************************************************/\n")
    (format mofdidx "\n")
    (format mofdidx "#include \"%s_mcep.h\"\n" name)
    (format mofdidx "#include \"cst_clunits.h\"\n")

    (set! pm_pos 0)
    (set! sample_pos 0)
    (set! times nil)
    (set! clunits_entries nil)
    (set! done_files nil)
    (set! num_unit_entries (length clindex))
    (set! residual_sizes nil)

    (set! lpc_info nil)
    (set! mcep_info nil)

    (set! n 500)
    (set! f 0)
    (while clindex
     (if (equal? n 500)
	 (begin
	   (if (> f 0)
	       (begin 
                 (format lofdbitlpc "0};\n\n")
                 (fclose lofdbitlpc) 
                 (format lofdbitres "0};\n\n")
                 (fclose lofdbitres) 
                 (format mofdbitmcep "0};\n\n")
                 (fclose mofdbitmcep)
                 ))
	   (set! lofdbitlpc
		 (fopen (format nil "%s/%s_lpc_%03d.c" odir name f) "w"))
           
           (format lofdbitlpc 
                   "const unsigned short %s_sts_lpc_page_%d[] = { \n" 
                   name f )
           (format lofdh "extern const unsigned short %s_sts_lpc_page_%d[];\n" 
                   name f )

	   (set! lofdbitres
		 (fopen (format nil "%s/%s_res_%03d.c" odir name f) "w"))
           (format lofdbitres 
                   "const unsigned char %s_sts_res_page_%d[] = { \n" 
                   name f )
           (format lofdh "extern const unsigned char %s_sts_res_page_%d[];\n" 
                   name f )

	   (set! mofdbitmcep 
		 (fopen (format nil "%s/%s_mcep_%03d.c" odir name f) "w"))
           (format mofdbitmcep
                   "const unsigned short %s_sts_mcep_page_%d[] = {\n" 
                   name f )
           (format mofdh "extern const unsigned short %s_sts_mcep_page_%d[];\n" 
                   name f )
	   (set! n 0)
           (set! lpc_page f)
           (set! mcep_page f)
           (set! lpc_page_pos 0)
           (set! res_page_pos 0)
           (set! mcep_page_pos 0)
	   (set! f (+ 1 f))))
     (set! n (+ 1 n))
     (set! pms (find_pm_pos 
		name
		(car clindex)
		stsdir
		mcepdir
		lofdbitlpc
		lofdbitres
		mofdbitmcep
		))

     ;; Output unit_entry for this unit
     (set! clunits_entries
	   (cons
	    (list 
	     (nth 0 (car clindex))
	     (nth 2 pms) ; start_pm
	     (nth 3 pms) ; phone_boundary_pm
	     (nth 4 pms) ; end_pm
	     (nth 5 (car clindex))
	     (nth 6 (car clindex))
	     )
	    clunits_entries))
     (set! clindex (cdr clindex)))

    (set! clunits_entries (sort_clentries clunits_entries clcatfnunitordered))

    (format lofdidx "\n\n")
    (format mofdidx "\n\n")

    (begin ;; Close of last pages
      (format lofdbitlpc "0};\n\n")
      (fclose lofdbitlpc) 
      (format lofdbitres "0};\n\n")
      (fclose lofdbitres) 
      (format mofdbitmcep "0};\n\n")
      (fclose mofdbitmcep)
      )

    (format lofdidx "const cst_sts_paged %s_sts_paged_vals[] = { \n" name)
    (set! i 0)
    (mapcar
     (lambda (info)
       (format lofdidx "  {%d,%d,%d,%s_sts_lpc_page_%d,%s_sts_res_page_%d},\n"
               (nth 1 info) (nth 2 info) (nth 3 info)
               name (nth 0 info)
               name (nth 0 info))
       (set! i (+ 1 i)))
     (reverse lpc_info))
    (format lofdidx "   { 0, 0, 0, 0, 0 }};\n\n")
    (format lofdidx "const cst_sts_list %s_sts = {\n" name)
    (format lofdidx "  NULL, %s_sts_paged_vals,\n" name)
    (format lofdidx "  NULL, NULL, NULL,\n")
    (format lofdidx "  %d,\n" i)
    (format lofdidx "  %d,\n" lpc_order)
    (format lofdidx "  %d,\n" sample_rate)
    (format lofdidx "  %f,\n" lpc_min)
    (format lofdidx "  %f\n" lpc_range)
    (format lofdidx "};\n\n")

    (format mofdidx "const cst_sts_paged %s_mcep_paged_vals[] = { \n" name)
    (set! i 0)
    (mapcar
     (lambda (info)
       (format mofdidx "  { %d, 0, 0, %s_sts_mcep_page_%d, 0 }, \n"
               (nth 1 info) 
	       name (nth 0 info))
       (set! i (+ 1 i)))
       (reverse mcep_info))
    (format mofdidx "   { 0, 0, 0 }};\n\n")

    (format mofdidx "const cst_sts_list %s_mcep = {\n" name)
    (format mofdidx "  NULL, %s_mcep_paged_vals,\n" name)
    (format mofdidx "  NULL, NULL, NULL,\n")
    (format mofdidx "  %d,\n" i)
    (format mofdidx "  %d,\n" mcep_order)
    (format mofdidx "  %d,\n" sample_rate)
    (format mofdidx "  %f,\n" mcep_min)
    (format mofdidx "  %f\n" (- mcep_max mcep_min))
    (format mofdidx "};\n\n")

    (format cofdidx "/*****************************************************/\n")
    (format cofdidx "/**  Autogenerated Clunits index for %s    */\n" name)
    (format cofdidx "/*****************************************************/\n")
    (format cofdidx "\n")
    (format cofdidx "#include \"cst_clunits.h\"\n")
    (format cofdidx "#include \"%s_clunits.h\"\n" name)
    (format cofdidx "#include \"%s_cltrees.h\"\n" name)

    (format cofdidx "\n\n")
    (set! unitbase_count 0)
    (set! unitbases nil)
    (mapcar
     (lambda (p)
       (if (and (not (string-matches (car p) ".*#.*"))
		(not (member_string (string-before (car p) "_") unitbases)))
	   (begin
	     (format cofdidx "#define unitbase_%s %d\n" 
		     (clunits_normal_phone_name 
                      (string-before (car p) "_"))
                     unitbase_count)
	     (set! unitbases (cons (string-before (car p) "_") unitbases))
	     (set! unitbase_count (+ 1 unitbase_count)))))
     clunits_entries)
    (format cofdidx "\n\n")

    (format cofdidx "const cst_clunit %s_units[] = { \n" name)
    (set! num_entries 0)
    (set! this_ut "")
    (set! this_ut_count 0)
    (mapcar
     (lambda (e)
       (if (not (string-equal this_ut (unit_type (nth 0 e))))
	   (begin
	     (if (> this_ut_count 0)
		 (format cofdh "#define unit_%s_num %d\n"
			 (clunits_normal_phone_name this_ut) 
                         this_ut_count))
	     (format cofdh "#define unit_%s_start %d\n"
		     (clunits_normal_phone_name (unit_type (nth 0 e)))
                     num_entries)
	     (set! this_ut (unit_type (nth 0 e)))
	     (set! this_ut_count 0)
	     ))
       (format cofdh "#define unit_%s %d\n" 
               (clunits_normal_phone_name (nth 0 e)) num_entries)
       (set! num_entries (+ 1 num_entries))
       (set! this_ut_count (+ 1 this_ut_count))
       (format cofdidx "   { /* %s */ unit_type_%s, unitbase_%s, %d,%d, %s, %s },\n"
               (nth 0 e)
               (clunits_normal_phone_name (unit_type (nth 0 e)))
	       (clunits_normal_phone_name (string-before (nth 0 e) "_"))
	       (nth 1 e) ; start_pm
	       (nth 3 e) ; end_pm
	       (clunits_normal_phone_name (nth 4 e)) ; prev
	       (clunits_normal_phone_name (nth 5 e)) ; next
	       ))
     clunits_entries)
    (format cofdidx "   { 0,0,0,0 } };\n\n")
    (format cofdidx "#define %s_num_units %d\n" name num_entries)
    (if (> this_ut_count 0)
	(format cofdh "#define unit_%s_num %d\n"
		this_ut this_ut_count))
    (fclose lofdh)
    (fclose lofdidx)
    (fclose mofdh)
    (fclose mofdidx)
    (fclose cofdh)
    (fclose cofdidx)
    ))

(defvar sts_coeffs_fname nil)

(define (find_pm_pos name entry stsdir mcepdir lofdlpc lofdres mofdmcep)
  "(find_pm_pos entry lpddir)
Diphone dics give times in seconds here we want them as indexes.  This
function converts the lpc to ascii and finds the pitch marks that
go with this unit.  These are written to ofdsts with ulaw residual
as short term signal."
  (let ((start_time (nth 2 entry))
	(phoneboundary_time (nth 3 entry))
	(end_time (nth 4 entry))
	start_pm pb_pm end_pm
	(ltime 0))
    (format t "%l\n" entry)
    (if (not (string-equal (cadr entry) sts_coeffs_fname))
        (begin
          ;; Only load when when we have a new filename
          (set! sts_coeffs
                (load (format nil "%s/%s.sts" stsdir (cadr entry)) t))
          (set! mcep_coeffs
                (load_ascii_track
                 (format nil "%s/%s.mcep" mcepdir (cadr entry))
                 (nth 2 entry) ;; from this start time
                 ))
          (set! sts_info (car sts_coeffs))
          (set! sts_coeffs (cdr sts_coeffs))
          (set! sts_coeffs_fname (cadr entry))
          ))
    (set! ltime 0)
    (set! size_to_now 0)
    ;; Flip through the sts's and mceps to find the right one --
    (while (and sts_coeffs (cdr sts_coeffs)
	    (> (absdiff start_time (car (car sts_coeffs)))
	      (absdiff start_time (car (cadr sts_coeffs)))))
     (set! ltime (car (car sts_coeffs)))
     (set! mcep_coeffs (cdr mcep_coeffs))
     (set! sts_coeffs (cdr sts_coeffs)))
    (set! sample_rate (nth 2 sts_info))
    (set! lpc_order (nth 1 sts_info))
    (set! lpc_min (nth 3 sts_info))
    (set! lpc_range (nth 4 sts_info))
    (set! start_pm pm_pos)
    (while (and sts_coeffs (cdr sts_coeffs)
                mcep_coeffs (cdr mcep_coeffs)
	    (> (absdiff phoneboundary_time (car (car sts_coeffs)))
	       (absdiff phoneboundary_time (car (cadr sts_coeffs)))))
     (output_mcep name (car mcep_coeffs) mofdmcep)
     (output_sts name (car sts_coeffs) (nth 1 entry) lofdlpc lofdres)
     (set! mcep_coeffs (cdr mcep_coeffs))
     (set! sts_coeffs (cdr sts_coeffs)))
    (set! pb_pm pm_pos)
    (while (and sts_coeffs (cdr sts_coeffs)
                mcep_coeffs (cdr mcep_coeffs)
	    (> (absdiff end_time (car (car sts_coeffs)))
	       (absdiff end_time (car (cadr sts_coeffs)))))
     (output_mcep name (car mcep_coeffs) mofdmcep)
     (output_sts name (car sts_coeffs) (nth 1 entry) lofdlpc lofdres)
     (set! mcep_coeffs (cdr mcep_coeffs))
     (set! sts_coeffs (cdr sts_coeffs)))
    (set! end_pm pm_pos)

    (list 
     (car entry)
     (cadr entry)
     start_pm
     pb_pm
     end_pm)))

(define (output_sts name frame fname ofdlpc ofdres)
  "(output_sts frame residual ofd)
Ouput this LPC frame."
  (let ((time (nth 0 frame))
	(coeffs (nth 1 frame))
	(size (nth 2 frame))
	(r (nth 3 frame)))
    (set! times (cons time times))

    (set! l_n lpc_page_pos)
    (while coeffs
     (format ofdlpc " %d," (car coeffs))
     (set! coeffs (cdr coeffs)))
    (format ofdlpc "\n")
    (set! lpc_page_pos (+ 1 lpc_page_pos)) ;; we know the frame size

    (set! r_n res_page_pos)
    (while r
     (format ofdres " %d," (car r))
     (set! res_page_pos (+ 1 res_page_pos))
     (set! r (cdr r)))
    (format ofdres "\n")
    
    (set! lpc_info
          (cons
           (list lpc_page l_n size r_n)
           lpc_info))
    (set! pm_pos (+ 1 pm_pos))
))

(define (lpccoeff_norm c)
  (* (/ (- c lpc_min) (- lpc_max lpc_min))
     65535))

(define (mcepcoeff_norm c)
  (* (/ (- c mcep_min) (- mcep_max mcep_min))
     65535))

(define (output_mcep name frame ofd)
  "(output_mcep frame duration residual ofd)
Ouput this MCEP frame."
  (let ()
    (set! mcep_order (- (length frame) 3))

    (set! frame (cddr frame)) ;; skip the "1"
    (set! frame (cdr frame)) ;; skip the energy
    (set! m_n mcep_page_pos)
    (while frame
     (format ofd " %d," (mcepcoeff_norm (car frame)))
     (set! frame (cdr frame)))
    (format ofd "\n")
    (set! mcep_page_pos (+ 1 mcep_page_pos))

    (set! mcep_info
          (cons
           (list mcep_page m_n)
           mcep_info))

))

(define (load_ascii_track trackfilename starttime)
   "(load_ascii_track trackfilename)
Coverts trackfilename to simple ascii representation."
   (let ((tmpfile (make_tmp_filename))
	 (nicestarttime (if (> starttime 0.100)
			    (- starttime 0.100)
			    starttime))
	 b)
     (system (format nil "$ESTDIR/bin/ch_track -otype est -start %f %s | 
                        awk '{if ($1 == \"EST_Header_End\")
                                 header=1;
                              else if (header == 1)
                                 printf(\"( %%s )\\n\",$0)}'>%s" 
		     nicestarttime trackfilename tmpfile))
     (set! b (load tmpfile t))
     (delete-file tmpfile)
     b))


(define (absdiff a b)
  (let ((d (- a b )))
    (if (< d 0)
	(* -1 d)
	d)))

(define (carttoC_extract_answer_list ofdh tree)
  "(carttoC_extract_answer_list tree)
Get list of answers from leaf node."
;  (carttoC_val_table ofdh 
;		     (car (last (car tree)))
;		     'none)
;  (format t "%l\n" (car tree))
  (cellstovals "cl" (mapcar car (caar tree)) ofdh)
  (format nil "cl_%04d" cells_count))

(define (sort_cltrees trees clcatfn)
  (let ((neworder nil) (ut nil))
    (mapcar
     (lambda (unit)
       (set! ut (unit_type (car unit)))
       (if (not (assoc_string ut neworder))
	   (set! neworder (cons (assoc_string ut trees) neworder))))
     (load clcatfn t))
    (reverse neworder)))

(define (clunits_make_carts cartfn clcatfn name odir cofd)
 "(define clunits_make_carts cartfn name)
Output clunit selection carts into odir/name_carts.c"
 (let (ofd ofdh)
 ;; Set up to dump full list of things at leafs
 (set! carttoC_extract_answer carttoC_extract_answer_list)
 (load cartfn)

 (set! ofd (fopen (format nil "%s/%s_cltrees.c" odir name) "w"))
 (set! ofdh (fopen (format nil "%s/%s_cltrees.h" odir name) "w"))
 (format ofd "\n")
 (format ofd "#include \"cst_string.h\"\n")
 (format ofd "#include \"cst_cart.h\"\n")
 (format ofd "#include \"cst_regex.h\"\n")
 (format ofd "#include \"%s_cltrees.h\"\n" name)

 (set! val_table nil)

 (set! clunits_selection_trees (sort_cltrees clunits_selection_trees clcatfn))

 (mapcar
  (lambda (cart)
    (set! current_node -1)
    (set! feat_nums nil)
    (do_carttoC ofd ofdh 
		(format nil "%s_%s" name 
                        (clunits_normal_phone_name (car cart)))
		(cadr cart)))
  clunits_selection_trees)
 
 (format ofd "\n\n")
 (format ofd "const cst_cart * const %s_carts[] = {\n" name)
 (mapcar
  (lambda (cart)
    (format ofd " &%s_%s_cart,\n" name 
            (clunits_normal_phone_name (car cart)))
    )
  clunits_selection_trees)
 (format ofd " 0 };\n")

 (format cofd "\n\n")
 (format cofd "#define %s_num_unit_types %d\n" 
	 name (length clunits_selection_trees))

 (format cofd "\n\n")
 (format cofd "const cst_clunit_type %s_unit_types[] = {\n" name)
 (set! n 0)
 (mapcar
  (lambda (cart)
    (format ofdh "#define unit_type_%s %d\n" 
	    (clunits_normal_phone_name (car cart)) n)
    (format cofd "  { \"%s\", unit_%s_start, unit_%s_num},\n" 
	    (car cart) 
            (clunits_normal_phone_name (car cart) )
            (clunits_normal_phone_name (car cart)) )
    (set! n (+ 1 n))
    )
  clunits_selection_trees)
 (format cofd "  { NULL, CLUNIT_NONE, CLUNIT_NONE } };\n")

 (fclose ofd)
 (fclose ofdh)

 )
)

(define (clunits_convert_durmodel durmodelfn name odir)

  (set! durmodel (load durmodelfn t))
  (set! phonedurs (cdr (cadr (car (cddr (car durmodel))))))
  (set! zdurtree (cadr (car (cddr (cadr durmodel)))))

  (set! carttoC_extract_answer basic_carttoC_extract_answer)

  (set! dfd (fopen (path-append odir (string-append name "_cl_durmodel.c")) "w"))
  (set! dfdh (fopen (path-append odir (string-append name "_cl_durmodel.h")) "w"))
  (format dfd "/*****************************************************/\n")
  (format dfd "/**  Autogenerated durmodel_cl 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_cl_durmodel.h\"\n\n" name)

  (mapcar
   (lambda (s)
     (format dfd "static const dur_stat dur_state_%s = { \"%s\", %f, %f };\n"
             (clunits_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" (clunits_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 (clunits_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_clunits)