(FILECREATED " 6-Jun-84 14:40:05" {PHYLUM}<SPEECH>PHONTOPV.FPGK;1
 16255  )


(PRETTYCOMPRINT PHONTOPVCOMS)

(RPAQQ PHONTOPVCOMS
 ((FNS CHECK SPEAK FINDONSET DECODE.FEATURES MAKE.PHONEME SPEAK FIND.ALLOPHONES 
			  FIND.ALLOPHONES1 FIND.PHONEMES FIND.PHONEMES1 FIND.PHONEMES2 
			  FIND.V.FEATURES FINDCODA FINDNUCLEUS FIX.PHONEME OFFGLIDE FINDVOWEL 
			  TEST.GLUE TEST.SYNTH)
	(* PSVOWELS are the transcription symbols which on their own signify vowels; PSVOWELBEG are 
	   the transcription symbols which CAN initiate a vowel: PSVOWELEND are the transcriptoin 
	   symbols which CAN complete a vowel initiated by PSVOWELBEG)
	(VARS DEBUGFLG OFFGLIDES PHONETICSYMBOLS PSPHONEMELST PSVOWELS PSVOWELBEG PSVOWELEND 
	      PV.CONSONANTS PVECTOR SOUNDS NSOUNDS TR VCOMMENTS WOFFGLIDES WORDS)))
