MacinTalk access

[lamkins@cs.umb.edu (David B. Lamkins)]

While perusing the archives, I noticed a request for code to access Macintalk
from MACL. There's a gap between the end of the archive and my membership on
this list, so I apologize if this is old news, but here's some code that I use
to access Macintalk from MACL 1.3.2. Note the caveats regarding any system
files later than 6.0.5 - I've seen a new version of Macintalk that purports to
fix the problem when running under 6.0.7 or 7.0, but haven't tried it. Also,
since this code uses UNDOCUMENTED function in MACL 1.3.2, I wouldn't be
surprised if it stopped working in MCL 2.0 (I'm still waiting for my beta copy).

Dave
-------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; File:        Speech.Lisp
; Description: High-level interface to MacinTalk
; Author:      David B. Lamkins
; Created:     1990 10 14
; Last Change: 1990 10 14
;
; Copyright ) 1990, David B. Lamkins, all rights reserved
;
; Bugs:
;  MacinTalk is all but dead, officially. See TN #268. You should expect
;  that use of MacinTalk will break the Sound Manager on any Mac with the
;  Apple Sound Chip (SE/30, all Mac II series). Also, don't expect MacinTalk
;  to work at all with System 6.0.6, which has introduced the System 7
;  Sound Manager.
;
;  Error handling and recovery is minimal, at best. Driver open errors are
;  handled OK, but other errors could leave handles floating in the Mac heap.
;
; Features:
;
; Revisions:
;  1990 10 14, DBL - Added SPEECH-PITCH and SPEECH-RATE interfaces. Changed
;   file name to match package name so require mechanism can find the file
;   when it's not in one of the default directories.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package 'speech)

(provide 'speech)                            ;If this is first form in file,
                                             ;MACL's editor doesn't recognize
                                             ;IN-PACKAGE and set the window
                                             ;package automagically. This is
                                             ;why we break with GLS's order.
(export '(speak-english
          speak-phonemes
          english-to-phonemes
          close-macintalk
          speech-rate
          speech-pitch
          speech-exceptions-file))

(require 'traps)

(use-package 'ccl)

; We'll need utility functions to convert back and forth between
; LISP strings and Mac handles.

(defun lisp-string-to-mac-handle (text)
  (let* ((size (length text))
         (the-handle (_NewHandle :d0 size :a0)))
    (with-pointers ((p the-handle))
      (dotimes (i size)
        (%put-byte p (elt text i))
        (setf p (%inc-ptr p 1))))
    the-handle))

(defun mac-handle-to-lisp-string (handle)
  (let* ((size (_GetHandleSize :a0 handle :d0))
         (the-text (make-string size)))
    (with-pointers ((p handle))
      (dotimes (i size)
        (setf (elt the-text i) (character (%get-byte p i)))))
    the-text))

; MacinTalk uses a handle to store driver globals, and optionally uses an
; exceptions file to help with translation from English to phonemes. If the
; file name is "noReader", the reader portion of MacinTalk won't be loaded
; and only the phoneme interfaces will work.

(defvar *macintalk-speech-handle* nil)
(defvar *macintalk-exceptions-file* "")      ;file name or "noReader"

; We save changes in rate and pitch in case we need to close and reopen
; the MacinTalk driver. This differs from the standard MacinTalk interface,
; which would restore defaults under the same conditions, but allows us to
; change exceptions files on the fly without losing pitch and rate settings.

(defvar *macintalk-speech-rate*)             ;intentionally unbound
(defvar *macintalk-speech-pitch* '(0 :no-change))

; If the speech handle hasn't been allocated, MacinTalk hasn't been loaded.

(defun open-macintalk-if-needed ()
  (unless (handlep *macintalk-speech-handle*)
    (multiple-value-bind (handle error)
                         (ccl::%speechon *macintalk-exceptions-file*)
      (if (zerop error)
        (setf *macintalk-speech-handle* handle)
        (error "Error ~D opening MacinTalk" error)))
    (when (boundp '*macintalk-speech-rate*)
      (ccl::%speechrate *macintalk-speech-handle* *macintalk-speech-rate*))
    (apply #'ccl::%speechpitch *macintalk-speech-handle* *macintalk-speech-pitch*)))

; MacinTalk should be closed before leaving MACL. If not, the unit table will
; eventually fill up and cause MacinTalk to fail. One way to handle this cleanly
; would be (trace (quit :on-entry #'close-macintalk)), but this is limited to
; just the one action at quitting time. It would be better to build a mechanism
; handle a queue of quitting time actions and then put (close-macintalk) on the
; queue.

(defun close-macintalk ()
  (when (handlep *macintalk-speech-handle*)
    (ccl::%speechoff *macintalk-speech-handle*)))

; Specify the exceptions file at runtime, if needed.

(defun speech-exceptions-file (file)
  (close-macintalk)
  (setf *macintalk-exceptions-file* file))

; Adjust rate and pitch, and save any changes to be applied if we reopen
; Macintalk after it has been closed.

(defun speech-rate (rate)
  (open-macintalk-if-needed)
  (when (<= 85 rate 425)
    (setf *macintalk-speech-rate* rate)
    (ccl::%speechrate *macintalk-speech-handle* rate)))

(defun speech-pitch (pitch mode)
  (open-macintalk-if-needed)
  (let ((mode-arg (case mode
                    (:natural 0)
                    (:robotic 256)
                    (:no-change 512))))
    (if (<= 65 pitch 500)
      (setf (first *macintalk-speech-pitch*) pitch)
      (setf pitch 0))
    (when (neq mode :no-change)
      (setf (second *macintalk-speech-pitch*) mode-arg))
    (ccl::%speechpitch *macintalk-speech-handle* pitch mode-arg)))

; English text can be converted to phonemes for subsequent editing.

(defun english-to-phonemes (text)
  (open-macintalk-if-needed)
  (let ((text-handle (lisp-string-to-mac-handle text))
        phonemes)
    (with-pointers ((text-ptr text-handle))
      (let ((phoneme-handle (ccl::%reader *macintalk-speech-handle*
                                          text-ptr
                                          (length text))))
        (setf phonemes (mac-handle-to-lisp-string phoneme-handle))
        (_DisposHandle :a0 phoneme-handle)))
    (_DisposHandle :a0 text-handle)
    phonemes))

; This will speak English text using the default translation.

(defun speak-english (text)
  (open-macintalk-if-needed)
  (let ((text-handle (lisp-string-to-mac-handle text)))
    (with-pointers ((text-ptr text-handle))
      (let ((phoneme-handle (ccl::%reader *macintalk-speech-handle*
                                          text-ptr
                                          (length text))))
        (ccl::%macintalk *macintalk-speech-handle* phoneme-handle)
        (_DisposHandle :a0 phoneme-handle)))
    (_DisposHandle :a0 text-handle)))

; For finicky ears, you can specify the phonetic string. The string should
; be terminated with a '#' character.

(defun speak-phonemes (text)
  (open-macintalk-if-needed)
  (let ((phoneme-handle (lisp-string-to-mac-handle text)))
    (ccl::%macintalk *macintalk-speech-handle* phoneme-handle)
    (_DisposHandle :a0 phoneme-handle)))