home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Multimed / Multimed.zip / fest-141.zip / festival / lib / voices.scm < prev    next >
Lisp/Scheme  |  1999-06-17  |  10KB  |  274 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. ;;; Preapre to access voices. Searches down a path of places.
  35. ;;;
  36. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37.  
  38. (define current-voice nil
  39.   "current-voice
  40.    The name of the current voice.")
  41.  
  42. ;; The path to search for voices is created from the load-path with
  43. ;; an extra list of directories appended.
  44.  
  45. (defvar system-voice-path '("/projects/festival/lib/voices-1.4/")
  46.   "system-voice-path
  47.    Additional directory not near the load path where voices can be
  48.    found, this can be redefined in lib/sitevars.scm if desired.")
  49.  
  50. (defvar voice-path 
  51.   (remove-duplicates
  52.    (append (mapcar (lambda (d) (path-append d "voices/")) load-path)
  53.        (mapcar (lambda (d) (path-as-directory d)) system-voice-path)
  54.        ))
  55.  
  56.   "voice-path
  57.    List of places to look for voices. If not set it is initialised from
  58.    load-path by appending \"voices/\" to each directory with 
  59.    system-voice-path appended.")
  60.  
  61. ;; Declaration of voices. When we declare a voice we record the
  62. ;; directory and set up an autoload for the vocie-selecting function
  63.  
  64. (defvar voice-locations ()
  65.   "voice-locations
  66.    Association list recording where voices were found.")
  67.  
  68. (defvar voice-location-trace nil
  69.   "voice-location-trace
  70.    Set t to print voice locations as they are found")
  71.  
  72. (define (voice-location name dir doc)
  73.   "(voice-location NAME DIR DOCSTRING)
  74.    Record the location of a voice. Called for each voice found on voice-path.
  75.    Can be called in site-init or .festivalrc for additional voices which
  76.    exist elsewhere."
  77.   (let ((func_name (intern (string-append "voice_" name)))
  78.     )
  79.  
  80.     (set! name (intern name))
  81.     (set! voice-locations (cons (cons name dir) voice-locations))
  82.     (eval (list 'autoload func_name (path-append dir "festvox/" name) doc))
  83.     (if voice-location-trace
  84.     (format t "Voice: %s %s\n" name dir)
  85.     )
  86.     )
  87.   )
  88.  
  89. ;; Voices are found on the voice-path if they are in directories of the form
  90. ;;        DIR/LANGUAGE/NAME
  91.  
  92. (define (search-for-voices)
  93.   "(search-for-voices)
  94.    Search down voice-path to locate voices."
  95.  
  96.   (let ((dirs voice-path)
  97.     (dir nil)
  98.     languages lanuguage
  99.     voices voicedir voice
  100.     )
  101.     (while dirs
  102.      (set! dir (car dirs))
  103.      (setq languages (directory-entries dir t))
  104.      (while languages
  105.        (set! language (car languages))
  106.        (set! voices (directory-entries (path-append dir language) t))
  107.        (while voices
  108.      (set! voicedir (car voices))
  109.      (set! voice (path-basename voicedir))
  110.      (if (string-matches voicedir ".*\\..*")
  111.          nil
  112.          (voice-location 
  113.           voice 
  114.           (path-as-directory (path-append dir language voicedir))
  115.           "voice found on path")
  116.          )
  117.      (set! voices (cdr voices))
  118.      )
  119.        (set! languages (cdr languages))
  120.        )
  121.      (set! dirs (cdr dirs))
  122.      )
  123.     )
  124.   )
  125.  
  126. (search-for-voices)
  127.  
  128. (define (current_voice_reset)
  129. "(current_voice_reset)
  130. This function is called at the start of defining any new voice.
  131. It is design to allow the previous voice to reset any global
  132. values it has messed with.  If this variable value is nil then
  133. the function wont be called.")
  134.  
  135. (define (voice_reset)
  136. "(voice_reset)
  137. This resets all variables back to acceptable values that may affect
  138. voice generation.  This function should always be called at the
  139. start of any function defining a voice.  In addition to reseting
  140. standard variables the function current_voice_reset will be called.
  141. This should always be set by the voice definition function (even
  142. if it does nothing).  This allows voice specific changes to be reset
  143. when a new voice is selection.  Unfortunately I can't force this
  144. to be used."
  145.    (Parameter.set 'Duration_Stretch 1.0)
  146.    (set! after_synth_hooks default_after_synth_hooks)
  147.  
  148.    ;; The follow are reset to allow existing voices to continue
  149.    ;; to work, new voices should be setting these explicitly
  150.    (Parameter.set 'Token_Method 'Token_English)
  151.    (Parameter.set 'POS_Method Classic_POS)
  152.    (Parameter.set 'Phrasify_Method Classic_Phrasify)
  153.    (Parameter.set 'Word_Method Classic_Word)
  154.    (Parameter.set 'Pause_Method Classic_Pauses)
  155.    (Parameter.set 'PostLex_Method Classic_PostLex)
  156.  
  157.    (set! diphone_module_hooks nil)
  158.    (set! UniSyn_module_hooks nil)
  159.  
  160.    (if current_voice_reset
  161.        (current_voice_reset))
  162.    (set! current_voice_reset nil)
  163. )
  164.  
  165. ;; We select the default voice from a list of possibilities. One of these
  166. ;; had better exist in every installation.
  167.  
  168. (define (no_voice_error)
  169.   (format t "No default voice found in %l\n" voice-path)
  170.   (format t "either no voices unpacked or voice-path is wrong\n")
  171.   (error "" nil))
  172.  
  173. (defvar voice_default 'no_voice_error
  174.  "voice_default
  175. A variable whose value is a function name that is called on start up to
  176. the default voice. [see Site initialization]")
  177.  
  178. (defvar default-voice-priority-list 
  179.   '(rab_diphone
  180.     kal_diphone
  181.     ked_diphone
  182.     don_diphone
  183.     en1_mbrola
  184.     us1_mbrola
  185.     us2_mbrola
  186.     us3_mbrola
  187.     gsw_diphone  ;; not publically distributed
  188.     el_diphone)
  189.   "default-voice-priority-list
  190.    List of voice names. The first of them available becomes the default voice.")
  191.  
  192. (let ((voices default-voice-priority-list)
  193.       voice)
  194.   (while (and voices (eq voice_default 'no_voice_error))
  195.      (set! voice (car voices))
  196.      (if (assoc voice voice-locations)
  197.          (set! voice_default (intern (string-append "voice_" voice)))
  198.          )
  199.      (set! voices (cdr voices))
  200.      )
  201.   )
  202.  
  203. (defvar Voice_descriptions nil
  204.   "Internal variable containing list of voice descriptions as
  205. decribed by proclaim_voice.")
  206.  
  207. (define (proclaim_voice name description)
  208. "(proclaim_voice NAME DESCRIPTION)
  209. Describe a voice to the systen.  NAME should be atomic name, that
  210. conventionally will have voice_ prepended to name the basic selection
  211. function.  OPTIONS is an assoc list of feature and value and must
  212. have at least features for language, gender, dialect and 
  213. description.  The first there of these are atomic, while the description
  214. is a text string describing the voice."
  215.   (let ((voxdesc (assoc name Voice_descriptions)))
  216.     (if voxdesc
  217.     (set-car! (cdr voxdesc) description)
  218.     (set! Voice_descriptions 
  219.           (cons (list name description) Voice_descriptions))))
  220. )
  221.  
  222. (define (voice.description name)
  223. "(voice.description NAME)
  224. Output description of named voice.  If the named voice is not yet loaded
  225. it is loaded."
  226.   (let ((voxdesc (assoc name Voice_descriptions))
  227.     (cv current-voice))
  228.     (if (null voxdesc)
  229.     (unwind-protect
  230.      (begin 
  231.        (voice.select name)
  232.        (voice.select cv) ;; switch back to current voice
  233.        (set! voxdesc (assoc name Voice_descriptions)))))
  234.     (if voxdesc
  235.        voxdesc
  236.        (begin
  237.      (format t "SIOD: unknown voice %s\n" name)
  238.      nil))))
  239.  
  240. (define (voice.select name)
  241. "(voice.select NAME)
  242. Call function to set up voice NAME.  This is normally done by 
  243. prepending voice_ to NAME and call it as a function."
  244.   (eval (list (intern (string-append "voice_" name)))))
  245.  
  246. (define (voice.describe name)
  247. "(voice.describe NAME)
  248. Describe voice NAME by saying its description.  Unfortunately although
  249. it would be nice to say that voice's description in the voice itself
  250. its not going to work cross language.  So this just uses the current
  251. voice.  So here we assume voices describe themselves in English 
  252. which is pretty anglo-centric, shitsurei shimasu."
  253.   (let ((voxdesc (voice.description name)))
  254.     (let ((desc (car (cdr (assoc 'description (car (cdr voxdesc)))))))
  255.       (cond
  256.        (desc (tts_text desc nil))
  257.        (voxdesc 
  258.     (SayText 
  259.      (format nil "A voice called %s exist but it has no description"
  260.          name)))
  261.        (t
  262.     (SayText 
  263.      (format nil "There is no voice called %s defined" name)))))))
  264.  
  265. (define (voice.list)
  266. "(voice.list)
  267. List of all (potential) voices in the system.  This checks the voice-location
  268. list of potential voices found be scanning the voice-path at start up time.
  269. These names can be used as arguments to voice.description and
  270. voice.describe."
  271.    (mapcar car voice-locations))
  272.  
  273. (provide 'voices)
  274.