;; Aggiungo la fase ApmlPostProcessing al pipeline di sintesi
;; richiede 
;;-(require 'apml) prima della sintesi
;;-variabile ApmlPost_Method settata 
;;per funzionare.


;Riconoscimento automatico del documento, necessario
; nel caso in cui si usi Festival da riga di comando:
;     festival --tts nomefile.apml

(set! auto-text-mode-alist
  (cons
    (cons "\\.apml$" 'apml)
    auto-text-mode-alist))


; Funzione che chiama un appropriato modulo/funzione per il "mapping"
; tra i vari livelli dei tag.

(define (EmotivePostProcessing utt)
  "(EmotivePostProcessing utt)
  Permettere di scegliere tra diversi metodi per il post-processing
  di apml e di vsml. Correntemente solo un metodo è disponibile,
  quello di prova."
  (let ((rval (apply_method 'Emotive_Post_Method utt)))
    (Parameter.get 'Emotive_Post_Method)
    (cond
      (rval rval) ; ??
      ((eq 'Emotive_One (Parameter.get 'Emotive_Post_Method))
       (Emotive_One utt))
      ((eq 'Prova (Parameter.get 'Emotive_Post_Method))
       (Apml_Tags utt))
      ((eq 'None (Parameter.get 'Emotive_Post_Method))
       utt)
      (t ;default
       (Apml_Tags utt)))))




;;Definizione del nuovo text mode. Vedere examples/th-mode.scm.
; Dichiarazione del nome e delle funzioni di inizializzazione e uscita.

(define (apml_init_func)
 "Chiamata all'avvio del modo apml"
 (print 'chiamata-apml_init)
 (apml_init_globals)
 (set! apml_previous_after_analysis_hooks after_analysis_hooks)
 (set! after_analysis_hooks (list EmotivePostProcessing))

; (set! apml_previous_elements xxml_elements)
; (set! xxml_elements apml_elements)
)

(define (apml_exit_function)
 "Chiamata all'uscita dal modo apml"
 (set! after_analysis_hooks apml_previous_after_analysis_hooks)
; (set! xxml_elements apml_previous_elements)
)

;Dichiarazione del text-mode; usata per (tts 'nomefile.apml 'apml)
(set! tts_text_modes
   (cons
    (list
      'apml
      (list
       (list 'init_func apml_init_func)
       (list 'exit_func apml_exit_function)
       '(analysis_type xml)
      )
    )
    tts_text_modes
   )
)

; Funzioni per la gestione dello stack delle features: diversamente da C++
; qui non è possibile agire sulle singole word, ma è necessario applicare
; di volta in volta tutte e sole le features derivate dall'insieme dei tags
; che "contengono" le parole...

; Funzioni copiate da apml.scm per la sintesi usando apml.cc.

; Rimane da chiarire il legame tra (tts 'nomefile.apml 'apml)  e ciò che avviene
; aprendo un file .apml. Nel primo caso vengono usati il text-mode e la variabile
; apml_elements. Nel secondo (utt.load 'nomefile.apml) i files  speech-tools/l
;ing-class/EST_UtteranceFile.cc e apml.cc.

;; Emotive sythesis wrappers.

(define (emotion_file_synth filename)
  "(emotion_file_synth filename)
  Synthesis an apml file."
  (let ((utt (Utterance Concept nil)))
    (utt.load utt filename)
    (utt.synth utt)))

; Funzioni per Debug.
(define (apml_print_words utt)
"(apml_print_words utt)
  Pretty print APML words with associated informations."
  (mapcar
   (lambda (x)
     (format t "%s (" (item.name x))
     (apml_pww_affective x)
     (format t ")\n"))
   (utt.relation.items utt 'Word))
  t)

(define (apml_pww_affective item)
  (let ((p (item.relation.parent item 'Affective)))
    (if p (apml_ppw_list (item.features p)))))

(define (vsml_print_words utt)
"(vsml_print_words utt)
  Pretty print VSML words with associated informations."
  (mapcar
   (lambda (x)
     (format t "%s (" (item.name x))
     (apml_pww_voqual x)
     (apml_pww_signalctrl x)
     (format t ")\n"))
   (utt.relation.items utt 'Word))
  t)

(define (apml_pww_voqual item)
  (let ((p (item.relation.parent item 'Voqual)))
    (if p (apml_ppw_list (item.features p)))))

(define (apml_pww_signalctrl item)
;;ritorna il genitore di item in Miotag
  (let ((p (item.relation.parent item 'Signalctrl)))
  ;;se genit != 0 ne stampa le features(nome, attributi, attr.val)
    (if p (apml_ppw_list (item.features p)))))


(define (apml_ppw_list l)
  (mapcar
   (lambda (x)
     (format t " %s" x))
   (flatten l)))
   
(define (emotion_plot r f u)
"(emotive_plot r f)
Disegna l'andamento di una certa feature f in una Relazione r nell'Utterance u."
; (let ((item (utt.relation.first u r))
;       (fd (fopen "/tmp/tmpplot" "w"))
;       )
 (set! fd (fopen "/tmp/tmpplot" "w"))
 (set! item (utt.relation.items u r))
; (print (item.features item))
 (mapcar
   (lambda (x)
     (set! val (item.feat x f))
     (if (not(equal? val 0)) (format fd "%3.5f\n" val))
   ) item)
 (fclose fd)
 ;Da sistemare...!
(set! fd (fopen "/tmp/plotcmd" "w"))
(format fd "set ylabel '%s\n" f)
(format fd "set style data linespoints\n")
(format fd "set xlabel 'Elements\n")
(format fd "plot '/tmp/tmpplot")
(fclose fd)
(system "gnuplot -persist /tmp/plotcmd")
 t);)
 

(provide 'apml-mode)
