1;;; Changing prosody parameters
2
3;; Copyright (C) 2004, 2006, 2008 Brailcom, o.p.s.
4
5;; Author: Milan Zamazal <pdm@brailcom.org>
6
7;; COPYRIGHT NOTICE
8
9;; This program is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 2 of the License, or
12;; (at your option) any later version.
13
14;; This program is distributed in the hope that it will be useful, but
15;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
16;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
17;; for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with this program; if not, write to the Free Software
21;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA.
22
23
24(require 'util)
25
26
27(defvar prosody-testing-word "babebibobub")
28
29
30;;; Prosody parameter accessors
31
32
33(define (prosody-get-pitch)
34  ;; This is now easy thing, there are many intonation methods in Festival,
35  ;; more methods can be added and the Int_Target_Method parameter can be
36  ;; wrapped
37  (cond
38   ((prosody-general-method?)
39    (or (avalue-get 'f0_mean int_general_params)
40        (prosody-general-pitch)))
41   ((prosody-lr-method?)
42    (avalue-get 'target_f0_mean int_lr_params))
43   ((prosody-simple-method?)
44    (avalue-get 'f0_mean int_simple_params))))
45
46(define (prosody-set-pitch value)
47  (cond
48   ((prosody-general-method?)
49    (if (avalue-get 'f0_mean int_general_params)
50        (set! int_general_params
51              (assoc-set int_general_params 'f0_mean (list value)))
52        (prosody-set-general-pitch value)))
53   ((prosody-lr-method?)
54    (set! int_lr_params
55          (assoc-set int_lr_params 'target_f0_mean (list value))))
56   ((prosody-simple-method?)
57    (set! int_simple_params
58          (assoc-set int_simple_params 'f0_mean (list value))))))
59
60(define (prosody-get-pitch-range)
61  (cond
62   ((prosody-general-method?)
63    (or (avalue-get 'f0_std int_general_params)
64        (prosody-general-pitch-range)))
65   ((prosody-lr-method?)
66    (avalue-get 'target_f0_std int_lr_params))
67   ((prosody-simple-method?)
68    (avalue-get 'f0_mean int_simple_params))))
69
70(define (prosody-set-pitch-range value)
71  (cond
72   ((prosody-general-method?)
73    (if (avalue-get 'f0_std int_general_params)
74        (set! int_general_params
75              (assoc-set int_general_params 'f0_std (list value)))
76        (prosody-set-general-pitch-range value)))
77   ((prosody-lr-method?)
78    (set! int_lr_params
79          (assoc-set int_lr_params 'target_f0_std (list value))))
80   ((prosody-simple-method?)
81    (set! int_simple_params
82          (assoc-set int_simple_params 'f0_std (list value))))))
83
84(defvar prosody-volume 1)
85
86(define (prosody-get-volume)
87  prosody-volume)
88
89(define (prosody-set-volume value)
90  (add-hook after_synth_hooks prosody-adjust-volume t)
91  (set! prosody-volume value))
92
93(define (prosody-get-rate)
94  (/ 1 (Param.get 'Duration_Stretch)))
95
96(define (prosody-set-rate value)
97  (Param.set 'Duration_Stretch (/ 1 value)))
98
99
100;;; Internal utilities
101
102
103(defvar prosody-parameters '())
104
105(define (prosody-change-parameter value get-func set-func min max)
106  (let* ((old-value (get-func))
107         (new-value (if (eq? (typeof value) 'closure)
108                        (value old-value)
109                        value)))
110    (cond
111     ((> new-value max)
112      (set! new-value max))
113     ((< new-value min)
114      (set! new-value min)))
115    (set-func new-value)
116    old-value))
117
118(define (prosody-adjust-volume utt)
119  (utt.wave.rescale utt prosody-volume))
120
121
122;;; Internal utilities -- general intonation method handling
123
124
125(defvar prosody-voice-f0-alist '()) ; items: (VOICE PITCH RANGE)
126(defvar prosody-voice-pitch-factor '()) ; (CURRENT-VOICE PITCH RANGE)
127
128(defmac (define-prosody-method-test form)
129  (let* ((method-name (nth 1 form))
130         (method-function-name (intern (string-append "Int_Targets_" method-name)))
131         (function-name (intern (string-append "prosody-" (downcase method-name) "-method?"))))
132    `(define (,function-name)
133       (let ((int-method (Param.get 'Int_Target_Method)))
134         (or (eq? int-method ,method-function-name)
135             (equal? int-method (quote ,method-function-name))
136             (equal? (Param.get 'Int_Method) ,method-name))))))
137(define-prosody-method-test "General")
138(define-prosody-method-test "LR")
139(define-prosody-method-test "Simple")
140
141(define (prosody-general-base-f0)
142  (or (second (assoc current-voice prosody-voice-f0-alist))
143      (let ((orig-targ-func (avalue-get 'targ_func int_general_params))
144            (pitch-list '()))
145        (avalue-set! 'targ_func int_general_params
146                     (lambda (utt syl)
147                       (let ((result (orig-targ-func utt syl)))
148                         (set! pitch-list (append pitch-list
149                                                  (mapcar cadr result)))
150                         result)))
151        (unwind-protect*
152            (SynthText prosody-testing-word)
153          (avalue-set! 'targ_func int_general_params orig-targ-func))
154        (set! pitch-list (or (butlast (cdr pitch-list)) '(100)))
155        (let* ((n (length pitch-list))
156               (pitch (/ (apply + pitch-list) n))
157               (range (/ (apply + (mapcar (lambda (p) (abs (- p pitch))) pitch-list)) n)))
158          (set! prosody-voice-f0-alist (assoc-set prosody-voice-f0-alist
159                                                  current-voice (list pitch range)))
160          pitch))))
161
162(define (prosody-general-f0-range)
163  (prosody-general-base-f0)
164  (third (assoc current-voice prosody-voice-f0-alist)))
165
166(define (prosody-general-pitch)
167  (* (prosody-general-base-f0) (prosody-current-voice-pitch-factor)))
168
169(define (prosody-general-pitch-range)
170  (* (prosody-general-f0-range) (prosody-current-voice-pitch-range-factor)))
171
172(define (prosody-current-voice-pitch-factor)
173  (when (or (null? prosody-voice-pitch-factor)
174            (not (equal? current-voice (first prosody-voice-pitch-factor))))
175    (set! prosody-voice-pitch-factor (list current-voice 1 1)))
176  (second prosody-voice-pitch-factor))
177
178(define (prosody-current-voice-pitch-range-factor)
179  (prosody-current-voice-pitch-factor) ; ensure the factor is defined
180  (third prosody-voice-pitch-factor))
181
182(define (prosody-ensure-targ-func-wrapped)
183  (unless (assoc 'prosody-wrapper-enabled int_general_params)
184    (prosody-general-base-f0)           ; store original base f0
185    (let ((orig-func (avalue-get 'targ_func int_general_params)))
186      (avalue-set! 'targ_func int_general_params
187                   (lambda (utt syl)
188                     (prosody-change-general-pitch utt syl orig-func)))
189      (set! int_general_params (cons '(prosody-wrapper-enabled t)
190                                     int_general_params)))))
191
192(define (prosody-set-general-pitch freq)
193  (prosody-ensure-targ-func-wrapped)
194  (set! prosody-voice-pitch-factor
195        (list current-voice
196              (/ freq (prosody-general-base-f0))
197              (or (third prosody-voice-pitch-factor) 1))))
198
199(define (prosody-set-general-pitch-range range)
200  (prosody-ensure-targ-func-wrapped)
201  (set! prosody-voice-pitch-factor
202        (list current-voice
203              (or (second prosody-voice-pitch-factor) 1)
204              (/ range (prosody-general-f0-range)))))
205
206(define (prosody-change-general-pitch utt syl next-func)
207  (let ((base-pitch (prosody-general-base-f0))
208        (pitch-factor (prosody-current-voice-pitch-factor))
209        (range-factor (prosody-current-voice-pitch-range-factor)))
210    (mapcar (lambda (spec)
211              (cons (first spec)
212                    (cons (* pitch-factor (+ base-pitch (* range-factor (- (second spec) base-pitch))))
213                          (cddr spec))))
214            (next-func utt syl))))
215
216
217;;; Exported functions
218
219
220(define (prosody-shifted-value shift)
221  (lambda (x) (+ shift x)))
222
223(define (prosody-relative-value coef)
224  (lambda (x) (* coef x)))
225
226(define (set-pitch pitch)
227  ;; Hz or a function
228  (prosody-change-parameter pitch prosody-get-pitch prosody-set-pitch 50 500))
229
230(define (set-pitch-range pitch-range)
231  ;; mean-in-% or a function
232  (prosody-change-parameter pitch-range prosody-get-pitch-range
233                            prosody-set-pitch-range 0 100))
234
235(define (set-volume volume)
236  ;; 0..1 or a function
237  (prosody-change-parameter volume prosody-get-volume prosody-set-volume 0 1))
238
239(define (set-rate rate)
240  ;; 0+..1..inf- or a function
241  (prosody-change-parameter rate prosody-get-rate prosody-set-rate 0.1 10))
242
243(define (change-prosody function param)
244  (prog1 (function param)
245    (set! prosody-parameters (assoc-set prosody-parameters function param))))
246
247(define (restore-prosody)
248  (let ((parameters prosody-parameters))
249    (while parameters
250      ((caar parameters) (cdar parameters))
251      (set! parameters (cdr parameters)))))
252
253(define (reset-prosody)
254  (set! prosody-parameters '()))
255
256
257(provide 'prosody-param)
258