;; ===================================================================================
;; Italian FESTIVAL Modules(IFM)
;; Copyright (C) 2001-2005 by the IFM Development Team
;; at "ISTC-SPFD CNR" and at "ITC-Irst".
;; ===================================================================================
;;	ISTC-SPFD CNR
;;		Istituto di Scienze e Tecnologie della Cognizione
;;		Sezione di Padova "Fonetica e Dialettologia"
;;		Consiglio Nazionale delle Ricerche
;;		Via G. Anghinoni, 10 - 35121 Padova
;;		tel (+39) 049 8274418 - fax (+39) 049 8274416
;;		e-mail: segreteria@pd.istc.cnr.it 
;; 
;;	ITC-irst
;;		Istituto Trentino di Cultura
;;		Centro per la ricerca scientifica e tecnologica 
;;		Via Santa Croce 77 - 38100 Trento ITALIA
;;		tel (+39) 0461-210111 - fax (+39) 0461-980436
;;		e-mail: info@itc.it 
;; ===================================================================================
;; This file is part of IFM.
;; 
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;; 
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;; 
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
;; ===================================================================================
;; Authors:	Piero COSI, ISTC-SPFD CNR, (cosi@pd.istc.cnr.it)
;; 		Carlo DRIOLI
;; 		Graziano TISATO
;; 		Roberto GRETTER, ITC-irst (SSI/MPA), (gretter@itc.it) 
;; 		Fabio TESSER
;; ===================================================================================
;;		WEB:  http://www.pd.istc.cnr.it/TTS/ItalianFESTIVAL
;; ===================================================================================
;;
;;  Support for MBROLA as an external module.
;;  For Windows' users
;;
;; ===================================================================================
;;
;;
;;; You might want to set this in your sitevars.scm
(defvar mbrola_progname "mbrola"
  "mbrola_progname
  The program name for mbrola.")
(defvar mbrola_database "it3"
  "mbrola_database
 The name of the MBROLA database to usde during MBROLA Synthesis.")

(define (MBROLA_Synth utt)
  "(MBROLA_Synth UTT)
  Synthesize using MBROLA as external module.  Basically dump the info
  from this utterance. Call MBROLA and reload the waveform into utt.
  [see MBROLA]"
  (let ((filename (agg_cdp (make_tmp_filename))))
    (save_segments_mbrola utt filename)
    ;(print (string-append mbrola_progname " " 
	;		   mbrola_database " "
	;		   filename " "
	;		   filename ".au"))
    (system (string-append mbrola_progname " " 
			   mbrola_database " "
			   filename " "
			   filename ".au"))
    (utt.import.wave utt (string-append filename ".au"))
    ;(print (string-append filename ".au"))
    (apply_hooks after_synth_hooks utt)
    (delete-file filename)
    (delete-file (string-append filename ".au"))
    utt))

(define (save_segments_mbrola utt filename)
  "(save_segments_mbrola UTT FILENAME)
  Save segment information in MBROLA format in filename.  The format is
  phone duration (ms) [% position F0 target]*. [see MBROLA]"
  (let ((fd (fopen filename "w")) new_seg_name)
    (mapcar
     (lambda (segment) 
     	;Modifica per mappare # in _
     	(if (equal? (item.feat segment 'name)  "#") 
     		(set! new_seg_name "_")
     		(set! new_seg_name (item.feat segment 'name)))
       (save_seg_mbrola_entry 
        ;(item.feat segment 'name)
        new_seg_name
	(item.feat segment 'segment_start)
	(item.feat segment 'segment_duration)
	(mapcar
	 (lambda (targ_item)
	   (list
	    (item.feat targ_item "pos")
	    (item.feat targ_item "f0")))
	 (item.relation.daughters segment 'Target)) ;; list of targets
	fd))
     (utt.relation.items utt 'Segment))
    (fclose fd)))

(define (save_seg_mbrola_entry name start dur targs fd)
  "(save_seg_mbrola_entry ENTRY NAME START DUR TARGS FD)
  Entry contains, (name duration num_targs start 1st_targ_pos 1st_targ_val)."
  (format fd "%s %d " name (nint (* dur 1000)))
  (if targs     ;; if there are any targets
      (mapcar
       (lambda (targ) ;; targ_pos and targ_val
	 (let ((targ_pos (car targ))
	       (targ_val (car (cdr targ))))
	                                  
	   (format fd "%d %d " 
		   (nint (* 100 (/ (- targ_pos start) dur))) ;; % pos of target
		   (nint (parse-number targ_val)))           ;; target value
	   ))
       targs))
  (terpri fd)
  (terpri fd)
)
	
(provide 'mbrola)
