;; ===================================================================================
;; 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
;; ===================================================================================
;;
;;  Definition of some ITALIAN SPECIFIC MODULES
;;
;; ===================================================================================
;;
;;
(define (Function_Word utt)
"Crea la features FW (Function_Word)  nella relation Word"
(let (w w1)
(set! w (utt.relation.first utt 'Word))
(while w
	;(print (item.name w))
	(if (string-matches (item.name w) ".+'.+") ;caso parole con apostrofi
      	 (let ()
      		(set! w1 (string-append (string-before (item.name w) "'") "'")) 
      		(item.set_feat w 'FW (italian_fw_gpos w1 italian_guess_pos)))
      	(item.set_feat w 'FW (italian_fw_gpos (item.name w) italian_guess_pos)))
	(set! w (item.next w)))))

(define (Phrase_Type utt)
"Crea la features type nella relation Phrase"
(let (p pu)
(set! p (utt.relation.first utt 'Phrase))
(while p
	(set! pu (item.feat p "R:Phrase.daughtern.R:Token.parent.punc"))
	(if (string-equal pu ".")
	(item.set_feat p 'type "dichiarativa"))
	(if (string-equal pu ";")
	(item.set_feat p 'type "completativa"))
	(if (string-equal pu ":")
	(item.set_feat p 'type "esplicativa"))
	(if (string-equal pu ",")
	(item.set_feat p 'type "pausativa"))
	(if (string-equal pu "?")
	(item.set_feat p 'type "interrogativa"))
	(if (string-equal pu "!")
	(item.set_feat p 'type "esclamativa"))
	(if (or (string-equal pu "..") (string-equal pu "..."))
	(item.set_feat p 'type "sospensiva"))
	(if (or (string-equal pu "\"") (string-equal pu ")") (string-equal pu "\]") (string-equal pu "\}"))
	(item.set_feat p 'type "riportativa"))
	(set! p (item.next p)))))


(define (Position_FW utt)
"Crea la features position FW (Function_Word) nella relation IntEvent"
(let ( P_gr n P_grP S I )

(utt.relation.create utt 'GrRespiro)
(utt.copy_relation utt 'IntEvent 'GrRespiro) ;;questa copia in realtà deve prendere solo primafuncionW, prima content e il primo accentede....
;(print "fase 1")

(set! P_gr (utt.relation.first utt 'GrRespiro))
(while P_gr 
	(set! n (item.name P_gr))
	(if (or (string-equal n "Accented") (string-equal n "altreFW"))   
		(let () 
			(set! P_grP (item.prev P_gr))
			(item.relation.remove P_gr 'GrRespiro)
			(set! P_gr P_grP)
			)
		)
	(set! P_gr (item.next P_gr))
	)
;(print "fase 2")
(set! P_gr (utt.relation.first utt 'GrRespiro))
(set! S (utt.relation.first utt 'Syllable))
(set! I (item.relation.parent P_gr 'Intonation))
(item.append_daughter P_gr S)
(if (item.next P_gr)
		(set! I (item.relation.parent (item.next P_gr) 'Intonation))
		;nel caso che sia l'utimo item non fa nulla (print "fine....")
		)
		
(set! S (item.next S))
		
		
(while S
	(if (equal? (item.relation I 'Intonation) (item.relation S 'Intonation))
	;;Vecchia condizione non compatibile con 131:
	;;(string-equal (item.feat I 'id) (item.feat S 'id))
		(let ()
		
		
		(set! P_gr (item.next P_gr))
		(item.append_daughter P_gr S)
		(if (item.next P_gr)
			(set! I (item.relation.parent (item.next P_gr) 'Intonation))
			;nel caso che sia l'utimo item non fa nulla (print "fine....")
			)
		(set! S (item.next S))
		)
		(while   (and S (not (equal? (item.relation I 'Intonation) (item.relation S 'Intonation))))
		;(print "f3")
		(item.append_daughter P_gr S)
		(set! S (item.next S)))))))

(define (Word_dopo_num utt)
"Dopo il modulo numerico (e solo in questo caso) che salva anche la trascrizione sposta le relation in modo appropiato"
(let  (p_token w wn word_str true_word_str trasc_word_str)
(set! p_token (utt.relation.first utt 'Token)) 
(while p_token
	(if  (string-equal (item.feat p_token 'pos) "Num+Alfa")
		(let ((w (item.daughter1 p_token))(wn (item.next (item.daughtern p_token))))
		;(print "Token Num+Alfa")
		(while (not (equal? w wn))
		;(print "non uguale")		
		(set! word_str (item.name w))
			(if (string-matches word_str ".* -T.*")
				
				(let ()
					;(print "c'è il -T")	
					(set! true_word_str (string-before word_str " -T")) 
					(set! trasc_word_str (string-after word_str " -T ")) 
					;(print true_word_str)
					(item.set_name w true_word_str)
					(item.set_feat w "TRA_NUM" trasc_word_str);da togliere in futuro
					)
				)
			(set! w (item.next w))
			)
		))
	 
	(set! p_token (item.next p_token)))))

(define (Word_split_pos utt)
"Prende il pos complesso della relation word (lessico) e lo divide in tPOS=True POS e GEN=Genere"
(let  (p_word)
(set! p_word (utt.relation.first utt 'Word)) 
(while p_word 
	(if  (string-matches (item.feat p_word 'pos) ".+\-.+")
		(let () 
		(item.set_feat p_word "tPOS" (string-before (item.feat p_word 'pos) "\-"))
		(item.set_feat p_word "GEN" (string-after (item.feat p_word 'pos) "\-"))
		)
		(item.set_feat p_word "tPOS" (item.feat p_word 'pos))
		)

	(set! p_word (item.next p_word))))
)

(define (Token_punct utt)
"Mette a posto la punteggiatura degli acronimi"
(let  (p_token)
(set! p_token (utt.relation.first utt 'Token)) 
(while p_token
	(if  (string-equal (item.feat p_token 'pos) "Acronimo") ;;mette a posto la punteggiatura degli acronimi togliendo il primo punto 
		(let (punt)
		(set! punt (string-after (item.feat p_token 'punc) "."))
		(item.set_feat p_token 'punc punt)
		)) 
	(set! p_token (item.next p_token)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (My_Pauses utt)
"Inserisce pausa prima della prima FW"
(print (utt.relation_tree utt 'Segment))
(set! s (utt.relation.first utt 'Syllable))
(while s 
	;(print s)
	;(print (item.feat s 'R:GrRespiro.parent.name))
	;(print (item.feat s 'id))
	;;;DA sostituire id se vuoi la compatibilità con 131
	(if (and (not (eq? (item.feat s 'syl_in ) 0)) (equal? (item.feat s 'R:GrRespiro.parent.daughter1.id) (item.feat s 'id)) (equal? (item.feat s 'R:GrRespiro.parent.name) "primaFW"))
		(let ()
			(print "si!")
			(insert_pause utt (item.relation.parent (item.prev s) 'SylStructure))
			)
		)
		(set! s (item.next s))
	)
)





(define (MAP_segments utt)
  "(MAP_segments utt UTT)
  Mappa difoni prendendo come riferimento il file ita_map.scm dove se vi sono i difoni da mappare."
  (let ((item_segs_list (utt.relation.items utt 'Segment)) )
   (while (cdr item_segs_list)
    (set! s1 (car item_segs_list))
    (set! s2 (car (cdr item_segs_list)))
    (let ((ita_maps ita_map))
      ;Modifica per mappare coppie di foni
       (while ita_maps
         
     	(if (and (equal? (item.feat s1 'name)  (string-append (car (car ita_maps)))) (equal? (item.feat s2 'name) (string-append (car (cdr (car ita_maps))))))
     	   (let ()
     	    (item.set_name s1 (car (car (cdr (cdr (car ita_maps))))))
     	    (item.set_name s2 (car (cdr (car (cdr (cdr (car ita_maps)))))))
     	    ))
     	 (set! ita_maps (cdr ita_maps))
     	 ))
     	(set! item_segs_list (cdr item_segs_list))
     	)
     )
    )
     	











;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (string-remove string1 string2)
"(string-remove STRING1 STRING2)
Remove all instances of STRING2 in STRING1 and return the result."
    (begin
       (while (and (not (equal? string1 string2))
                        (or (not (equal? (string-before string1 string2) ""))
                            (not (equal? (string-after  string1 string2) ""))
                        )
               )
              (let (before after)
                  (set! before (string-before string1 string2))
                  (set! after  (string-after string1 string2))
    			(set! string1 (string-append before after))
              )
        )
	  (if (equal? string1 string2) "" string1)
    )
)

(define (Classic_Pauses_mB utt)
  "(Pauses UTT)
Predict pause insertion."
  (let ((words (utt.relation.items utt 'Word)) lastword tpname)
    (if words
	(begin
	  (insert_initial_pause utt)   ;; always have a start pause
	  (set! lastword (car (last words)))
	  (mapcar
	   (lambda (w)
	     (let ((pbreak (item.feat w "pbreak"))
		   (emph (item.feat w "R:Token.parent.EMPH")))
	       (cond
		((or (string-equal "mB" pbreak)
		     (string-equal "B" pbreak)
		     (string-equal "BB" pbreak))
		 (insert_pause utt w))
;		((string-equal emph "1")
;		 (insert_pause utt w))
		((equal? w lastword)
		 (insert_pause utt w)))))
	   words)
	  ;; The embarassing bit.  Remove any words labelled as punc or fpunc
	  (mapcar
	   (lambda (w)
	     (let ((pos (item.feat w "pos")))
	       (if (or (string-equal "punc" pos)
		       (string-equal "fpunc" pos))
		   (let ((pbreak (item.feat w "pbreak"))
			 (wp (item.relation w 'Phrase)))
		     (if (and (string-matches pbreak "BB?")
			      (item.relation.prev w 'Word))
			 (item.set_feat 
			  (item.relation.prev w 'Word) "pbreak" pbreak))
		     (item.relation.remove w 'Word)
		     ;; can't refer to w as we've just deleted it
		     (item.relation.remove wp 'Phrase)))))
	   words)))
  utt))




(provide 'italian_module)