1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-*-mode:scheme-*- 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;;; Author: Alan W Black 34;;; Date: wasting time one August morning in 1996 35;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36;;; 37;;; Here is a short example of a Festival program that speaks the 38;;; current time. It uses UNIX date to get the time then builds 39;;; a string with an expression of the current time. 40;;; 41;;; The string generated for synthesis is of the form 42;;; The time is now <exactness> <minute info> <hour info> <am/pm> 43;;; 44 45;;; Because this is a --script type file I has to explicitly 46;;; load the initfiles: init.scm and user's .festivalrc 47(load (path-append libdir "init.scm")) 48 49(define (get-the-time) 50"Returns a list of hour and minute and second, for later processing" 51 (let (date) 52 (system "date | awk '{print $4}' | tr : ' ' >/tmp/saytime.tmp") 53 (set! date (load "/tmp/saytime.tmp" t)) ;; loads the file unevaluated 54 (system "rm /tmp/saytime.tmp") 55 date) 56) 57 58(define (round-up-time time) 59"Rounds time up/down to nearest five minute interval" 60 (let ((hour (car time)) 61 (min (car (cdr time))) 62 (sec (car (cdr (cdr time))))) 63 (set! min (round-min (+ 2 min))) 64 (list hour min sec))) 65 66(define (round-min min) 67"Returns minutes rounded down to nearest 5 minute interval" 68 (cond 69 ((< min 5) 70 0) 71 (t 72 (+ 5 (round-min (- min 5)))))) 73 74(define (approx time) 75"Returns a string stating the approximation of the time. 76 exactly -- within a minute either side 77 almost -- 1-2 minutes before 78 just after - 1-2 minutes after 79 a little after 2-3 minutes after 80" 81 (let ((rm (round-min (car (cdr time)))) 82 (min (car (cdr time)))) 83 (cond 84 ((or (< (- min rm) 1) 85 (> (- min rm) 3)) 86 "exactly ") 87 ((< (- min rm) 2) 88 "just after ") 89 ((< (- min rm) 3) 90 "a little after ") 91 (t 92 "almost ")))) 93 94(define (hour-string time) 95"Return description of hour" 96 (let ((hour (car time))) 97 (if (> (car (cdr time)) 30) 98 (set! hour (+ 1 hour))) 99 (cond 100 ((or (eq hour 0) (eq hour 24)) 101 "midnight ") 102 ((> hour 12) 103 (string-append (- hour 12) ", ")) 104 (t 105 (string-append hour ", "))))) 106 107(define (minute-string time) 108"Return description of minute" 109 (let ((min (car (cdr time)))) 110 (cond 111 ((or (eq min 0) (eq min 60)) " ") 112 ((eq min 5) "five past ") 113 ((eq min 10) "ten past ") 114 ((eq min 15) "quarter past ") 115 ((eq min 20) "twenty past ") 116 ((eq min 25) "twenty-five past ") 117 ((eq min 30) "half past ") 118 ((eq min 35) "twenty-five to ") 119 ((eq min 40) "twenty to ") 120 ((eq min 45) "quarter to ") 121 ((eq min 50) "ten to ") 122 ((eq min 55) "five to ") 123 (t 124 "something else ")))) 125 126(define (ampm-string time) 127"Return morning/afternoon or evening string" 128 (let ((hour (car time))) 129 (cond 130 ((or (eq hour 0) (eq hour 12) (eq hour 24)) 131 " ") 132 ((< hour 12) 133 "in the morning. ") 134 ((< hour 18) 135 "in the afternoon. ") 136 (t 137 "in the evening. ")))) 138 139;;; 140;;; Now with all the functions defined we can get the time 141;;; 142(set! actual-time (get-the-time)) 143(set! round-time (round-up-time actual-time)) 144 145;;; Construct the time expression 146(set! time-string 147 (string-append 148 "The time is now, " 149 (approx actual-time) 150 (minute-string round-time) 151 (hour-string round-time) 152 (ampm-string round-time))) 153 154(format t "%s\n" time-string) 155 156;;; Synthesize it 157(SayText time-string) 158 159