;;; -*- Mode:Lisp; Syntax:Common-Lisp; Package:TALK; VSP:0; Fonts:(CPTFONT HL12 TR12I COURIER CPTFONT HL12B) -*-

;1;; File "*TALK1"*
;1;; Speaking phonemes on the TI D/A converter.  Depends on code in 3PHONEME-TRANSLATOR.LISP*.*
;1;;*
;1;; Copyright © 1989 David Forster.  Permission is granted for non-commercial use and distribution.*
;1;;*
;1;; 5ChangeLog:**
;1;;*
;1;;*		1David Forster*	1Created.*
;1;;   28 Feb 89*	1Jamie Zawinski*	1Added debugging code and handling of delays to TALK.*
;1;;*


(in-package "3TALK*")


(defvar 4*speech-table** (make-hash-table :test #'equal)
  "2Table of words (key) and sound-arrays (data) to `say' the words.  This is for special-cases.*")

(defvar 4*pause-table**
	'((#\. . 1000)  ;1 only deal with:* .,!?;:-()[]{}<>
	  (#\, .  250)  ;1 don't deal with:* @#$%^&*_=+`{}~\|'"/
	  (#\! . 1000)
	  (#\? . 1000)
	  (#\: . 1000)
	  (#\; .  750)
	  (#\- .  500)
	  (#\( .  500)
	  (#\) .  500)
	  (#\[ .  500)
	  (#\] .  500)
	  (#\{ .  500)
	  (#\} .  500)
	  (#\< .  500)
	  (#\> .  500)
	  (#\space . 0)
	  (#\tab   . 0))
   "2Table (alist) of punctuation symbols and pauses (in milliseconds) to correspond to them.
Caveat: all values are completely untweaked and dreamed-up.*")


(defun 4construct-from-string* (string)
  "2Convert the string to phonetics, and return a list of the sound-arrays for the phonetic elements of the word.*"
  (let ((sound-list '()))
    (do* ((phoneme-string (convert-string string nil))
	  (l (length phoneme-string))
	  (index 0 (1+ index)))
	 ((>= index l))
      (let ((phone (char phoneme-string index))
	    symbol)
	(when (upper-case-p phone)
	  (incf index)
	  (setq phone (make-array 2 :element-type 'string-char :initial-contents (list phone (char phoneme-string index)))))
	(setq symbol (find-symbol (string-upcase (string phone)) "3KEYWORD*"))
	(push (or (get symbol 'TV:SOUND-ARRAY)
		  (cdr (assoc phone 4*pause-table** :test #'eql))
		  (string phone))
	      sound-list)))
    (nreverse sound-list)))


(defun 4decipher-word* (word)
  "2Convert the string to phonetics, and return a list of the sound-arrays for the phonetic elements of the word.
  If the word has a special-case entry in *SPEECH-TABLE*, use that instead.*"
  (let (sound)
     (cond ((setf sound (or (gethash word *speech-table*)
			    (gethash (string-downcase word) *speech-table*)))
	    (list sound))
	   (t (construct-from-string word)))))


(defun 4talk* (text &optional dry-run-p)
   "2Say TEXT.*"
  (when dry-run-p (fresh-line))
  (dolist (array (decipher-word text) (values))
    (cond (dry-run-p
	   (cond ((consp array)
		  (princ (car array))
		  (princ (cdr array))
		  (princ #\Space))
		 ((numberp array)
		  (format t "3~&delay ~D~%*" array))
		 (t (princ array)
		    (princ #\Space))))
	  
	  ((numberp array)
	   (sleep (float (/ array 1000))))

	  ((stringp array)
	   (format t "3~&unknown - ~S~%*" array))

	  ((symbolp array)
	   (tv:play array))
	  
	  (t
	   (setf (get 'UTTERANCE 'TV:SOUND-ARRAY) array)
	   (tv:play 'UTTERANCE)))))