home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Multimed / Multimed.zip / fest-141.zip / festival / lib / ogimarkup-mode.scm < prev    next >
Lisp/Scheme  |  1999-05-30  |  8KB  |  192 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;;                                                                       ;;
  3. ;;;                Centre for Speech Technology Research                  ;;
  4. ;;;                     University of Edinburgh, UK                       ;;
  5. ;;;                       Copyright (c) 1996,1997                         ;;
  6. ;;;                        All Rights Reserved.                           ;;
  7. ;;;                                                                       ;;
  8. ;;;  Permission is hereby granted, free of charge, to use and distribute  ;;
  9. ;;;  this software and its documentation without restriction, including   ;;
  10. ;;;  without limitation the rights to use, copy, modify, merge, publish,  ;;
  11. ;;;  distribute, sublicense, and/or sell copies of this work, and to      ;;
  12. ;;;  permit persons to whom this work is furnished to do so, subject to   ;;
  13. ;;;  the following conditions:                                            ;;
  14. ;;;   1. The code must retain the above copyright notice, this list of    ;;
  15. ;;;      conditions and the following disclaimer.                         ;;
  16. ;;;   2. Any modifications must be clearly marked as such.                ;;
  17. ;;;   3. Original authors' names are not deleted.                         ;;
  18. ;;;   4. The authors' names are not used to endorse or promote products   ;;
  19. ;;;      derived from this software without specific prior written        ;;
  20. ;;;      permission.                                                      ;;
  21. ;;;                                                                       ;;
  22. ;;;  THE UNIVERSITY OF EDINBURGH AND THE CONTRIBUTORS TO THIS WORK        ;;
  23. ;;;  DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING      ;;
  24. ;;;  ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT   ;;
  25. ;;;  SHALL THE UNIVERSITY OF EDINBURGH NOR THE CONTRIBUTORS BE LIABLE     ;;
  26. ;;;  FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES    ;;
  27. ;;;  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN   ;;
  28. ;;;  AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,          ;;
  29. ;;;  ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF       ;;
  30. ;;;  THIS SOFTWARE.                                                       ;;
  31. ;;;                                                                       ;;
  32. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33. ;;;
  34. ;;;  An example tts text mode for reading OGI's CSLU toolkit mark up
  35. ;;;
  36. ;;;  Note not all tokens do something in festival but  all are removed 
  37. ;;;  from the actual text 
  38. ;;;
  39.  
  40. (defvar ogimarkup_eou_tree 
  41. '((n.name matches "<.*")
  42.   ((1))
  43. ((n.whitespace matches ".*\n.*\n\\(.\\|\n\\)*") ;; A significant break (2 nls)
  44.   ((1))
  45.   ((punc in ("?" ":" "!"))
  46.    ((1))
  47.    ((punc is ".")
  48.     ;; This is to distinguish abbreviations vs periods
  49.     ;; These are heuristics
  50.     ((name matches "\\(.*\\..*\\|[A-Z][A-Za-z]?[A-Za-z]?\\|etc\\)")  ;; an abbreviation
  51.      ((n.whitespace is " ")
  52.       ((0))                  ;; if abbrev single space isn't enough for break
  53.       ((n.name matches "[A-Z].*")
  54.        ((1))
  55.        ((0))))
  56.      ((n.whitespace is " ")  ;; if it doesn't look like an abbreviation
  57.       ((n.name matches "[A-Z].*")  ;; single space and non-cap is no break
  58.        ((1))
  59.        ((0)))
  60.       ((1))))
  61.     ((0)))))))
  62.  
  63. (define (ogimarkup_init_func)
  64.  "Called on starting ogimarkup text mode."
  65.  (set! ogimarkup_in_tag nil)
  66.  (set! ogimarkup_tagtokens "")
  67.  (set! ogimarkup_previous_t2w_func token_to_words)
  68.  (set! english_token_to_words ogimarkup_token_to_words)
  69.  (set! token_to_words ogimarkup_token_to_words)
  70.  (set! ogimarkup_previous_eou_tree eou_tree)
  71.  (set! eou_tree ogimarkup_eou_tree))
  72.  
  73. (define (ogimarkup_exit_func)
  74.  "Called on exit ogimarkup text mode."
  75.  (Parameter.set 'Duration_Stretch 1.0)
  76.  (set! token_to_words ogimarkup_previous_t2w_func)
  77.  (set! english_token_to_words ogimarkup_previous_t2w_func)
  78.  (set! eou_tree ogimarkup_previous_eou_tree))
  79.  
  80. (define (ogimarkup_token_to_words token name)
  81.   "(ogimarkup_token_to_words token name)
  82. OGI markup specific token to word rules.  Tags may have optional
  83. argument e.g. <slow> or <slow 0.6> which means the tag may be over
  84. a number of tokens."
  85.   (let (tag (arg nil) (rval nil))
  86.   (cond
  87.    ((string-matches name "<.*")
  88.     (set! ogimarkup_tagtokens "")
  89.     (set! tag (string-after name "<"))
  90.     (if (string-matches tag ".*>$")
  91.     (set! tag (string-before tag ">"))
  92.     (if (string-matches (set! arg (item.feat token "n.name"))
  93.                 ".*>$")
  94.         (set! arg (string-before arg ">"))))
  95.     (set! ogimarkup_in_tag tag)
  96.     (cond
  97.      ((string-equal tag "slow")
  98.       (Parameter.set 'Duration_Stretch 1.3))
  99.      ((string-equal tag "SLOW")
  100.       (Parameter.set 'Duration_Stretch 2.0))
  101.      ((string-equal tag "normal")
  102.       (Parameter.set 'Duration_Stretch 1.0))
  103.      ((string-matches tag "FAST")
  104.       (Parameter.set 'Duration_Stretch 0.5))
  105.      ((string-matches tag "fast")
  106.       (Parameter.set 'Duration_Stretch 0.8))
  107.      ((string-matches tag"spell")
  108.       ;; This ain't really right as we'll get an utterance break here
  109.       (set! rval (symbolexplode arg)))
  110.      ((string-matches tag "phone")
  111.       ;; This ain't really right as we'll get an utterance break here
  112.       (item.set_feat token "token_pos" "digits")  ;; canonical phone number
  113.       (set! rval (ogimarkup_previous_t2w_func token arg)))
  114.      ((string-matches tag "male")
  115.       (if (and (member 'OGIresLPC *modules*)
  116.            (symbol-bound? 'voice_aec_diphone))
  117.       (voice_aec_diphone)
  118.       (voice_don_diphone)))
  119.      ((string-matches tag "Male")
  120.       (if (and (member 'OGIresLPC *modules*)
  121.            (symbol-bound? 'voice_mwm_diphone))
  122.       (voice_mwm_diphone)
  123.       (voice_ked_diphone)))
  124.      ((string-matches tag "MALE")
  125.       (if (and (member 'OGIresLPC *modules*)
  126.            (symbol-bound? 'voice_jph_diphone))
  127.       (voice_jph_diphone)
  128.       (voice_rab_diphone)))
  129.      ((string-matches tag "FT")
  130.       t)  ;; do nothing until the end of this tag
  131.      ((string-matches (downcase tag) "female") 
  132.       ;; only one female voice so map female Female FEMALE to it
  133.       (if (and (member 'OGIresLPC *modules*)
  134.            (symbol-bound? 'voice_tll_diphone))
  135.       (voice_tll_diphone)
  136.       (voice_don_diphone))))
  137.     (if (string-matches name ".*>$")
  138.     (set! ogimarkup_in_tag nil))
  139.     rval ;; mostly nil
  140.     )
  141.    ((string-matches name ".*>$")
  142.     (set! ogimarkup_tagtokens 
  143.       (string-append
  144.        ogimarkup_tagtokens
  145.        (ogimarkup_get_token_string token t)))  ;; delete final >
  146.     (if (string-equal ogimarkup_in_tag "FT")
  147.     (ogimarkup_festival_eval ogimarkup_tagtokens))
  148.     (set! ogimarkup_in_tag nil)   ;; end of tag
  149.     nil)
  150.    (ogimarkup_in_tag
  151.     (set! ogimarkup_tagtokens
  152.       (string-append
  153.        ogimarkup_tagtokens
  154.        (ogimarkup_get_token_string token nil)))
  155.     nil)                          ;; still in tag
  156.    (t  ;; for all other cases
  157.      (ogimarkup_previous_t2w_func token name)))))
  158.  
  159. (set! tts_text_modes
  160.    (cons
  161.     (list
  162.       'ogimarkup   ;; mode name
  163.       (list         ;; ogimarkup mode params
  164.        (list 'init_func ogimarkup_init_func)
  165.        (list 'exit_func ogimarkup_exit_func)))
  166.     tts_text_modes))
  167.  
  168. (define (ogimarkup_get_token_string token delend)
  169.   "(ogimarkup_get_token_string TOKEN DELEND)
  170. return string for token including whitespace and punctuation.  If DELEND
  171. is true remove > from the name."
  172.   (string-append
  173.    (item.feat token "whitespace")
  174.    (item.feat token "prepunctuation")  
  175.    (if delend
  176.        (string-before 
  177.     (item.feat token "name") ">")
  178.        (item.feat token "name"))
  179.    (if (string-equal "0" (item.feat token "punc"))
  180.        ""
  181.        (item.feat token "punc"))))
  182.  
  183. (define (ogimarkup_festival_eval tagtokens)
  184. "(ogimarkup_festival_eval TAGTOKENS
  185. Take a string of the tokens within the tag and read an s-expression from
  186. it and then evaluate it."
  187.   (let ((com "") (command nil))
  188.     (set! command (read-from-string tagtokens))
  189.     (eval command)))
  190.  
  191. (provide 'ogimarkup-mode)
  192.