（警告：Scheme code が続きます；理解する必要はありません）
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Site Initialisation file
;;; This is loaded near the end of init.scm,
;;; just before user initialisation file
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ==========================
;;; Style Management Functions
;;; ==========================
(defvar Styles '((default 140 22 1.0))
"Available voice styles")
(defvar style_default 'default
"Default voice style")
(defvar current_style 'none
"Current voice style")
(define (Style selected_style)
"(Style DEFINED_STYLE)
Sets the pitch, pitch variance, and speed of the current voice.
Type 'Styles' for a list of defined styles."
(let ((style (assoc selected_style Styles)))
(if (not style)
(set! style (assoc 'default Styles)))
(let ((model_mean (cadr (assoc 'model_f0_mean int_lr_params)))
(model_std (cadr (assoc 'model_f0_std int_lr_params)))
(new_mean (cadr style))
(new_std (cadr (cdr style)))
(new_stretch (cadr (cdr (cdr style)))))
(set! int_lr_params
(list
(list 'target_f0_mean new_mean)
(list 'target_f0_std new_std)
(list 'model_f0_mean model_mean)
(list 'model_f0_std model_std)))
(Parameter.set 'Duration_Stretch new_stretch)
(set! current_style (car style))
(list (car style) new_mean new_std new_stretch)
)
)
)
(define (NewStyle style_name mean std stretch)
"(NewStyle STYLE_NAME MEAN STD STRETCH)
Defines a new style; MEAN and STD refer to pitch mean and variance,
while STRETCH refers to inverse speed, 1.0 being the standard."
(set! Styles (cons (list style_name mean std stretch) Styles)))
(if (probe_file "/etc/festival.conf")
(load "/etc/festival.conf"))
;;; =================
;;; Style Definitions
;;; =================
(NewStyle 'male_frozen 80 10 1.5 )
(NewStyle 'male_slow 100 22 1.1 )
(NewStyle 'male_tenor 140 60 1.0 )
(NewStyle 'male_baritone 100 40 1.0 )
(NewStyle 'male_bass 70 25 1.0 )
(NewStyle 'male_relaxed 100 24 0.95)
(NewStyle 'male_newscaster 140 32 0.85)
(NewStyle 'male_hurried 117 22 0.80)
(NewStyle 'male_stressed 150 30 0.70)
(NewStyle 'male_fast 110 22 0.70)
(NewStyle 'male_faster 110 22 0.60)
(NewStyle 'male_panic 170 20 0.60)
(NewStyle 'male_fastest 110 22 0.55)
(NewStyle 'the_flash 110 22 0.45)
これは festival のテキスト読み上げのインターフェイスに声質の 「スタイル」のサポートを追加するスクリプトです。ほかの機能を追加 するためのテンプレートとしても使えます。何か追加したらぜひ教え てください。
スクリプト名を saytext として、ごく簡単に使い方を説明しておきましょう。
saytext -h # （なぞめいた）ヘルプメッセージがでます
saytext [-s <スタイル>] [<ファイル名>] # ファイルもしくは標準入力を読み上げます
<スタイル>は、存在するものなら何でもかまいません。<ファイル名 >が指定されない場合は、標準入力が使われます。
例 saytext -s male_baritone myfile.txt
そしてこれがスクリプトのコードです：
#!/usr/lib/festival/src/main/festival --script
;;; Here is a Festival script that adds voice "style"
;;; support to the text-to-speech command-line interface.
;;;
;;; Type "saytext -h" for help, including a list of available styles.
;;;
;;; User-defined "styles" can be declared in ~/.festivalrc like this:
;;;
;;; (NewStyle <name> <mean_pitch> <pitch_SD> <speed>)
;;; E.g: (NewStyle 'mystyle 100 23 0.9) ; Defines a baritone
;;;
;;; You can also set default styles:
;;;
;;; (set! style_default 'my_style)
;;;
;;; Styles may be selected within a script via:
;;;
;;; (Style <name>)
;;; E.g.: (Style 'my_style)
;;; ==============
;;; INITIALIZATION
;;; ==============
;;; Because this is a --script type file I have to explicitly
;;; load the initfiles: init.scm and user's .festivalrc
(load (string-append libdir "init.scm"))
(if (probe_file (format nil "%s/.festivalrc" (getenv "HOME")))
(load (format nil "%s/.festivalrc" (getenv "HOME"))))
;;; Clear rotten rendered speech from tmp
(system "/bin/rm -f /tmp/est_*")
;;; Process command-line arguments
(defvar TTS_Filename "-"
"This variable stores the name of the file to be read,
\"\" for stdin")
(while argv
(let ((option (car argv)))
(set! argv (cdr argv))
(cond
((eq? option '-s)
(if (length argv)
(let ((style (car argv)))
(if (not (assoc style Styles))
(format t "No style '%s, " style))
(Style style)
; (format t "Using style %s\n" current_style)
(set! argv (cdr argv))
)
(error "Syntax error in option: -s <style>" nil)))
((eq? option '-h)
(format t "Usage: saytext [-s <style> | -h]\n")
(format t "Available styles are:\n")
(format t " %l\n" Styles)
(quit))
(t
(set! TTS_Filename (string-append "" option))))))
(tts TTS_Filename nil)