[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Speech Manager
- To: info-macl@cambridge.apple.com
- Subject: Speech Manager
- From: ralex@sigi.cs.colorado.edu (Alex Repenning)
- Date: Thu, 26 Aug 1993 20:25:23 -0600
Here's our early first hack putting a thin layer on top of the speech manager traps. It's fairly basic but does quite some testing to prevent crashes. Also it deals with the clean abortion of ongoing speech by hitting command "."
Includes a simple synchronization mechanism for speech and a voice picker.
~~~~~~~~~~~~~~~~~ Speech-Manager.lisp ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;-*- Mode: Lisp; Package: SPEECH -*-
;*********************************************************************
;* *
;* PROGRAM S P E E C H M A N A G E R *
;* *
;*********************************************************************
;* Author : Alex Repenning & Hal Eden *
;* Copyright : (C) University of Colorado at Boulder *
;* Computer Science Department *
;* Boulder, CO 80303 *
;* 03/28/90 *
;* Filename : speech-manager.lisp *
;* Last Update : 8/15/93 *
;* Version : *
;* 1.0 : 8/16/93 The Pope is in Denver *
;* Systems : MCL 2.0p2 *
;* Abstract : Basic functionality to use Speech Manager from *
;* MCL. *
;* *
;******************************************************************
(defpackage SPEECH
(:USE "MAKE" "COMMON-LISP-USER" "COMMON-LISP" "CCL")
(:EXPORT "GET-DEFAULT-SPEECH-CHANNEL-FROM-USER" "SPEAK-TEXT"
"WHILE-SPEAKING" "WHILE-COMPUTING-SPEAK"
"SPEECH-AVAILABLE-P"))
(in-package SPEECH)
;*************************************************
;* Error Handling *
;*************************************************
(defmacro ERROR-FREE (Trap-Call)
(let ((Result (gensym)))
`(let ((,Result ,Trap-Call))
(case ,Result
(0 ,Result)
(t (error "Speech Manager; Trap: ~A, Code: ~A" ,(first Trap-Call) ,Result))))))
(defmacro ERROR-WITHOUT-SPEECH-MANAGER ()
`(unless (speech-available-p) (error "Speech Manager is NOT AVAILABLE")))
;*************************************************
;* Globals *
;*************************************************
(defvar *Default-Speech-Channel* nil "{SpeechChannel}")
(defun GET-DEFAULT-SPEECH-CHANNEL-FROM-USER () "
out: Speech-Channel {SpeechChannel}.
Make the user select from the loaded voices and
create a speech channel => *Default-Speech-Channel*."
(when *Default-Speech-Channel*
(#_DisposeSpeechChannel *Default-Speech-Channel*))
(%stack-block ((SndH-VAR 4))
(%put-ptr SndH-VAR (%null-ptr))
(error-free (#_NewSpeechChannel (pick-voice) SndH-VAR))
(setq *Default-Speech-Channel* (%get-ptr SndH-VAR)))
*Default-Speech-Channel*)
(defun DEFAULT-SPEECH-CHANNEL () "
out: Speech-Channel {SpeechChannel}.
Return the default speech channel. If the channel
has not been previously set by the user do it now."
(or *Default-Speech-Channel*
(get-default-speech-channel-from-user)))
;*************************************************
;* Features and Gestalt *
;*************************************************
(defun SPEECH-AVAILABLE-P () "
out: Available {boolean}.
Return a non-nil value if the speech manager is available"
(rlet ((Response :pointer))
(and (zerop (#_Gestalt #$gestaltSpeechAttr Response))
(logbitp #$gestaltSpeechMgrPresent (%get-long Response)))))
(cond
((speech-available-p) (pushnew :speech-manager *Features*))
(t (cerror "The Speech Manager is NOT available on this machine")))
;*************************************************
;* Low-Level Functions (not Exported) *
;*************************************************
(defun COUNT-VOICES () "
out: Number {fixnum}.
Return number of instaleld voices"
(rlet ((Number :Pointer))
(unless (zerop (#_countvoices Number)) (error "VOICE MANAGER PROBLEM"))
(%get-signed-word Number)))
(defun STOP-SPEECH (Speech-Channel) "
in: Speech-Channel {SpeechChannel}.
Stop any speaking going on in channel <Speech-Channel>."
(error-free (#_StopSpeech Speech-Channel)))
;*************************************************
;* SPEECH Functions *
;*************************************************
(defun SPEAK-TEXT (Text &optional (Speech-Channel *Default-Speech-Channel*)) "
in: Text {string},
&optional Speech-Channel {SpeechChannel}.
Speak <String> synchronous, i.e, terminate when string spoken."
(cond
((speech-available-p)
(when Speech-Channel
(unwind-protect ; for clean aborts: stop speaking
(with-cstrs ((String Text))
(error-free (#_SpeakText Speech-Channel String (length Text)))
(loop (when (zerop (#_SpeechBusy)) (return))))
(stop-speech Speech-Channel))))
(t (format t "~%[Speech Substitute] ~A" Text))))
(defmacro WHILE-SPEAKING (Text &body Forms) "
in: Text {string}, &body Forms {t}.
Execute <Forms> WHILE <Text> is spoken using *Default-Speech-Channel*."
(let ((Str-Var (gensym)))
`(cond
((speech-available-p)
(unwind-protect ; for clean aborts: stop speaking
(with-cstrs ((,Str-Var ,Text))
(error-free (#_SpeakText (default-speech-channel) ,Str-Var (length ,Text)))
(loop
(when (zerop (#_SpeechBusy)) (return))
,@Forms))
(error-free (#_StopSpeech (default-speech-channel)))))
(t (format t "~%[Speech Substitute] ~A" ,Text)))))
(defmacro WHILE-COMPUTING-SPEAK (Text &body Forms) "
in: Text {string}, &body Forms {t}.
Execute <Forms> once, terminate speaking and return."
(let ((Str-Var (gensym)))
`(cond
((speech-available-p)
(unwind-protect ; for clean aborts: stop speaking
(with-cstrs ((,Str-Var ,Text))
(error-free (#_SpeakText (default-speech-channel) ,Str-Var (length ,Text)))
,@Forms)
(error-free (#_StopSpeech (default-speech-channel)))))
(t (format t "~%[Speech Substitute] ~A" ,Text)))))
;**************************************************
;* User Solicitations *
;**************************************************
(defun PICK-VOICE () "
out: Voice {VoiceSpec} or :cancel
Let user pick from currently installed voices."
(unless (speech-available-p) (error "VOICE MANAGER PROBLEM"))
(let ((Voices nil))
(dotimes (I (count-voices))
(let ((Voice (make-record :VoiceSpec)))
(#_GetIndVoice (1+ I) Voice)
(push Voice Voices)))
(let ((The-Voice
(first
(select-item-from-list
Voices
:window-title "Select a Voice:"
:table-print-function
#'(lambda (Voice Stream)
(rlet ((Info :VoiceDescription))
(#_GetVoiceDescription Voice Info #.(record-length :VoiceDescription))
(format Stream "~A: ~A, age: ~A"
(rref Info :VoiceDescription.name)
(rref Info :VoiceDescription.comment)
(rref Info :VoiceDescription.age))))))))
(dolist (Voice Voices The-Voice)
(unless (eql Voice The-Voice) (dispose-record Voice))))))
#| Examples:
(speech-available-p)
(get-default-speech-channel-from-user)
(speak-text "This is a fine computer!")
(while-speaking "hello" (prin1 '*))
(while-computing-speak "did the Pope go yet?" (dotimes (i 50) (print i)))
(speak-text "Four score and twenty years ago, our forefathers brought
forth on this continent a new nation, concieved in liberty and dedicated
to the proposition
that all men are created equal. Now we are engaged in a great civil war,
testing whether that nation or any nation so conceived and so dedicated can
long endure. We are met on a great battlefield of that war. We have come to
dedicate a portion of that field as a final resting-place for those who here
gave their lives that that nation might live. It is altogether fitting and
proper that we should do this. But in a larger sense, we cannot dedicate, we
cannot consecrate, we cannot hallow this ground. The brave men, living and
dead who struggled here have consecrated it far above our poor power to add
or detract. The world will little note nor long remember what we say here,
but it can never forget what they did here. It is for us the living rather to
be dedicated here to the unfinished work which they who fought here have thus
far so nobly advanced. It is rather for us to be here dedicated to the great
task remaining before us--that from these honored dead we take increased
devotion to that cause for which they gave the last full measure of
devotion--that we here highly resolve that these dead shall not have died in
vain, that this nation under God shall have a new birth of freedom, and that
government of the people, by the people, for the people shall not perish from
the earth.")
|#
~~~~~~~~~~~~~~~~~~~~~ the end ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
_/_/_/ _/_/_/ _/_/_/ Alex Repenning (ralex@cs.colorado.edu)
_/ _/ _/ _/ University of Colorado
_/ _/ _/ Department of Computer Science and
_/ _/ _/ Institute of Cognitive Science
_/ _/ _/ _/ Boulder, CO 80309-0430
_/_/_/ _/_/_/ Phone: (303) 492-1218