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