lib/festival.scm

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