More speech manager stuff

[seth@aic.hrl.hac.com]

I've got a good start on some wrapper routines for interfacing to the
speech manager but I'm a bit stuck with channels and SpeakText, the
latter returns -32767 when I try to say anything. Here's the code:

;-*- Mode: Lisp; Package: COMMON-LISP-USER -*-
;;;
;;; Written by Seth R. Goldman
;;; Copyright ) 1993 Hughes Aircraft Company
;;; Permission granted for non-commercial use.
;;;
(in-package :cl-user)

;;;
;;; Provide a simple interface to the Speech Manager
;;;
(defun TrapError? (result)
  "Make sure we get back a good result."
  (unless (zerop result)
    (cerror "Ignore it" "System error: ~D" result)))

;;;
;;; Syntactic Sugar for trap calls
;;;
(defun CanSpeak? (&aux result)
  (let ((response (#_newptr 4)))
    (TrapError? (#_gestalt #$gestaltSpeechAttr response))
    (setq result (logtest (%get-signed-long response) 
                          (expt 2 #$gestaltSpeechMgrPresent)))
    (#_disposptr response)
    result))

(defun CountVoices (&aux result)
  (let ((response (#_newptr 2)))
    (TrapError? (#_countvoices response))
    (setq result (%get-signed-word response))
    (#_disposptr response)
    result))

(defun GetIndVoice (idx &optional voice)
  (unless voice (setq voice (make-record :voicespec)))
  (TrapError? (#_getindvoice idx voice))
  voice)

(defun GetVoiceDescription (voice &optional info)
  (unless info (setq info (make-record :voicedescription)))
  (TrapError? (#_getvoicedescription voice info (pointer-size info)))
  info)

(defun StopSpeech (channel)
  (TrapError? (#_stopspeech channel)))

(defun SpeakString (str)
  (with-pstrs ((pstr str))
    (TrapError? (#_speakstring pstr))))

(defun SpeakText (channel str)
  (with-cstrs ((cstr str))
    (TrapError? (#_speaktext channel cstr (length str)))))

(defun NewSpeechChannel (voice &optional channel)
  (unless channel (setq channel (#_newhandle 4)))
  (with-pointers ((chan channel))
    (TrapError? (#_newspeechchannel voice chan)))
  channel)

(defun DisposeSpeechChannel (channel)
  (StopSpeech channel)
  (TrapError? (#_disposespeechchannel channel)))

(defun SpeechBusy? ()
  (not (zerop (#_speechbusy))))

(defun SpeechBusySystemWide? ()
  (not (zerop (#_speechbusysystemwide))))

;;;
;;; Utility Routines
;;;

(defvar *voices-table* nil)

(defun BuildVoicesTable ()
  (declare (special *voices-table*))
  (setq *voices-table* nil)
  (when (CanSpeak?)
    (dotimes (i (CountVoices))
      (push (GetVoiceDescription (GetIndVoice (1+ i)))
*voices-table*))))

(defun GetVoiceNames ()
  "Return a list of all currently loaded voice names."
  (declare (special *voices-table*))
  (when (CanSpeak?)
    (unless *voices-table* (BuildVoicesTable))
    (map 'list
         #'(lambda (info) (rref info VoiceDescription.name))
         *voices-table*)))

(defun GetVoiceDescriptionByName (name)
  (declare (special *voices-table*))
  (find name *voices-table*
        :test #'(lambda (x y)
                  (string-equal x (rref y VoiceDescription.name)))))

(defun SpeakWithNamedVoice (voice-name str &aux info)
  (when (setq info (GetVoiceDescriptionByName voice-name))
    (let ((channel (NewSpeechChannel (rref info
VoiceDescription.voice))))
      (unwind-protect (SpeakText channel str)
        (catch :done
          (loop (unless (SpeechBusy?) (throw :done t))))
        (DisposeSpeechChannel channel))
      t)))
    
(defun SpeechTest (&optional (msg "Testing 1 2 3, Testing"))
  (dolist (voice (GetVoiceNames))
    (print voice)
    (SpeakWithNamedVoice voice msg)))