home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Multimed / Multimed.zip / fest-141.zip / festival / lib / festival.scm < prev    next >
Lisp/Scheme  |  1999-09-09  |  24KB  |  616 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. ;;;  General Festival Scheme specific functions
  34. ;;;  Including definitions of various standard variables.
  35.  
  36. ;; will be set automatically on start-up
  37. (defvar festival_version "unknown"
  38.   "festival_version
  39.  A string containing the current version number of the system.")
  40.  
  41. ;; will be set automatically on start-up
  42. (defvar festival_version_number '(x x x)
  43.   "festival_version_number
  44.  A list of major, minor and subminor version numbers of the current
  45.  system.  e.g. (1 0 12).")
  46.  
  47. (define (apply_method method utt)
  48. "(apply_method METHOD UTT)
  49. Apply the appropriate function to utt defined in parameter."
  50.   (let ((method_val (Parameter.get method)))
  51.     (cond
  52.      ((null method_val)
  53.       nil)   ;; should be an error, but I'll let you off at present
  54.      ((and (symbol? method_val) (symbol-bound? method_val))
  55.       (apply (symbol-value method_val) (list utt)))
  56.      ((member (typeof method_val) '(subr closure))
  57.       (apply method_val (list utt)))
  58.      (t      ;; again is probably an error
  59.       nil))))
  60.  
  61. (define (require_module l)
  62.   "(require_module l)
  63. Check that certain compile-time modules are included in this installation.
  64. l may be a single atom or list of atoms.  Each item in l must appear in
  65. *modules* otherwise an error is throw."
  66.   (if (consp l)
  67.       (mapcar require_module l)
  68.       (if (not (member_string l *modules*))
  69.       (error (format nil "module %s required, but not compiled in this installation\n" l))))
  70.   t)
  71.  
  72. ;;;  Feature Function Functions
  73. (define (utt.features utt relname func_list)
  74. "(utt.features UTT RELATIONNAME FUNCLIST)
  75.   Get vectors of feature values for each item in RELATIONNAME in UTT.
  76.   [see Features]"
  77.   (mapcar 
  78.    (lambda (s) 
  79.      (mapcar (lambda (f) (item.feat s f)) func_list))
  80.    (utt.relation.items utt relname)))
  81.  
  82. (define (utt.type utt)
  83. "(utt.type UTT)
  84.   Returns the type of UTT."
  85.   (intern (utt.feat utt 'type)))
  86.  
  87. (define (utt.save.segs utt filename)
  88. "(utt.save.segs UTT FILE)
  89.   Save segments of UTT in a FILE in xlabel format."
  90.   (let ((fd (fopen filename "w")))
  91.     (format fd "#\n")
  92.     (mapcar
  93.      (lambda (info)
  94.        (format fd "%2.4f 100 %s\n" (car info) (car (cdr info))))
  95.      (utt.features utt 'Segment '(segment_end name)))
  96.     (fclose fd)
  97.     utt))
  98.  
  99. (define (utt.save.words utt filename)
  100. "(utt.save.words UTT FILE)
  101.   Save words of UTT in a FILE in xlabel format."
  102.   (let ((fd (fopen filename "w")))
  103.     (format fd "#\n")
  104.     (mapcar
  105.      (lambda (info)
  106.        (format fd "%2.4f 100 %s\n" (car info) (car (cdr info))))
  107.      (utt.features utt 'Word '(word_end name)))
  108.     (fclose fd)
  109.     utt))
  110.  
  111. (define (utt.resynth labfile f0file)
  112. "(utt.resynth LABFILE F0FILE)
  113. Resynthesize an utterance from a label file and F0 file (in any format
  114. supported by the Speech Tool Library).   This loads, synthesizes and
  115. plays the utterance."
  116.    (utt.play (utt.synth (utt.load.segf0 labfile f0file))))
  117.  
  118. (define (utt.relation.present utt relation)
  119. "(utt.relation.present UTT RELATIONNAME)
  120. Returns t if UTT caontains a relation called RELATIONNAME, nil otherwise."
  121.   (if (member_string relation (utt.relationnames utt))
  122.       t
  123.       nil))
  124.  
  125. (define (utt.relation.leafs utt relation)
  126. "(utt.relation.leafs UTT RELATIONNAME)
  127. Returns a list of all the leafs in this relation."
  128.   (let ((leafs nil))
  129.     (mapcar
  130.      (lambda (i)
  131.        (if (not (item.down (item.relation i relation)))
  132.        (set! leafs (cons i leafs))))
  133.      (utt.relation.items utt relation))
  134.     (reverse leafs)))
  135.  
  136. (define (utt.relation.first utt relation)
  137. "(utt.relation.first UTT RELATIONNAME)
  138. Returns a the first item in this relation."
  139.   (utt.relation utt relation))
  140.  
  141. (define (utt.relation.last utt relation)
  142. "(utt.relation.last UTT RELATIONNAME)
  143. Returns a the last item in this relation."
  144.   (let ((i (utt.relation.first utt relation)))
  145.     (while (item.next i)
  146.        (set! i (item.next i)))
  147.     i))
  148.  
  149. (define (item.relation.append_daughter parent relname daughter)
  150. "(item.relation.append_daughter parent relname daughter)
  151. Make add daughter to parent as a new daughter in relname."
  152.    (item.append_daughter (item.relation parent relname) daughter))
  153.  
  154. (define (item.relation.insert si relname newsi direction)
  155. "(item.relation.insert si relname newsi direction)
  156. Insert newsi in relation relname with respect to direction.  If
  157. direction is ommited after is assumed, valid directions are after
  158. before, above and below.  Note you should use 
  159. item.relation.append_daughter for tree adjoining.  newsi maybe
  160. a item itself of a LISP description of one."
  161.    (item.insert 
  162.     (item.relation si relname)
  163.     newsi
  164.     direction))
  165.  
  166. (define (item.relation.daughters parent relname)
  167.   "(item.relation.daughters parent relname)
  168. Return a list of all daughters of parent by relname."
  169.   (let ((d1 (item.daughter1 (item.relation parent relname)))
  170.     (daughters))
  171.     (while d1
  172.        (set! daughters (cons d1 daughters))
  173.        (set! d1 (item.next d1)))
  174.     (reverse daughters)))
  175.  
  176. (define (item.daughters p)
  177.   "(item.daughters parent)
  178. Return a list of all daughters of parent."
  179.   (item.relation.daughters p (item.relation.name p)))
  180.  
  181. (define (item.relation.parent si relname)
  182.   "(item.relation.parent item relname)
  183. Return the parent of this item in this relation."
  184.   (item.parent (item.relation si relname)))
  185.  
  186. (define (item.relation.daughter1 si relname)
  187.   "(item.relation.daughter1 item relname)
  188. Return the first daughter of this item in this relation."
  189.   (item.daughter1 (item.relation si relname)))
  190.  
  191. (define (item.relation.daughter2 si relname)
  192.   "(item.relation.daughter2 item relname)
  193. Return the second daughter of this item in this relation."
  194.   (item.daughter2 (item.relation si relname)))
  195.  
  196. (define (item.relation.daughtern si relname)
  197.   "(item.relation.daughtern item relname)
  198. Return the final daughter of this item in this relation."
  199.   (item.daughtern (item.relation si relname)))
  200.  
  201. (define (item.relation.next si relname)
  202.   "(item.relation.next item relname)
  203. Return the next item in this relation."
  204.   (item.next (item.relation si relname)))
  205.  
  206. (define (item.relation.prev si relname)
  207.   "(item.relation.prev item relname)
  208. Return the previous item in this relation."
  209.   (item.prev (item.relation si relname)))
  210.  
  211. (define (item.relation.first si relname)
  212.   "(item.relation.first item relname)
  213. Return the most previous item from this item in this relation."
  214.   (let ((n (item.relation si relname)))
  215.     (while (item.prev n)
  216.      (set! n (item.prev n)))
  217.     n))
  218.  
  219. (define (item.leafs si)
  220.   "(item.relation.leafs item relname)
  221. Return a list of the leafs of this item in this relation."
  222.   (let ((ls nil)
  223.     (pl (item.first_leaf si))
  224.     (ll (item.next_leaf (item.last_leaf si))))
  225.     (while (and pl (not (equal? pl ll)))
  226.        (set! ls (cons pl ls))
  227.        (set! pl (item.next_leaf pl)))
  228.     (reverse ls)))
  229.  
  230. (define (item.relation.leafs si relname)
  231.   "(item.relation.leafs item relname)
  232. Return a list of the leafs of this item in this relation."
  233.   (item.leafs (item.relation si relname)))
  234.  
  235. (define (item.root s)
  236.   "(item.root s)
  237. Follow parent link until s has no parent."
  238.   (cond
  239.    ((item.parent s) 
  240.     (item.root (item.parent s)))
  241.    (t s)))
  242.  
  243. (define (item.parent_to s relname)
  244.   "(item.parent_to s relname)
  245. Find the first ancestor of s in its current relation that is also in
  246. relname.  s is treated as an ancestor of itself so if s is in relname
  247. it is returned.  The returned value is in will be in relation relname
  248. or nil if there isn't one."
  249.   (cond
  250.    ((null s) s)
  251.    ((member_string relname (item.relations s)) 
  252.     (item.relation s relname))
  253.    (t (item.parent_to (item.parent s) relname))))
  254.  
  255. (define (item.daughter1_to s relname)
  256.   "(item.daughter1_to s relname)
  257. Follow daughter1 links of s in its current relation until an item
  258. is found that is also in relname, is s is in relname it is returned.
  259. The return item is returned in relation relname, or nil if there is
  260. nothing in relname."
  261.   (cond
  262.    ((null s) s)
  263.    ((member_string relname (item.relations s)) (item.relation s relname))
  264.    (t (item.daughter1_to (item.daughter1 s) relname))))
  265.  
  266. (define (item.daughtern_to s relname)
  267.   "(item.daughter1_to s relname)
  268. Follow daughtern links of s in its current relation until an item
  269. is found that is also in relname, is s is in relname it is returned.
  270. The return item is returned in relation relname, or nil if there is
  271. nothing in relname."
  272.   (cond
  273.    ((null s) s)
  274.    ((member_string relname (item.relations s)) (item.relation s relname))
  275.    (t (item.daughtern_to (item.daughtern s) relname))))
  276.  
  277. (define (item.name s)
  278. "(item.name ITEM)
  279.   Returns the name of ITEM. [see Accessing an utterance]"
  280.   (item.feat s "name"))
  281.  
  282. (define (utt.wave utt)
  283.   "(utt.wave UTT)
  284. Get waveform from wave (R:Wave.first.wave)."
  285.   (item.feat (utt.relation.first utt "Wave") "wave"))
  286.  
  287. (define (utt.wave.rescale . args)
  288.  "(utt.wave.rescale UTT FACTOR NORMALIZE)
  289. Modify the gain of the waveform in UTT by GAIN.  If NORMALIZE is
  290. specified and non-nil the waveform is maximized first."
  291.   (wave.rescale (utt.wave (nth 0 args)) (nth 1 args) (nth 2 args))
  292.   (nth 0 args))
  293.  
  294. (define (utt.wave.resample utt rate)
  295.   "(utt.wave.resample UTT RATE)\
  296. Resample waveform in UTT to RATE (if it is already at that rate it remains
  297. unchanged)."
  298.   (wave.resample (utt.wave utt) rate)
  299.   utt)
  300.  
  301. (define (utt.import.wave . args)
  302.   "(utt.import.wave UTT FILENAME APPEND)
  303. Load waveform in FILENAME into UTT in R:Wave.first.wave.  If APPEND
  304. is specified and non-nil append this to the current waveform."
  305.   (let ((utt (nth 0 args))
  306.     (filename (nth 1 args))
  307.     (append (nth 2 args)))
  308.     (if (and append (member 'Wave (utt.relationnames utt)))
  309.     (wave.append (utt.wave utt) (wave.load filename))
  310.     (begin
  311.       (utt.relation.create utt 'Wave)
  312.       (item.set_feat
  313.        (utt.relation.append utt 'Wave)
  314.        "wave"
  315.        (wave.load filename))))
  316.     utt))
  317.  
  318. (define (utt.save.wave . args)
  319.   "(utt.save.wave UTT FILENAME FILETYPE)
  320. Save waveform in UTT in FILENAME with FILETYPE (if specified) or
  321. using global parameter Wavefiletype."
  322.   (wave.save 
  323.    (utt.wave (nth 0 args))
  324.    (nth 1 args)
  325.    (nth 2 args))
  326.   (nth 0 args))
  327.  
  328. (define (utt.play utt)
  329.   "(utt.play UTT)
  330. Play waveform in utt by current audio method."
  331.   (wave.play (utt.wave utt))
  332.   utt)
  333.  
  334. (define (utt.save.track utt filename relation feature)
  335.   "(utt.save.track utt filename relation feature)
  336. DEPRICATED use trace.save instead."
  337.   (format stderr "utt.save.track: DEPRICATED use track.save instead\n")
  338.   (track.save 
  339.    (item.feat
  340.     (utt.relation.first utt relation)
  341.     feature)
  342.    filename)
  343.   utt)
  344.  
  345. (define (utt.import.track utt filename relation fname)
  346.   "(utt.import.track UTT FILENAME RELATION FEATURE_NAME)
  347. Load track in FILENAME into UTT in R:RELATION.first.FEATURE_NAME.
  348. Deletes RELATION if it already exists. (you maybe want to use track.load
  349. directly rather than this legacy function."
  350.   (utt.relation.create utt relation)
  351.   (item.set_feat
  352.    (utt.relation.append utt relation)
  353.    fname
  354.    (track.load filename))
  355.   utt)
  356.  
  357. (define (wagon_predict item tree)
  358. "(wagon_predict ITEM TREE)
  359. Predict with given ITEM and CART tree and return the prediction
  360. (the last item) rather than whole probability distribution."
  361.  (car (last (wagon item tree))))
  362.  
  363. (define (phone_is_silence phone)
  364.   (member_string 
  365.    phone
  366.    (car (cdr (car (PhoneSet.description '(silences)))))))
  367.  
  368. (define (phone_feature phone feat)
  369. "(phone_feature phone feat)
  370. Return the feature for given phone in current phone set, or 0
  371. if it doesn't exist."
  372.   (let ((ph (intern phone)))
  373.     (let ((fnames (cadr (assoc 'features (PhoneSet.description))))
  374.       (fvals (cdr (assoc ph (cadr (assoc 'phones (PhoneSet.description)))))))
  375.       (while (and fnames (not (string-equal feat (car (car fnames)))))
  376.          (set! fvals (cdr fvals))
  377.          (set! fnames (cdr fnames)))
  378.       (if fnames
  379.       (car fvals)
  380.       0))))
  381.  
  382. (defvar server_max_clients 10
  383.   "server_max_clients
  384. In server mode, the maximum number of clients supported at any one
  385. time.  When more that this number of clients attach simulaneous
  386. the last ones are denied access.  Default value is 10.
  387. [see Server/client API]")
  388.  
  389. (defvar server_port 1314
  390.   "server_port
  391. In server mode the inet port number the server will wait for connects
  392. on.  The default value is 1314. [see Server/client API]")
  393.  
  394. (defvar server_log_file t
  395.   "server_log_file
  396. If set to t server log information is printed to standard output
  397. of the server process.  If set to nil no output is given.  If set
  398. to anything else the value is used as the name of file to which
  399. server log information is appended.  Note this value is checked at
  400. server start time, there is no way a client may change this.
  401. [see Server/client API]")
  402.  
  403. (defvar server_passwd nil
  404.   "server_passwd
  405. If non-nil clients must send this passwd to the server followed by
  406. a newline before they can get a connection.  It would be normal
  407. to set this for the particular server task.
  408. [see Server/client API]")
  409.  
  410. (defvar server_access_list '(localhost)
  411.   "server_access_list
  412. If non-nil this is the exhaustive list of machines and domains
  413. from which clients may access the server.  This is a list of REGEXs
  414. that client host must match.  Remember to add the backslashes before
  415. the dots. [see Server/client API]")
  416.  
  417. (defvar server_deny_list nil
  418.   "server_deny_list
  419. If non-nil this is a list of machines which are to be denied access
  420. to the server absolutely, irrespective of any other control features.
  421. The list is a list of REGEXs that are used to matched the client hostname.
  422. This list is checked first, then server_access_list, then passwd.
  423. [see Server/client API]")
  424.  
  425. (define (def_feature_docstring fname fdoc)
  426. "(def_feature_docstring FEATURENAME FEATUREDOC)
  427. As some feature are used directly of stream items with no
  428. accompanying feature function, the features are just values on the feature
  429. list.  This function also those features to have an accompanying
  430. documentation string."
  431.   (let ((fff (assoc fname ff_docstrings)))
  432.     (cond
  433.      (fff  ;; replace what's already there
  434.       (set-cdr! fff fdoc))
  435.      (t
  436.       (set! ff_docstrings (cons (cons fname fdoc) ff_docstrings))))
  437.     t))
  438.  
  439. (define (linear_regression item model)
  440.   "(linear_regression ITEM MODEL)
  441. Use linear regression MODEL on ITEM.  MODEL consists of a list
  442. of features, weights and optional map list.  E.g. ((Intercept 100)
  443. (tobi_accent 10 (H* !H*)))."
  444.   (let ((intercept (if (equal? 'Intercept (car (car model))) 
  445.                        (car (cdr (car model))) 0))
  446.         (mm (if (equal? 'Intercept (car (car model))) 
  447.                 (cdr model) model)))
  448.   (apply + 
  449.    (cons intercept
  450.    (mapcar
  451.     (lambda (f)
  452.      (let ((ff (item.feat item (car f))))
  453.       (if (car (cdr (cdr f)))
  454.          (if (member_string ff (car (cdr (cdr f))))
  455.            (car (cdr f))
  456.            0)
  457.          (* (parse-number ff) (car (cdr f))))))
  458.     mm)))))
  459.  
  460. (defvar help
  461.  "The Festival Speech Synthesizer System: Help
  462.  
  463. Getting Help
  464.   (doc '<SYMBOL>)   displays help on <SYMBOL>
  465.   (manual nil)      displays manual in local netscape
  466.   C-c               return to top level
  467.   C-d or (quit)     Exit Festival
  468. (If compiled with editline)
  469.   M-h               desplays help on current symbol  
  470.   M-s               speaks help on current symbol  
  471.   M-m               displays relevant manula page in local netscape
  472.   TAB               Command, symbol and filename completion
  473.   C-p or up-arrow   Previous command
  474.   C-b or left-arrow Move back one character
  475.   C-f or right-arrow 
  476.                     Move forward one character
  477.   Normal Emacs commands work for editing command line
  478.  
  479. Doing stuff
  480.   (SayText TEXT)      Synthesize text, text should be surrounded by
  481.                       double quotes
  482.   (tts FILENAME nil)  Say contexts of file, FILENAME should be 
  483.                       surrounded by double quotes
  484.   (voice_rab_diphone) Select voice (Britsh Male)
  485.   (voice_ked_diphone) Select voice (American Male)
  486. ")
  487.  
  488. (define (festival_warranty)
  489. "(festival_warranty)
  490.   Display Festival's copyright and warranty. [see Copying]"
  491.  (format t
  492.    (string-append
  493.     "    The Festival Speech Synthesis System: "
  494.     festival_version
  495. "
  496.                 Centre for Speech Technology Research                  
  497.                      University of Edinburgh, UK                       
  498.                        Copyright (c) 1996-1999                         
  499.                         All Rights Reserved.                           
  500.                                                                        
  501.   Permission is hereby granted, free of charge, to use and distribute  
  502.   this software and its documentation without restriction, including   
  503.   without limitation the rights to use, copy, modify, merge, publish,  
  504.   distribute, sublicense, and/or sell copies of this work, and to      
  505.   permit persons to whom this work is furnished to do so, subject to   
  506.   the following conditions:                                            
  507.    1. The code must retain the above copyright notice, this list of    
  508.       conditions and the following disclaimer.                         
  509.    2. Any modifications must be clearly marked as such.                
  510.    3. Original authors' names are not deleted.                         
  511.    4. The authors' names are not used to endorse or promote products   
  512.       derived from this software without specific prior written        
  513.       permission.                                                      
  514.                                   
  515.   THE UNIVERSITY OF EDINBURGH AND THE CONTRIBUTORS TO THIS WORK        
  516.   DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING      
  517.   ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT   
  518.   SHALL THE UNIVERSITY OF EDINBURGH NOR THE CONTRIBUTORS BE LIABLE     
  519.   FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES    
  520.   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN   
  521.   AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,          
  522.   ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF       
  523.   THIS SOFTWARE.                                                       
  524. ")))
  525.  
  526. (define (intro)
  527. "(intro)
  528.  Synthesize an introduction to the Festival Speech Synthesis System."
  529.   (tts (path-append libdir "../examples/intro.text") nil))
  530.  
  531. (define (intro-spanish)
  532. "(intro-spanish)
  533.  Synthesize an introduction to the Festival Speech Synthesis System
  534.  in spanish.  Spanish voice must already be selected for this."
  535.   (tts (path-append libdir "../examples/spintro.text") nil))
  536.  
  537. (define (na_play FILENAME)
  538. "(play_wave FILENAME)
  539. Play given wavefile"
  540.  (utt.play (utt.synth (eval (list 'Utterance 'Wave FILENAME)))))
  541.  
  542. ;;; Some autoload commands
  543. (autoload manual-sym "festdoc" "Show appropriate manual section for symbol.")
  544. (autoload manual "festdoc" "Show manual section.")
  545.  
  546. (autoload display "display" "Graphically display utterance.")
  547.  
  548. (autoload festtest "festtest" "Run tests of Festival.")
  549.  
  550. (defvar diphone_module_hooks nil
  551.   "diphone_module_hooks
  552.   A function or list of functions that will be applied to the utterance
  553.   at the start of the diphone module.  It can be used to map segment 
  554.   names to those that will be used by the diphone database itself.
  555.   Typical use specifies _ and $ for consonant clusters and syllable 
  556.   boundaries, mapping to dark ll's etc.  Reduction and tap type 
  557.   phenomena should probabaly be done by post lexical rules though the 
  558.   distinction is not a clear one.")
  559.  
  560. (def_feature_docstring
  561.   'Segment.diphone_phone_name
  562.   "Segment.diphone_phone_name
  563.   This is produced by the diphone module to contain the desired phone
  564.   name for the desired diphone.  This adds things like _ if part of 
  565.   a consonant or $ to denote syllable boundaries.  These are generated
  566.   on a per voice basis by function(s) specified by diphone_module_hooks.
  567.   Identification of dark ll's etc. may also be included.  Note this is not
  568.   necessarily the name of the diphone selected as if it is not found
  569.   some of these characters will be removed and fall back values will be
  570.   used.")
  571.  
  572. (def_feature_docstring
  573.   'Syllable.stress
  574.   "Syllable.stress
  575.   The lexical stress of the syllable as specified from the lexicon entry
  576.   corresponding to the word related to this syllable.")
  577.  
  578. ;;;
  579. ;;;  I tried some tests on the resulting speed both runtime and loadtime
  580. ;;;  but compiled files don't seem to make any significant difference
  581. ;;;
  582. (define (compile_library)
  583.   "(compile_library)
  584. Compile all the scheme files in the library directory."
  585.   (mapcar
  586.    (lambda (file)
  587.      (format t "compile ... %s\n" file)
  588.      (compile-file (string-before file ".scm")))
  589.    (list
  590.      "synthesis.scm" "siod.scm" "init.scm" "lexicons.scm"
  591.      "festival.scm" "gsw_diphone.scm" "intonation.scm" "duration.scm"
  592.      "pos.scm" "phrase.scm" "don_diphone.scm" "rab_diphone.scm"
  593.      "voices.scm" "tts.scm" "festdoc.scm" "languages.scm" "token.scm"
  594.      "mbrola.scm" "display.scm" "postlex.scm" "tokenpos.scm"
  595.      "festtest.scm" "cslush.scm" "ducs_cluster.scm" "sucs.scm"
  596.      "web.scm" "cart_aux.scm"
  597.      "lts_nrl.scm" "lts_nrl_us.scm" "email-mode.scm"
  598.      "mrpa_phones.scm" "radio_phones.scm" "holmes_phones.scm"
  599.      "mrpa_durs.scm" "klatt_durs.scm" "gswdurtreeZ.scm"
  600.      "tobi.scm" "f2bf0lr.scm"))
  601.   t)
  602.  
  603. (define (register_unisyn_features ddd)
  604.   (format t "********************\n")
  605.   (format t "\n")
  606.   (format t "The Scheme `register_unisyn_features' is no longer required\n")
  607.   (format t "its function is absorbed into the initialization process\n")
  608.   (format t "delete you call to this function now as this will cause\n")
  609.   (format t "an error in the future\n")
  610.   (format t "\n")
  611.   (system "sleep 3")
  612.   (format t "********************\n")
  613. )  
  614.  
  615. (provide 'festival)
  616.