;;;-*- Mode: Lisp; Package: SPEECH -*- ;********************************************************************* ;* * ;* PROGRAM S P E E C H M A N A G E R * ;* * ;********************************************************************* ;* Author : Alexander Repenning (ralex@cs.colorado.edu) & * ;* Hal Eden (haleden@cs.colorado.edu) * ;* http://www.cs.colorado.edu/~ralex * ;* Copyright : (C) University of Colorado at Boulder * ;* Computer Science Department * ;* Boulder, CO 80303 * ;* 03/28/90 * ;* Filename : speech-manager.lisp * ;* Last Update : 11/15/97 * ;* Version : * ;* 1.0 : 08/16/93 The Pope is in Denver * ;* 1.1 : 05/01/95 Loadable without Speech Manager extension * ;* 1.2 : 06/17/96 includes Multi Voice Speech 1.2.4, * ;* require-trap in macros * ;* 1.2.1 : 08/15/97 Examples cleaned up * ;* 1.3 : 11/15/97 GET-NAMED-SPEECH-CHANNEL and * ;* VOICE-NAMES-AVAILABLE * ;* Systems : PPC 8500, MCL 4.1 * ;* Abstract : Basic functionality to use Mac Speech Manager * ;* Systems Requirements: Speech Manager extension (and lotsa RAM) * ;* Todo : add more specific result code error messages * ;* * ;****************************************************************** (defpackage SPEECH (:USE "COMMON-LISP-USER" "COMMON-LISP" "CCL") (:EXPORT "GET-DEFAULT-SPEECH-CHANNEL-FROM-USER" "SPEAK-TEXT" "WHILE-SPEAKING" "WHILE-COMPUTING-SPEAK" "SPEECH-AVAILABLE-P" "GET-SPEECH-CHANNEL-FROM-USER" "CLOSE-ALL-SPEECH-CHANNELS" "GET-NAMED-SPEECH-CHANNEL" "VOICE-NAMES-AVAILABLE")) (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" ',(case (first Trap-Call) (require-trap (second Trap-Call)) (t (first Trap-Call))) ,Result)))))) ;************************************************* ;* Globals * ;************************************************* (defvar *Default-Speech-Channel* nil "{SpeechChannel}") (defvar *Speech-Channels* (make-hash-table :test #'equal) "{hashtable {voice-name} => {channel}") ;************************************************* ;* 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))))) (when (speech-available-p) (pushnew :speech-manager *Features*)) (defun VOICE-NAMES-AVAILABLE () " out: {list of: {string}}. Return the list of all voice names available." (when (speech-available-p) (let ((Names nil)) (dotimes (I (count-voices) Names) (let ((Voice (make-record :VoiceSpec))) (#_GetIndVoice (1+ I) Voice) (rlet ((Info :VoiceDescription)) (#_GetVoiceDescription Voice Info #.(record-length :VoiceDescription)) (push (rref Info :VoiceDescription.name) Names))))))) ;************************************************* ;* Speech Channels * ;************************************************* (defun FIND-VOICE (Name) " in: Name {string}. out: Voice {voice}. Return a with if exists. Voice is a record that needs to be deallocated when no longer used." (let ((Voice (make-record :VoiceSpec))) (dotimes (I (count-voices)) (#_GetIndVoice (1+ I) Voice) (rlet ((Info :VoiceDescription)) (#_GetVoiceDescription Voice Info #.(record-length :VoiceDescription)) (when (string-equal Name (rref Info :VoiceDescription.name)) (return-from FIND-VOICE Voice)))) (dispose-record Voice) nil)) (defun MAKE-SPEECH-CHANNEL-FROM-VOICE (Voice) " in/out: Voice {voice}. out: Speech-Channel {SpeechChannel}. Return a Speech channel for . Cache channels: if channel for voice already exists -> reuse." (rlet ((Info :VoiceDescription)) (#_GetVoiceDescription Voice Info #.(record-length :VoiceDescription)) (let* ((Name (rref Info :VoiceDescription.name)) (Channel (gethash Name *Speech-Channels*))) (multiple-value-prog1 (cond (Channel (values Channel Name)) ; if there is a channel with this name: return it (t ; need to create a new channel (values (setf (gethash Name *Speech-Channels*) (rlet ((Snd :pointer)) (%put-ptr Snd (%null-ptr)) (error-free (#_NewSpeechChannel Voice Snd)) (%get-ptr Snd))) Name))))))) (defun GET-SPEECH-CHANNEL-FROM-USER (&optional (Prompt "Select a Voice:")) " in: &optional Prompt {string} \"Select a Voice:\" out: Speech-Channel {SpeechChannel}, Voice-Name {string}. Make the user select from the loaded voices and create a speech channel. If the voice has been selected before a SHARED channel is returned. Returns nil if speech manager is not available." (unless (speech-available-p) (return-from GET-SPEECH-CHANNEL-FROM-USER nil)) (let ((Voice (pick-voice Prompt))) (prog1 (make-speech-channel-from-voice Voice) (dispose-record Voice)))) (defun GET-NAMED-SPEECH-CHANNEL (Name) " in: Name {string}. out: Speech-Channel {SpeechChannel}. Return a speech channel installed with a voice . - if channel already exists reuse else - if voice exists make new channel else - ask user to select substitute channel and create alias." (unless (speech-available-p) (return-from GET-NAMED-SPEECH-CHANNEL nil)) (let ((Voice nil)) (cond ;; allready loaded ((gethash Name *Speech-Channels*)) ;; voice exists but needs to be loaded ((setq Voice (find-voice Name)) (prog1 (make-speech-channel-from-voice Voice) (dispose-record Voice))) ;; make user select voice (t (let ((Channel (get-speech-channel-from-user (format nil "Select Substitute Voice For \"~A\"" Name)))) ;; make alias (setf (gethash Name *Speech-Channels*) Channel) Channel))))) (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*. Returns nil if speech manager is not available." (unless (speech-available-p) (return-from GET-DEFAULT-SPEECH-CHANNEL-FROM-USER nil)) (when *Default-Speech-Channel* (#_DisposeSpeechChannel *Default-Speech-Channel*)) (rlet ((Snd :pointer)) (%put-ptr Snd (%null-ptr)) (error-free (#_NewSpeechChannel (pick-voice) Snd)) (setq *Default-Speech-Channel* (%get-ptr Snd))) *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))) (defun CLOSE-ALL-SPEECH-CHANNELS () " Close all the currently open speech channels." (maphash #'(lambda (Name Channel) (when Channel (#_DisposeSpeechChannel Channel) (setf (gethash Name *Speech-Channels*) nil))) *Speech-Channels*)) ;************************************************* ;* Low-Level Functions (not Exported) * ;************************************************* (defun COUNT-VOICES () " out: Number {fixnum}. Return number of instaleld voices" (unless (speech-available-p) (return-from COUNT-VOICES 0)) (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 ." (unless (speech-available-p) (return-from STOP-SPEECH)) (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 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 Channel &body Forms) " in: Text {string}, Channel {Channel}, &body Forms {t}. Execute WHILE 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 (require-trap #_SpeakText ,Channel ,Str-Var (length ,Text))) (loop (when (zerop (require-trap #_SpeechBusy)) (return)) ,@Forms)) (error-free (require-trap #_StopSpeech ,Channel)))) (t (format t "~%[Speech Substitute] ~A" ,Text))))) (defmacro WHILE-COMPUTING-SPEAK (Text Channel &body Forms) " in: Text {string}, Channel {Channel}, &body Forms {t}. Execute 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 (require-trap #_SpeakText ,Channel ,Str-Var (length ,Text))) ,@Forms) (error-free (require-trap #_StopSpeech ,Channel)))) (t (format t "~%[Speech Substitute] ~A" ,Text))))) ;************************************************** ;* User Solicitations * ;************************************************** (defun PICK-VOICE (&optional (Prompt "Select a Voice:")) " in: &optional Prompt {string} default \"Select a Voice:\" out: Voice {VoiceSpec} or :cancel Let user pick from currently installed voices." (unless (speech-available-p) (error "Speech is not available on this machine")) (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 Prompt :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) (voice-names-available) (let ((Channel (get-named-speech-channel "Fred"))) (when Channel (speak-text "I'm Fred the voice most likely to be on your mac" Channel))) (let ((Channel (get-named-speech-channel "Lorenzo"))) (when Channel (speak-text "You had to select a substitute voice for me" Channel))) (setq *V1* (get-speech-channel-from-user)) (setq *V2* (get-speech-channel-from-user)) (speak-text "Honney, where are my car keys?" *V1*) (speak-text "They are on the kitchen table like usual!" *V2*) (while-speaking "this is just a test" *V1* (princ "*")) (while-computing-speak "did the Pope go yet?" *V1* (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." *V1*) |#