;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<--OGI-->;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                        ;;
;;             Center for Spoken Language Understanding                   ;;
;;        Oregon Graduate Institute of Science & Technology               ;;
;;                         Portland, OR USA                               ;;
;;                        Copyright (c) 2000                              ;;
;;                                                                        ;;
;;      This module is not part of the CSTR/University of Edinburgh       ;;
;;               release of the Festival TTS system.                      ;;
;;                                                                        ;;
;;  In addition to any conditions disclaimers below, please see the file  ;;
;;  "license_ogi_tts.txt" distributed with this software for information  ;;
;;  on usage and redistribution, and for a DISCLAIMER OF ALL WARRANTIES.  ;;
;;                                                                        ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<--OGI-->;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Various postlexical hack rules for diphone synthesizer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; resyllabify
;;
(define (resyllabify_hack utt)
  "(resyllabify_hack UTT)
Resyllabify using hacked Phone.cc"
  (set! ss nil)
  (set! sItems nil)
  (mapcar
   (lambda (seg)
     (if (not (string-equal (item.name seg) "pau"))
	 (begin
	   (set! ss (append ss (list (intern (item.name seg)))))
	   (set! sItems (append sItems (list seg)))
	   ))
     (if (not (in_same_word seg (item.next seg)))
	 (begin 
	   (set! resyll (lex.syllabify.phstress ss))
;;	   (print resyll)
	   ;; loop through syllables in this word
	   (mapcar
	    (lambda (wordsyl)
;;	      (print wordsyl)
	      
	      ;; loop through segments in this syllable
	      (set! vfoundyet nil)
	      (mapcar
	       (lambda (wordseg)
		 (set! segItem (car sItems))
		 (set! sItems (cdr sItems))
		 
		 (if (not vfoundyet)
		     (if (string-equal (item.feat segItem 'ph_vc) "+")
			 (set! vfoundyet t)
			 ))
		 (if vfoundyet
		     (item.set_feat segItem 'ogi_onsetcoda "coda")
		     (item.set_feat segItem 'ogi_onsetcoda "onset")))
	       (car wordsyl)))
	    resyll)
	   
	   
	   (set! ss nil)
	   (set! sItems nil)
	   )))
   (utt.relation.items utt 'Segment))
  utt)





;;
;; "vowel -- light r"
;;
(define (lightR_hack utt)
  "(lightR_hack UTT)
Change syllable-final \"r\" to light R (for worldbet only)"
  (mapcar
   (lambda (seg)
     (if (string-equal (item.feat seg 'name)  "9r")
	 (begin 
	   (if (string-equal (item.feat seg 'ogi_onsetcoda ) "coda")
	       (begin 
		 (print (string-append (item.name seg) " changed to 8r"))
		 (item.set_feat seg 'allophone_name "8r"))
	       ))))
   (utt.relation.items utt 'Segment))
  utt)

;;
;; /oU-9r/ --> /or/ when preceded and followed by consonants 
;;
(define (OR_hack utt)
  "(OR_hack UTT)
Change \"oU-9r\" to \"or\" when preceded and followed by consonants"
  (mapcar
   (lambda (seg)
     (if (string-equal (item.feat seg 'ogi_onsetcoda ) "coda")
	 (if (and 
	      (string-equal (item.feat seg 'name)  "9r")
	      (string-equal (item.feat seg 'p.name)  "oU")
	      (string-equal (item.feat seg 'n.ph_vc)  "-")
	      (not (string-equal (item.feat seg 'n.name)  "pau")) ;; temp
	      (string-equal (item.feat seg 'pp.ph_vc)  "-"))
	     (begin 
	       (print (string-append (item.name seg) " eating oU"))
	       (print " ")
	       (item.set_name seg "or")
	       (item.delete (item.prev seg))
	       ))))
   (utt.relation.items utt 'Segment))
  utt)

;;
;; "vowel -- dark l"
;;
(define (darkL_hack utt)
  "(darkL_hack UTT)
Change syllable-final \"l\" to dark L (for worldbet only)"
  (mapcar
   (lambda (seg)
     (if (string-equal (item.feat seg 'name)  "l")
	 (begin 
	   (if (string-equal (item.feat seg 'ogi_onsetcoda ) "coda")
	       (begin 
		 (print (string-append (item.name seg) " changed to l2"))
		 (item.set_feat seg 'allophone_name "l2"))
	       ))))
   (utt.relation.items utt 'Segment))
  utt)


;;
;; plosive hacks
;;
(define (plosive_hacks utt)
  "(plosive_hacks UTT)
Change to allphones of plosives"
  (mapcar
   (lambda (seg)
     (cond

      ;;;;;;;;;;;;;;;; t ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ((string-equal (item.feat seg 'name)  "t") 
         (begin 
	   (if (string-equal (item.feat seg 'ogi_onsetcoda ) "onset")
	       (begin
		 (cond
                  ;;;;;;;;;;; 
		  ((string-equal (item.feat seg 'n.name) "9r")
		   (if (string-equal (item.feat seg 'p.name) "s")
		     (begin 
		       (item.set_feat seg 'allophone_name "t>9r<s"))
		     (begin 
		       (item.set_feat seg 'allophone_name "t>9r"))))

                  ;;;;;;;;;;; 
		  ((string-equal (item.feat seg 'n.name) "w")
		     (begin 
		       (item.set_feat seg 'allophone_name "t>w")))
		  
                  ;;;;;;;;;;; 
		  ((string-equal (item.feat seg 'p.name) "s")
		     (begin 
		       (item.set_feat seg 'allophone_name "t<s")))

		  )))))
	 
      ;;;;;;;;;;;;;;;; p ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	 ((string-equal (item.feat seg 'name)  "p") 
         (begin 
	   (if (string-equal (item.feat seg 'ogi_onsetcoda ) "onset")
	       (begin
		 (cond
                  ;;;;;;;;;;; 
		  ((string-equal (item.feat seg 'n.name) "9r")
		   (if (string-equal (item.feat seg 'p.name) "s")
		     (begin 
		       (item.set_feat seg 'allophone_name "p>9r<s")
		       )
		     (begin 
		       (item.set_feat seg 'allophone_name "p>9r"))))

                  ;;;;;;;;;;; 
		  ((string-equal (item.feat seg 'n.name) "w")
		     (begin 
		        (item.set_feat seg 'allophone_name "p>w")))

                  ;;;;;;;;;;; 
		  ((string-equal (item.feat seg 'n.name) "l")
		   (if (string-equal (item.feat seg 'p.name) "s")
		       (begin 
		       (item.set_feat seg 'allophone_name "p>l<s"))
		       (begin 
			 (item.set_feat seg 'allophone_name "p>l"))))

		  )))))

      ;;;;;;;;;;;;;;;; k ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	 ((string-equal (item.feat seg 'name)  "k") 
	  (begin 
	    (if (string-equal (item.feat seg 'ogi_onsetcoda ) "onset")
		(begin
		  (cond
		   
                  ;;;;;;;;;;; 
		   ((string-equal (item.feat seg 'n.name) "9r")
		    (begin 
		      (item.set_feat seg 'allophone_name "k>9r")))
		   
                  ;;;;;;;;;;; 
		   ((string-equal (item.feat seg 'n.name) "w")
		    (begin 
		      (item.set_feat seg 'allophone_name "k>w")))
		   
                  ;;;;;;;;;;; 
		   ((string-equal (item.feat seg 'n.name) "l")
		    (begin 
		      (item.set_feat seg 'allophone_name "k>l")))

		   )))))

	 ))
   (utt.relation.items utt 'Segment))
  utt)


;;
;; flaps
;;
(define (flap_hack utt)
  "(flap_hack UTT)
Change t to dx when before an unstressed vowel"
  (mapcar
   (lambda (seg)
     (if (string-equal (item.feat seg 'name)  "t")
	 (begin 
	   (if (and 
		;; prev is stressed vowel in same word
		(and 
		 (string-equal (item.feat (item.prev seg) 'ph_vc) "+")
		 (eq (item.feat (item.prev seg) 'R:SylStructure.parent.stress) 1)
		 (in_same_word seg (item.prev seg))
		 )

		;; next is unstressed vowel in same word
		(and 
		 (string-equal (item.feat (item.next seg) 'ph_vc) "+")
		 (equal? (item.feat (item.next seg) 'R:SylStructure.parent.stress) 0)
		 (in_same_word seg (item.next seg))
		 )

		;; and not -/en/ like mitten, button, ...		
		(not 
		 (string-equal (item.feat seg 'nn.ph_ctype) "n")))

		(begin 
		 (item.set_feat seg 'allophone_name "dx"))
	       ))))
   (utt.relation.items utt 'Segment))
  utt)


;;
;;
;;
(define (in_same_word seg1 seg2)
  "(in_same_word SEG1 SEG2)
Return TRUE if these segments are in same word, NIL else."
  (if (and seg1 seg2)
      (if (equal?
	   (item.feat seg1 'R:SylStructure.parent.parent.id)
	   (item.feat seg2 'R:SylStructure.parent.parent.id))
	  t
	  nil)
      nil)
  )

(provide 'ogi_hack)