(DEFINEQ

(CHECK

  [LAMBDA (C1 V C2)                                          (* pkh: " 6-Jun-84 13:12")

    (PRINT (fetch
 (PVECTOR SOUND) of
 C1))
    (PRINT (fetch
 (PVECTOR COMMENT) of
 C1))
    (PRINT (fetch
 (PVECTOR SOUND) of
 V))
    (PRINT (fetch
 (PVECTOR COMMENT) of
 V))
    (PRINT (fetch
 (PVECTOR SOUND) of
 C2))
    (PRINT (fetch
 (PVECTOR COMMENT) of
 C2])

(SPEAK

  [LAMBDA (TRANSCRIPTION)                                    (* pkh: " 6-Jun-84 14:09")

                                                             (* Top level function for the synthesizer)

    (PROG ((SOUNDLIST (UNPACK TRANSCRIPTION))
	   NUCLEUS ONSET CODA FEATURES (SYLLABLE (create
 SYLLABLE)))

          (* TBW (FOR (SYLLABIFY SOUNDLIST) SYLLABLE IN DO BODY) (* Split the transcription up into units that correspond to

	  phonemes; Example: aY is AY.PHONEME; r%, is ER.PHONEME))


                                                             (* Find the phonemes going from transcriptions;

							     this function does the replaces in the syllable fields 

							     itself)

          (SETQ NUCLEUS (FINDNUCLEUS
 SOUNDLIST))
          (SETQ ONSET (FINDONSET
 SOUNDLIST NUCLEUS))
          (SETQ CODA (FINDCODA
 SOUNDLIST ONSET NUCLEUS))
          (replace
 ONSET of
 SYLLABLE with
 ONSET)
          (replace
 NUCLEUS of
 SYLLABLE with
 NUCLEUS)
          (replace
 CODA of
 SYLLABLE with
 CODA)
          (FIND.PHONEMES
 SYLLABLE)                           (* Find the correct PVECTORS 

							     (allophones) starting with phonemes;

							     then stuff them into the correct fields in the syllable)

          (SETQ ONSET (FIND.ALLOPHONES
 (fetch
 ONSET of
 SYLLABLE)
				       'ONSET SYLLABLE))
          (SETQ CODA (FIND.ALLOPHONES
 (fetch
 CODA of
 SYLLABLE)
				      'CODA SYLLABLE))
          (SETQ NUCLEUS (FIND.ALLOPHONES
 (fetch
 NUCLEUS of
 SYLLABLE)
					 'NUCLEUS SYLLABLE))
          (replace
 ONSET of
 SYLLABLE with
 ONSET)
          (replace
 NUCLEUS of
 SYLLABLE with
 NUCLEUS)
          (replace
 CODA of
 SYLLABLE with
 CODA)

          (* For the time being we only have a single in the ONSET NUCLEUS and OFFSET which can be passed to SPEECH.GLUE 

	  (* Better version TBW))



          (COND
	    [DEBUGFLG (RETURN (CHECK
 (CAR ONSET)
				     (CAR NUCLEUS)
				     (CAR CODA]
	    (T (RETURN (SPEECH.GLUE (CAR ONSET)
				    (CAR NUCLEUS)
				    (CAR CODA])

(FINDONSET

  [LAMBDA (SOUNDLIST NUCLEUS SYLLABLE)                       (* pkh: " 6-Jun-84 12:09")


          (* Finds the phonetic symbols which preceed a vowel and considers them the onset; returns a list of lists with 

	  each sublist containing the elements of a phonetic symbol; phonetic symbols may be complex%, i.e. they may consist

	  of more than a single character; Example: l~ desingates a thick l; were it an onset it would come out as 

	  ((l ~)))


                                                             (* TBW Check for complex onset symbols)

    (for
 P (V ←(CAAR NUCLEUS)) in
 SOUNDLIST until
 (EQ P V) collect
 (LIST P) finally
 (RETURN $$VAL])

(DECODE.FEATURES

  [LAMBDA (FLST PREORPOSTV)                                  (* pkh: " 6-Jun-84 13:15")

    (SELECTQ PREORPOSTV
	     [ONSET (COND
		      ((MEMB '+front FLST)
			'PREVFRONT)
		      ((AND (MEMB '+back FLST)
			    (MEMB '+round FLST))
			'PREVBACKROUNDED)
		      ((AND (MEMB '+back FLST)
			    (MEMB '-round FLST))
			'PREVBACKUNROUNDED)
		      ((MEMB '+round FLST)
			'PREVBACKROUNDED)
		      ((MEMB '-round FLST)
			'PREVBACKUNROUNDED)
		      (T (SHOULDNT]
	     [CODA (COND
		     ((MEMB FLST WOFFGLIDES)
		       'POSTVWOFFGLIDE)
		     (T 'POSTVNOWOFFGLIDE]
	     (SHOULDNT])


(SPEAK

  [LAMBDA (TRANSCRIPTION)                                    (* pkh: " 6-Jun-84 14:09")

                                                             (* Top level function for the synthesizer)

    (PROG ((SOUNDLIST (UNPACK TRANSCRIPTION))
	   NUCLEUS ONSET CODA FEATURES (SYLLABLE (create
 SYLLABLE)))

          (* TBW (FOR (SYLLABIFY SOUNDLIST) SYLLABLE IN DO BODY) (* Split the transcription up into units that correspond to

	  phonemes; Example: aY is AY.PHONEME; r%, is ER.PHONEME))


                                                             (* Find the phonemes going from transcriptions;

							     this function does the replaces in the syllable fields 

							     itself)

          (SETQ NUCLEUS (FINDNUCLEUS
 SOUNDLIST))
          (SETQ ONSET (FINDONSET
 SOUNDLIST NUCLEUS))
          (SETQ CODA (FINDCODA
 SOUNDLIST ONSET NUCLEUS))
          (replace
 ONSET of
 SYLLABLE with
 ONSET)
          (replace
 NUCLEUS of
 SYLLABLE with
 NUCLEUS)
          (replace
 CODA of
 SYLLABLE with
 CODA)
          (FIND.PHONEMES
 SYLLABLE)                           (* Find the correct PVECTORS 

							     (allophones) starting with phonemes;

							     then stuff them into the correct fields in the syllable)

          (SETQ ONSET (FIND.ALLOPHONES
 (fetch
 ONSET of
 SYLLABLE)
				       'ONSET SYLLABLE))
          (SETQ CODA (FIND.ALLOPHONES
 (fetch
 CODA of
 SYLLABLE)
				      'CODA SYLLABLE))
          (SETQ NUCLEUS (FIND.ALLOPHONES
 (fetch
 NUCLEUS of
 SYLLABLE)
					 'NUCLEUS SYLLABLE))
          (replace
 ONSET of
 SYLLABLE with
 ONSET)
          (replace
 NUCLEUS of
 SYLLABLE with
 NUCLEUS)
          (replace
 CODA of
 SYLLABLE with
 CODA)

          (* For the time being we only have a single in the ONSET NUCLEUS and OFFSET which can be passed to SPEECH.GLUE 

	  (* Better version TBW))



          (COND
	    [DEBUGFLG (RETURN (CHECK
 (CAR ONSET)
				     (CAR NUCLEUS)
				     (CAR CODA]
	    (T (RETURN (SPEECH.GLUE (CAR ONSET)
				    (CAR NUCLEUS)
				    (CAR CODA])

(FIND.ALLOPHONES

  [LAMBDA (PHONEMELST ONSETORCODA SYLLABLE)                  (* pkh: " 6-Jun-84 14:06")

                                                             (* Goes from syllable with phonetic transcription to 

							     allophones and PVECTORS)

                                                             (* (EVAL (CAR (fetch NUCLEUS of PHONEMELST))) is in 

							     order to get our hands on the nucleus phoneme)

    (COND
      ((NOT PHONEMELST)
	(LIST (fetch
 (PHONEME INVARIANT) of
 SI.PHONEME)))
      (T (SELECTQ ONSETORCODA
		  (ONSET (for
 X PVECTOR (ALLOPHONETYPE ←(DECODE.FEATURES

							 [FIND.V.FEATURES
 (EVAL (CAR (fetch
 NUCLEUS
											of
 SYLLABLE]
							 'ONSET))
			    in
 PHONEMELST collect
 (COND
						    ([SETQ PVECTOR
							(EVAL `
(FETCH
 (PHONEME ,ALLOPHONETYPE)
								  OF
 ,X]
						      PVECTOR)
						    ((SETQ PVECTOR (fetch
 INVARIANT
								      of
 (EVAL X)))
						      PVECTOR)
						    (T (SHOULDNT)))
			    finally
 (RETURN $$VAL)))
		  (CODA (for
 X PVECTOR
			     (ALLOPHONETYPE ←(DECODE.FEATURES

					      [fetch
 (PVECTOR SOUND)
						 of
 (fetch
 (PHONEME INVARIANT)
						       of
 (EVAL (CAR (fetch
 NUCLEUS of
 SYLLABLE]
					      'CODA))
			   in
 PHONEMELST collect
 [COND
						   ([SETQ PVECTOR
						       (EVAL `
(FETCH
 (PHONEME ,ALLOPHONETYPE)
								 OF
 ,X]
						     PVECTOR)
						   (T (fetch
 PREVFRONT of
 (EVAL X]
			   finally
 (RETURN $$VAL)))
		  (NUCLEUS (for
 X in
 (fetch
 NUCLEUS of
 SYLLABLE) collect
 (fetch
 INVARIANT
									    of
 (EVAL X))
			      finally
 (RETURN $$VAL)))
		  (SHOULDNT])



(FIND.PHONEMES1

  [LAMBDA (PSYMBOLLST)                                       (* pkh: " 6-Jun-84 12:40")


          (* Input: List of lists where each sublist has as elements the components of a transcription symbol;

	  Output: List of phonemes (i.e. AY.PHONEME etc.))




          (* (SETQ M (FIND.PHONEMES2 X)) (COND (M M) (T (COND ((MEMB (CADR PSYMBOLLST) (QUOTE (w y))) 

	  (SETQ PSYMBOLLST (CDR PSYMBOLLST)) (PACK* (U-CASE (MKATOM (PACK* X (CAR PSYMBOLLST)))) (QUOTE .PHONEME)))))))



    (for
 X M in
 PSYMBOLLST
       collect
 (SETQ M (PACK X))
	       (COND
		 ((SETQ M (ASSOC M PSPHONEMELST))
		   (CADR M))
		 (T (SHOULDNT)))
       finally
 (RETURN $$VAL])



(FINDCODA

  [LAMBDA (SOUNDLIST ONSET NUCLEUS)                          (* pkh: " 6-Jun-84 12:28")

                                                             (* TWB CHECK FOR COMPLEX TRANSCRIPTIONSYMBOLS IN THE 

							     SYLLABLE (SAME PROBLEM IN FINDONSET))

    (for
 X in
 [NTH SOUNDLIST (ADD1 (IPLUS (for
 Y in
 ONSET sum
 (LENGTH Y))
					  (for
 Y in
 NUCLEUS sum
 (LENGTH Y]
       collect
 (LIST X) finally
 (RETURN $$VAL])

(FINDNUCLEUS

  [LAMBDA (TRANSCRIPTION SYLLABLE)                           (* pkh: " 6-Jun-84 12:06")


          (* Returns the phonetic symbol of the vowel nucleus in a list of lists; the format for input to FIND.PHONEMES is a

	  list of lists where each sublist is the sequence of characters which designate a KLATT phoneme: The nucleus of 

	  "saYt" will therefore come into FIND.PHONEMES as ((aY)); the onset of "traYt" will come in as 

	  ((t) (r)))



    (for
 P S V G in
 old
 TRANSCRIPTION when
 (OR (MEMB P PSVOWELS)
					       (MEMB P PSVOWELBEG))
       do
                                                    (* Single symbol corresponding on its own to a vowel)

	  [COND
	    ([AND (MEMB P PSVOWELS)
		  (OR (NEQ P 'a)
		      (NOT (OFFGLIDE
 (CADR TRANSCRIPTION]
	      (SETQ V (LIST P)))
	    [(AND (MEMB P PSVOWELBEG)
		  (NEQ P 'y))                                (* Two symbols corresponding to a vowel)

	      (COND
		((MEMBER (CADR TRANSCRIPTION)
			 PSVOWELEND)
		  (SETQ V (LIST P (CADR TRANSCRIPTION]
	    ((AND (MEMB P PSVOWELBEG)
		  (EQ P 'y)
		  (EQ 'u (CADR TRANSCRIPTION))
		  (EQ 'W (CADDR TRANSCRIPTION)))
	      (SETQ V (LIST P (CADR TRANSCRIPTION)
			    (CADDR TRANSCRIPTION]
       finally
 (RETURN (LIST V])




(TEST.GLUE

  [LAMBDA (WORDS)                                            (* pkh: " 6-Jun-84 14:15")

    (for
 X RESULT in
 WORDS collect
 (CONS X (LIST (SPEAK
 X])

(TEST.SYNTH

  [LAMBDA (WORDS)                                            (* pkh: " 6-Jun-84 14:20")

    [SETQ ALST (for
 X RESULT in
 WORDS collect
 (CONS X (LIST (SPEAK
 X]
    (FOR
 X TRAJ IN
 ALST
       DO
 (SETQ USER.TRAJS (CADR X))
	  (SPEECH.TEST])
)



(* PSVOWELS are the transcription symbols which on their own signify vowels; PSVOWELBEG are the
 transcription symbols which CAN initiate a vowel: PSVOWELEND are the transcriptoin symbols 
which CAN complete a vowel initiated by PSVOWELBEG)



(RPAQQ DEBUGFLG
 NIL)

(RPAQQ OFFGLIDES
 (Y W y w))

(RPAQQ PHONETICSYMBOLS
 (P T K p t k b d g D 0 & f v s z S Z C J W Y m n G ~ y w l r R %, : H L M ? x 
			  "l~"
			  i I U u o c a - E @ e))

(RPAQQ PSPHONEMELST
 ((p PP.PHONEME)
		     (t TT.PHONEME)
		     (k KK.PHONEME)
		     (b BB.PHONEME)
		     (d DD.PHONEME)
		     (g GG.PHONEME)
		     (t TT.PHONEME)
		     (0 TH.PHONEME)
		     (& DH.PHONEME)
		     (f FF.PHONEME)
		     (v VV.PHONEME)
		     (s SS.PHONEME)
		     (z ZZ.PHONEME)
		     (S SH.PHONEME)
		     (I IH.PHONEME)
		     (C CH.PHONEME)
		     (J JH.PHONEME)
		     (@ AE.PHONEME)
		     (↑ AH.PHONEME)
		     (w WW.PHONEME)
		     (y YY.PHONEME)
		     (m MM.PHONEME)
		     (n NN.PHONEME)
		     (yuW YU.PHONEME)
		     (uW UW.PHONEME)
		     (l LL.PHONEME)
		     (r RR.PHONEME)
		     (oY OY.PHONEME)
		     (oW OW.PHONEME)
		     (aW AW.PHONEME)
		     (aY AY.PHONEME)
		     (h HH.PHONEME)
		     (eY EY.PHONEME)
		     (iY IY.PHONEME)
		     (r%, ER.PHONEME)
		     (↑ UH.PHONEME)
		     (U UH.PHONEME)
		     (c AO.PHONEME)
		     (E EH.PHONEME)
		     (a AA.PHONEME)
		     (Y NIL)
		     (W NIL)
		     (Z NIL)
		     (l~ NIL)
		     (x NIL)
		     (U NIL)
		     (? NIL)
		     (M NIL)
		     (L NIL)
		     (H NIL)
		     (: NIL)
		     (%, NIL)
		     (R NIL)
		     (N NIL)
		     (G NIL)))

(RPAQQ PSVOWELS
 (I U c a E @ ↑))

(RPAQQ PSVOWELBEG
 (i e a o u r y))

(RPAQQ PSVOWELEND
 (Y W %, uW))

(RPAQQ PV.CONSONANTS
 (SPEECH.FFb SPEECH.VVf SPEECH.VVb SPEECH.THf SPEECH.THb SPEECH.DHf SPEECH.DHb 
				 SPEECH.SSf SPEECH.SSbu SPEECH.SSr SPEECH.ZZf SPEECH.ZZbu SPEECH.ZZb 
				 SPEECH.SHf SPEECH.SHbu SPEECH.CHbu SPEECH.SHr SPEECH.CHf SPEECH.CHr 
				 SPEECH.JHf SPEECH.JHbu SPEECH.JHr SPEECH.PPf SPEECH.PPb SPEECH.BBf 
				 SPEECH.BBb SPEECH.TTf SPEECH.TTbu SPEECH.TTr SPEECH.DDf SPEECH.DDbu 
				 SPEECH.DDr SPEECH.KKf SPEECH.KKbu SPEECH.KKr SPEECH.GGf SPEECH.GGbu 
				 SPEECH.GGr SPEECH.MMf SPEECH.MMb SPEECH.NNf SPEECH.NNbu SPEECH.NNr 
				 SPEECH.WW SPEECH.YY SPEECH.RR SPEECH.LL SPEECH.HH SPEECH.SI 
				 SPEECH.TTnw SPEECH.TTw))

(RPAQQ PVECTOR
 NIL)

(RPAQQ SOUNDS
 (SPEECH.IY SPEECH.IH SPEECH.EY SPEECH.EH SPEECH.AE SPEECH.AY SPEECH.AA SPEECH.AW 
			 SPEECH.AH SPEECH.AO SPEECH.OW SPEECH.OY SPEECH.UH SPEECH.UW SPEECH.ER 
			 SPEECH.YU SPEECH.FFf SPEECH.FFb SPEECH.VVf SPEECH.VVb SPEECH.THf SPEECH.THb 
			 SPEECH.DHf SPEECH.DHb SPEECH.SSf SPEECH.SSbu SPEECH.SSr SPEECH.ZZf 
			 SPEECH.ZZbu SPEECH.ZZb SPEECH.SHf SPEECH.SHbu SPEECH.CHbu SPEECH.SHr 
			 SPEECH.CHf SPEECH.CHr SPEECH.JHf SPEECH.JHbu SPEECH.JHr SPEECH.PPf 
			 SPEECH.PPb SPEECH.BBf SPEECH.BBb SPEECH.TTf SPEECH.TTbu SPEECH.TTr 
			 SPEECH.DDf SPEECH.DDbu SPEECH.DDr SPEECH.KKf SPEECH.KKbu SPEECH.KKr 
			 SPEECH.GGf SPEECH.GGbu SPEECH.GGr SPEECH.MMf SPEECH.MMb SPEECH.NNf 
			 SPEECH.NNbu SPEECH.NNr SPEECH.WW SPEECH.YY SPEECH.RR SPEECH.LL SPEECH.HH 
			 SPEECH.SI SPEECH.TTnw SPEECH.TTw))

(RPAQQ NSOUNDS
 (SPEECH.FFf SPEECH.FFb SPEECH.VVf SPEECH.VVb SPEECH.THf SPEECH.THb SPEECH.DHf 
			   SPEECH.DHb SPEECH.SSf SPEECH.SSbu SPEECH.SSr SPEECH.ZZf SPEECH.ZZbu 
			   SPEECH.ZZb SPEECH.SHf SPEECH.SHbu SPEECH.CHbu SPEECH.SHr SPEECH.CHf 
			   SPEECH.CHr SPEECH.JHf SPEECH.JHbu SPEECH.JHr SPEECH.PPf SPEECH.PPb 
			   SPEECH.BBf SPEECH.BBb SPEECH.TTf SPEECH.TTbu SPEECH.TTr SPEECH.DDf 
			   SPEECH.DDbu SPEECH.DDr SPEECH.KKf SPEECH.KKbu SPEECH.KKr SPEECH.GGf 
			   SPEECH.GGbu SPEECH.GGr SPEECH.MMf SPEECH.MMb SPEECH.NNf SPEECH.NNbu 
			   SPEECH.NNr SPEECH.WW SPEECH.YY SPEECH.RR SPEECH.LL SPEECH.HH SPEECH.SI 
			   SPEECH.TTnw SPEECH.TTw))

(RPAQQ TR
 {PVECTOR}#15,121374)

(RPAQQ VCOMMENTS
 ((IY (* as in "beet" (+front)
			 *))
		  (IH (* as in "bit" (+front)
			 *))
		  (EY (* as in "bait" (+front)
			 *))
		  (EH (* as in "bet" (+front)
			 *))
		  (AE (* as in "bat" (+front)
			 *))
		  (AY (* as in "bite" (+back -round)
			 *))
		  (AA (* as in "Bob" (+back -round)
			 *))
		  (AW (* as in "bout" (+back -round)
			 *))
		  (AH (* as in "but" (+front -round)
			 *))
		  (AO (* as in "bought" (+round)
			 *))
		  (OW (* as in "boat" (+round)
			 *))
		  (OY (* as in "boy" (+round)
			 *))
		  (UH (* as in "book" (+round)
			 *))
		  (UW (* as in "boot" (+round)
			 *))
		  (ER (* as in "Bert" (+round)
			 *))
		  (YU (* as in "pew" (+front)
			 *))))

(RPAQQ WOFFGLIDES
 (OW UW AW YU))

(RPAQQ WORDS
 (saYt keYt fIt pIk bct boWt br%,t))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (798 11568 (CHECK 808 . 1214) (SPEAK 1216 . 3371) (FINDONSET 3373 . 4083) (
DECODE.FEATURES 4085 . 4696) (SPEAK 4699 . 6854) (FIND.ALLOPHONES 6856 . 8605) (FIND.PHONEMES1 8609 . 
9312) (FINDCODA 9316 . 9796) (FINDNUCLEUS 9798 . 11093) (TEST.GLUE 11098 . 11280) (TEST.SYNTH 11282 . 
11566)))))
STOP