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