(FILECREATED "25-Jul-84 15:31:11" {ERIS}<SPEECH>ROACH>COEWAVE.FPKG;4
 29202  

      changes to:  (RECORDS RES)
		   (FNS COEFF.GET COEFF.PUT COEFF.INDEX COEWAVE.CREATE.COEFF COEWAVE.INIT.COEFF 
			MEMORY.GET MEMORY.PUT MEMORY.INDEX COEWAVE.CREATE.MEMORY COEWAVE.INIT.MEMORY 
			COEWAVE.INIT COEWAVE.CTW COEWAVE.CTW1 COEWAVE.GLOTTAL COEWAVE.TURBULENCE 
			COEWAVE.CASCADE COEWAVE.PARALLEL COEWAVE.SUM COEWAVE.STEP.RES 
			COEWAVE.STEP.ANTIRES COEWAVE.NOISE COEWAVE.TRACE COEWAVE.UNBREAK 
			COEWAVE.TRACEUPDATE))


(* Copyright (c)  by NIL. All rights reserved.)

(PRETTYCOMPRINT COEWAVECOMS)

(RPAQQ COEWAVECOMS
 ((INITVARS (COEWAVE.WINDOW NIL)
			      (COEWAVE.TRACE NIL))
	(RECORDS RES COEFF REG MEMORY)
	(FNS COEFF.GET COEFF.PUT COEFF.INDEX COEWAVE.CREATE.COEFF COEWAVE.INIT.COEFF MEMORY.GET 
	     MEMORY.PUT MEMORY.INDEX COEWAVE.CREATE.MEMORY COEWAVE.INIT.MEMORY COEWAVE.INIT 
	     COEWAVE.CTW COEWAVE.CTW1 COEWAVE.GLOTTAL COEWAVE.TURBULENCE COEWAVE.CASCADE 
	     COEWAVE.PARALLEL COEWAVE.SUM COEWAVE.STEP.RES COEWAVE.STEP.ANTIRES COEWAVE.NOISE 
	     COEWAVE.TRACE COEWAVE.UNBREAK COEWAVE.TRACEUPDATE)
	(P (SETQ COEFF.FIELDNAMES (CAR (NTH (RECLOOK 'COEFF)
					    4)))
	   (SETQ MEMORY.FIELDNAMES (CAR (NTH (RECLOOK 'MEMORY)
					     4))))))

(RPAQ? COEWAVE.WINDOW
 NIL)

(RPAQ? COEWAVE.TRACE
 NIL)
[DECLARE: EVAL@COMPILE 

(RECORD RES
 (A B C)
	    A ← 0.0 B ← 0.0 C ← 0.0
	    (ACCESSFNS ((BANDWIDTH (FMINUS (FQUOTIENT (LOG (FMINUS (fetch
 (RES C) of
 DATUM)))
						      TWOPIT)))
			(FREQUENCY (FQUOTIENT (ARCCOS
						(FQUOTIENT (fetch
 (RES B) of
 DATUM)
							   (FTIMES 2.0
								   (SQRT (FMINUS (fetch
 (RES C)
										    of
 DATUM)))))
						T)
					      TWOPIT)))))

(DATATYPE COEFF
                                              (* Synthesizer Coefficients *)

	  (AV ASV AB AFRIC AFRIC1 AASPIR A1 ANP A2 A3 A4 A5 A6 PLSTEP RESGP RESGZ RESGS RES1 RES2 
	      RES3 RES4 RES5 RES6 RESNP RESNZ PULSN SWITCH NCF))

(RECORD REG
 (T1 T2)
	    T1 ← 0.0 T2 ← 0.0)

(DATATYPE MEMORY
                                             (* Synthesizer Memory *)

	  (REG1P REG2P REG3P REG4P REG5P REG6P REGNP REGN REG1C REG2C REG3C REG4C REG5C REG6C REGNPC 
		 REGNZC REGGP REGGZ REGGS1 REGGS2 NPULSE MPULSE INPUTV INPUTSV UGLOTV UGLOT UGLOT1 
		 USUMC UDIF USUMP PLSTEP AFRIC DFRIC UFRIC AASPIR DASPIR UASPIR UCASC UPAR ULIPS 
		 OUTPUT))
]
(/DECLAREDATATYPE 'COEFF
		  '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
			    POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
			    POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
(/DECLAREDATATYPE 'MEMORY
		  '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
			    POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
			    POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
			    POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
			    POINTER POINTER POINTER POINTER))
(DEFINEQ

(COEFF.GET

  (LAMBDA (COEFF FIELDNAME)                                  (* kbr: "25-Jul-84 15:29")

    (PROG (DESCRIPTOR INDEX ANSWER)
          (SETQ DESCRIPTOR '(COEFF INDEX POINTER))
          (SETQ INDEX (COEFF.INDEX
 FIELDNAME))
          (RPLACA (CDR DESCRIPTOR)
		  INDEX)
          (SETQ ANSWER (FETCHFIELD DESCRIPTOR COEFF))
          (RETURN ANSWER))))

(COEFF.PUT

  (LAMBDA (COEFF FIELDNAME VALUE)                            (* kbr: "25-Jul-84 15:29")

    (PROG (DESCRIPTOR INDEX ANSWER)
          (SETQ DESCRIPTOR '(COEFF INDEX POINTER))
          (SETQ INDEX (COEFF.INDEX
 FIELDNAME))
          (RPLACA (CDR DESCRIPTOR)
		  INDEX)
          (SETQ ANSWER (REPLACEFIELD DESCRIPTOR COEFF VALUE))
          (RETURN ANSWER))))

(COEFF.INDEX

  (LAMBDA (FIELDNAME)                                        (* kbr: "25-Jul-84 15:29")

    (FOR
 I ← 0 BY
 (IPLUS I 2) AS
 F IN
 COEFF.FIELDNAMES WHEN
 (EQ F FIELDNAME) DO
 (RETURN I))))

(COEWAVE.CREATE.COEFF

  (LAMBDA NIL                                                (* kbr: "25-Jul-84 15:29")

    (PROG (COEFF)
          (SETQ COEFF (CREATE
 COEFF
			      RESGP ← (CREATE
 RES)
			      RESGZ ← (CREATE
 RES)
			      RESGS ← (CREATE
 RES)
			      RES1 ← (CREATE
 RES)
			      RES2 ← (CREATE
 RES)
			      RES3 ← (CREATE
 RES)
			      RES4 ← (CREATE
 RES)
			      RES5 ← (CREATE
 RES)
			      RES6 ← (CREATE
 RES)
			      RESNP ← (CREATE
 RES)
			      RESNZ ← (CREATE
 RES)))
          (RETURN COEFF))))

(COEWAVE.INIT.COEFF

  (LAMBDA (COEFF)                                            (* kbr: "25-Jul-84 15:29")

                                                             (* Initialize synthesizer before computing waveform 

							     chunk. *)

    (PROG NIL
          (replace
 (COEFF AV) of
 COEFF with
 0.0)
          (replace
 (COEFF ASV) of
 COEFF with
 0.0)
          (replace
 (COEFF AB) of
 COEFF with
 0.0)
          (replace
 (COEFF AFRIC) of
 COEFF with
 0.0)
          (replace
 (COEFF AFRIC1) of
 COEFF with
 0.0)
          (replace
 (COEFF AASPIR) of
 COEFF with
 0.0)
          (replace
 (COEFF A1) of
 COEFF with
 0.0)
          (replace
 (COEFF ANP) of
 COEFF with
 0.0)
          (replace
 (COEFF A2) of
 COEFF with
 0.0)
          (replace
 (COEFF A3) of
 COEFF with
 0.0)
          (replace
 (COEFF A4) of
 COEFF with
 0.0)
          (replace
 (COEFF A5) of
 COEFF with
 0.0)
          (replace
 (COEFF A6) of
 COEFF with
 0.0)
          (replace
 (COEFF RESGP) of
 COEFF with
 (CREATE
 RES))
          (replace
 (COEFF RESGZ) of
 COEFF with
 (CREATE
 RES))
          (replace
 (COEFF RESGS) of
 COEFF with
 (CREATE
 RES))
          (replace
 (COEFF RES1) of
 COEFF with
 (CREATE
 RES))
          (replace
 (COEFF RES2) of
 COEFF with
 (CREATE
 RES))
          (replace
 (COEFF RES3) of
 COEFF with
 (CREATE
 RES))
          (replace
 (COEFF RES4) of
 COEFF with
 (CREATE
 RES))
          (replace
 (COEFF RES5) of
 COEFF with
 (CREATE
 RES))
          (replace
 (COEFF RES6) of
 COEFF with
 (CREATE
 RES))
          (replace
 (COEFF RESNP) of
 COEFF with
 (CREATE
 RES))
          (replace
 (COEFF RESNZ) of
 COEFF with
 (CREATE
 RES))
          (replace
 (COEFF PLSTEP) of
 COEFF with
 0.0)
          (replace
 (COEFF PULSN) of
 COEFF with
 0.0)
          (replace
 (COEFF SWITCH) of
 COEFF with
 'CASCADE)
          (replace
 (COEFF NCF) of
 COEFF with
 5))))

(MEMORY.GET

  (LAMBDA (MEMORY FIELDNAME)                                 (* kbr: "25-Jul-84 15:29")

    (PROG (DESCRIPTOR INDEX ANSWER)
          (SETQ DESCRIPTOR '(MEMORY INDEX POINTER))
          (SETQ INDEX (MEMORY.INDEX
 FIELDNAME))
          (RPLACA (CDR DESCRIPTOR)
		  INDEX)
          (SETQ ANSWER (FETCHFIELD DESCRIPTOR MEMORY))
          (RETURN ANSWER))))

(MEMORY.PUT

  (LAMBDA (MEMORY FIELDNAME VALUE)                           (* kbr: "25-Jul-84 15:29")

    (PROG (DESCRIPTOR INDEX ANSWER)
          (SETQ DESCRIPTOR '(MEMORY INDEX POINTER))
          (SETQ INDEX (MEMORY.INDEX
 FIELDNAME))
          (RPLACA (CDR DESCRIPTOR)
		  INDEX)
          (SETQ ANSWER (REPLACEFIELD DESCRIPTOR MEMORY VALUE))
          (RETURN ANSWER))))

(MEMORY.INDEX

  (LAMBDA (FIELDNAME)                                        (* kbr: "25-Jul-84 15:29")

    (FOR
 I ← 0 BY
 (IPLUS I 2) AS
 F IN
 MEMORY.FIELDNAMES WHEN
 (EQ F FIELDNAME) DO
 (RETURN I))))

(COEWAVE.CREATE.MEMORY

  (LAMBDA NIL                                                (* kbr: "25-Jul-84 15:29")

    (PROG (MEMORY)
          (SETQ MEMORY (CREATE
 MEMORY
			       REG1P ← (CREATE
 REG)
			       REG2P ← (CREATE
 REG)
			       REG3P ← (CREATE
 REG)
			       REG4P ← (CREATE
 REG)
			       REG5P ← (CREATE
 REG)
			       REG6P ← (CREATE
 REG)
			       REGN ← (CREATE
 REG)
			       REGNP ← (CREATE
 REG)
			       REG1C ← (CREATE
 REG)
			       REG2C ← (CREATE
 REG)
			       REG3C ← (CREATE
 REG)
			       REG4C ← (CREATE
 REG)
			       REG5C ← (CREATE
 REG)
			       REG6C ← (CREATE
 REG)
			       REGNPC ← (CREATE
 REG)
			       REGNZC ← (CREATE
 REG)
			       REGGP ← (CREATE
 REG)
			       REGGS1 ← (CREATE
 REG)
			       REGGS2 ← (CREATE
 REG)
			       REGGZ ← (CREATE
 REG)))
          (RETURN MEMORY))))

(COEWAVE.INIT.MEMORY

  (LAMBDA (MEMORY)                                           (* kbr: "25-Jul-84 15:29")

    (PROG NIL
          (replace
 (MEMORY REG1P) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REG2P) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REG3P) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REG4P) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REG5P) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REG6P) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REGN) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REGNP) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REG1C) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REG2C) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REG3C) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REG4C) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REG5C) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REG6C) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REGNPC) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REGNZC) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REGGP) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REGGS1) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REGGS2) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY REGGZ) of
 MEMORY with
 (CREATE
 REG))
          (replace
 (MEMORY NPULSE) of
 MEMORY with
 40)
          (replace
 (MEMORY MPULSE) of
 MEMORY with
 0)
          (replace
 (MEMORY PLSTEP) of
 MEMORY with
 0.0)
          (replace
 (MEMORY AFRIC) of
 MEMORY with
 0.0)
          (replace
 (MEMORY AASPIR) of
 MEMORY with
 0.0)
          (replace
 (MEMORY DFRIC) of
 MEMORY with
 0.0)
          (replace
 (MEMORY UFRIC) of
 MEMORY with
 0.0)
          (replace
 (MEMORY DASPIR) of
 MEMORY with
 0.0)
          (replace
 (MEMORY UASPIR) of
 MEMORY with
 0.0)
          (replace
 (MEMORY INPUTV) of
 MEMORY with
 0.0)
          (replace
 (MEMORY INPUTSV) of
 MEMORY with
 0.0)
          (replace
 (MEMORY UGLOTV) of
 MEMORY with
 0.0)
          (replace
 (MEMORY UGLOT) of
 MEMORY with
 0.0)
          (replace
 (MEMORY USUMC) of
 MEMORY with
 0.0)
          (replace
 (MEMORY UDIF) of
 MEMORY with
 0.0)
          (replace
 (MEMORY USUMP) of
 MEMORY with
 0.0)
          (replace
 (MEMORY UCASC) of
 MEMORY with
 0.0)
          (replace
 (MEMORY UPAR) of
 MEMORY with
 0.0)
          (replace
 (MEMORY OUTPUT) of
 MEMORY with
 0.0))))

(COEWAVE.INIT

  (LAMBDA NIL                                                (* kbr: "25-Jul-84 15:29")

    (PROG NIL
          (SETQ COEWAVE.WINDOW (WDISPLAY.CREATEW "COEWAVE WINDOW"))
          (WDISPLAY.CLEARW COEWAVE.WINDOW))))

(COEWAVE.CTW

  (LAMBDA (COEFF MEMORY WAVE N1 N2)                          (* kbr: "25-Jul-84 15:29")

                                                             (* Synthesize elts N1 through N2 of WAVE using COEFF *)

    (PROG (DELTAN)                                           (* Delta amplitudes of aspiration and frication.

							     *)

          (SETQ DELTAN (IPLUS N2 (IMINUS N1)
			      1))
          (replace
 (MEMORY DASPIR) of
 MEMORY with
 (FQUOTIENT (FDIFFERENCE (fetch
 (COEFF AASPIR)
									     of
 COEFF)
									  (fetch
 (MEMORY AASPIR)
									     of
 MEMORY))
							     DELTAN))
          (replace
 (MEMORY DFRIC) of
 MEMORY with
 (FQUOTIENT (FDIFFERENCE (fetch
 (COEFF AFRIC)
									    of
 COEFF)
									 (fetch
 (MEMORY AFRIC)
									    of
 MEMORY))
							    DELTAN))
                                                             (* Plosive release. *)

          (replace
 (MEMORY PLSTEP) of
 MEMORY with
 (FMINUS (fetch
 (COEFF PLSTEP) of
 COEFF)))
                                                             (* Main loop *)

          (FOR
 N ← N1 TO
 N2 DO
 (COEWAVE.CTW1
 COEFF MEMORY WAVE N)))))

(COEWAVE.CTW1

  (LAMBDA (COEFF MEMORY WAVE N)                              (* kbr: "25-Jul-84 15:29")

    (PROG NIL
          (COEWAVE.GLOTTAL
 COEFF MEMORY)
          (COEWAVE.TURBULENCE
 COEFF MEMORY)                  (* Switch should feed signal to only one of CACADE and 

							     PARALLEL. *)

          (SELECTQ (fetch
 (COEFF SWITCH) of
 COEFF)
		   (CASCADE (COEWAVE.CASCADE
 COEFF MEMORY))
		   (PARALLEL (COEWAVE.PARALLEL
 COEFF MEMORY))
		   (SHOULDNT))
          (COEWAVE.SUM
 COEFF MEMORY)
          (SETA WAVE N (fetch
 (MEMORY OUTPUT) of
 MEMORY))
          (COND
	    (COEWAVE.TRACE
 (COEWAVE.TRACEUPDATE
 N MEMORY WAVE))))))

(COEWAVE.GLOTTAL

  (LAMBDA (COEFF MEMORY)                                     (* kbr: "25-Jul-84 15:29")

    (PROG (RESGP RESGZ RESGS REGGP REGGZ REGGS1 REGGS2 INPUTV INPUTSV UGLOTV UGLOTSV)
          (SETQ RESGP (fetch
 (COEFF RESGP) of
 COEFF))
          (SETQ RESGZ (fetch
 (COEFF RESGZ) of
 COEFF))
          (SETQ RESGS (fetch
 (COEFF RESGS) of
 COEFF))
          (SETQ REGGP (fetch
 (MEMORY REGGP) of
 MEMORY))
          (SETQ REGGZ (fetch
 (MEMORY REGGZ) of
 MEMORY))
          (SETQ REGGS1 (fetch
 (MEMORY REGGS1) of
 MEMORY))
          (SETQ REGGS2 (fetch
 (MEMORY REGGS2) of
 MEMORY))
          (replace
 (MEMORY NPULSE) of
 MEMORY with
 (SUB1 (fetch
 (MEMORY NPULSE) of
 MEMORY)))
          (replace
 (MEMORY MPULSE) of
 MEMORY with
 (SUB1 (fetch
 (MEMORY MPULSE) of
 MEMORY)))
          (COND
	    ((AND (ILEQ (fetch
 (MEMORY NPULSE) of
 MEMORY)
			0)
		  (IGREATERP (fetch
 (COEFF PULSN) of
 COEFF)
			     1))                             (* End of period. F0 <> 0.0 *)

	      (replace
 (MEMORY NPULSE) of
 MEMORY with
 (fetch
 (COEFF PULSN) of
 COEFF))
	      (replace
 (MEMORY MPULSE) of
 MEMORY with
 (IQUOTIENT (fetch
 (COEFF PULSN) of
 COEFF)
								 2))
	      (SETQ INPUTV (fetch
 (COEFF AV) of
 COEFF))
	      (SETQ INPUTSV (fetch
 (COEFF ASV) of
 COEFF)))
	    (T                                               (* Set INPUTV to 0 between glottal impulses.

							     *)

	       (SETQ INPUTV 0.0)
	       (SETQ INPUTSV 0.0)))                          (* Subtract out DC voltage. *)

          (SETQ INPUTV (FDIFFERENCE INPUTV (FQUOTIENT (fetch
 (COEFF AV) of
 COEFF)
						      (fetch
 (COEFF PULSN) of
 COEFF))))
          (SETQ INPUTSV (FDIFFERENCE INPUTSV (FQUOTIENT (fetch
 (COEFF ASV) of
 COEFF)
							(fetch
 (COEFF PULSN) of
 COEFF))))
          (replace
 (MEMORY INPUTV) of
 MEMORY with
 INPUTV)
          (replace
 (MEMORY INPUTSV) of
 MEMORY with
 INPUTSV)
                                                             (* GP%, GZ%, GP%, GS. *)

          (COEWAVE.STEP.RES
 INPUTV RESGP REGGP)
          (SETQ UGLOTV (COEWAVE.STEP.ANTIRES
 (fetch
 (REG T1) of
 REGGP)
					     RESGZ REGGZ))
          (replace
 (MEMORY UGLOTV) of
 MEMORY with
 UGLOTV)
          (COEWAVE.STEP.RES
 INPUTSV RESGS REGGS1)
          (COEWAVE.STEP.RES
 (fetch
 (REG T1) of
 REGGS1)
			    RESGP REGGS2)                    (* Calc glottal volume velocity.

							     *)

          (replace
 (MEMORY UGLOT1) of
 MEMORY with
 (fetch
 (MEMORY UGLOT) of
 MEMORY))
          (replace
 (MEMORY UGLOT) of
 MEMORY with
 (FPLUS UGLOTV (fetch
 (REG T1) of
 REGGS2))))))

(COEWAVE.TURBULENCE

  (LAMBDA (COEFF MEMORY)                                     (* kbr: "25-Jul-84 15:29")

                                                             (* Turbulence noise of aspiration and fircation.

							     *)

    (PROG (NOISE)
          (SETQ NOISE (COEWAVE.NOISE
))                       (* Modulate noise during second half of a glottal 

							     period. *)

          (COND
	    ((ILEQ (fetch
 (MEMORY MPULSE) of
 MEMORY)
		   0)
	      (SETQ NOISE (FQUOTIENT NOISE 2.0))))           (* Glottal AND frication source volume velocities.

							     *)

          (replace
 (MEMORY AASPIR) of
 MEMORY with
 (FPLUS (fetch
 (MEMORY AASPIR) of
 MEMORY)
							 (fetch
 (MEMORY DASPIR) of
 MEMORY)))
          (replace
 (MEMORY UASPIR) of
 MEMORY with
 (FTIMES (fetch
 (MEMORY AASPIR) of
 MEMORY)
							  NOISE))
          (replace
 (MEMORY AFRIC) of
 MEMORY with
 (FPLUS (fetch
 (MEMORY AFRIC) of
 MEMORY)
							(fetch
 (MEMORY DFRIC) of
 MEMORY)))
          (replace
 (MEMORY UFRIC) of
 MEMORY with
 (FTIMES (fetch
 (MEMORY AFRIC) of
 MEMORY)
							 NOISE)))))

(COEWAVE.CASCADE

  (LAMBDA (COEFF MEMORY)                                     (* kbr: "25-Jul-84 15:29")

    (PROG (RES1 RES2 RES3 RES4 RES5 RES6 RESNP RESNZ REG1C REG2C REG3C REG4C REG5C REG6C REGNPC 
		REGNZC REG5P REG6P UCASC)
          (SETQ RES1 (fetch
 (COEFF RES1) of
 COEFF))
          (SETQ RES2 (fetch
 (COEFF RES2) of
 COEFF))
          (SETQ RES3 (fetch
 (COEFF RES3) of
 COEFF))
          (SETQ RES4 (fetch
 (COEFF RES4) of
 COEFF))
          (SETQ RES5 (fetch
 (COEFF RES5) of
 COEFF))
          (SETQ RES6 (fetch
 (COEFF RES6) of
 COEFF))
          (SETQ RESNP (fetch
 (COEFF RESNP) of
 COEFF))
          (SETQ RESNZ (fetch
 (COEFF RESNZ) of
 COEFF))
          (SETQ REG1C (fetch
 (MEMORY REG1C) of
 MEMORY))
          (SETQ REG2C (fetch
 (MEMORY REG2C) of
 MEMORY))
          (SETQ REG3C (fetch
 (MEMORY REG3C) of
 MEMORY))
          (SETQ REG4C (fetch
 (MEMORY REG4C) of
 MEMORY))
          (SETQ REG5C (fetch
 (MEMORY REG5C) of
 MEMORY))
          (SETQ REG6C (fetch
 (MEMORY REG6C) of
 MEMORY))
          (SETQ REGNPC (fetch
 (MEMORY REGNPC) of
 MEMORY))
          (SETQ REGNZC (fetch
 (MEMORY REGNZC) of
 MEMORY))
          (SETQ REG5P (fetch
 (MEMORY REG5P) of
 MEMORY))
          (SETQ REG6P (fetch
 (MEMORY REG6P) of
 MEMORY))
          (replace
 (MEMORY USUMC) of
 MEMORY with
 (FPLUS (fetch
 (MEMORY UGLOT) of
 MEMORY)
							(fetch
 (MEMORY UASPIR) of
 MEMORY)))
                                                             (* Formants. *)

          (COND
	    ((ILESSP (fetch
 (COEFF NCF) of
 COEFF)
		     6)
	      (replace
 (REG T1) of
 REG6C with
 (fetch
 (MEMORY USUMC) of
 MEMORY)))
	    (T (COEWAVE.STEP.RES
 (fetch
 (MEMORY USUMC) of
 MEMORY)
				 RES6 REG6C)))
          (COND
	    ((ILESSP (fetch
 (COEFF NCF) of
 COEFF)
		     5)
	      (replace
 (REG T1) of
 REG5C with
 (fetch
 (MEMORY USUMC) of
 MEMORY)))
	    (T (COEWAVE.STEP.RES
 (fetch
 (REG T1) of
 REG6C)
				 RES5 REG5C)))
          (COEWAVE.STEP.RES
 (fetch
 (REG T1) of
 REG5C)
			    RES4 REG4C)
          (COEWAVE.STEP.RES
 (fetch
 (REG T1) of
 REG4C)
			    RES3 REG3C)
          (COEWAVE.STEP.RES
 (fetch
 (REG T1) of
 REG3C)
			    RES2 REG2C)
          (COEWAVE.STEP.RES
 (fetch
 (REG T1) of
 REG2C)
			    RES1 REG1C)                      (* Nasal. *)

          (SETQ UCASC (COEWAVE.STEP.ANTIRES
 (fetch
 (REG T1) of
 REG1C)
					    RESNZ REGNZC))
          (SETQ UCASC (COEWAVE.STEP.RES
 UCASC RESNP REGNPC))
          (replace
 (MEMORY UCASC) of
 MEMORY with
 UCASC)      (* Excite formant resonators F5-F6 with fric noise.

							     *)

          (COEWAVE.STEP.RES
 (fetch
 (MEMORY UFRIC) of
 MEMORY)
			    RES5 REG5P)
          (COEWAVE.STEP.RES
 (fetch
 (MEMORY UFRIC) of
 MEMORY)
			    RES6 REG6P))))

(COEWAVE.PARALLEL

  (LAMBDA (COEFF MEMORY)                                     (* kbr: "25-Jul-84 15:30")

                                                             (* Send voicing and frication noise thru parallel 

							     resonators. Increment resonator amplitudes gradually.

							     *)

    (PROG (RES1 RES2 RES3 RES4 RES5 RES6 RESNP REG1P REG2P REG3P REG4P REG5P REG6P REGN UGLOT1)
          (SETQ RES1 (fetch
 (COEFF RES1) of
 COEFF))
          (SETQ RES2 (fetch
 (COEFF RES2) of
 COEFF))
          (SETQ RES3 (fetch
 (COEFF RES3) of
 COEFF))
          (SETQ RES4 (fetch
 (COEFF RES4) of
 COEFF))
          (SETQ RES5 (fetch
 (COEFF RES5) of
 COEFF))
          (SETQ RES6 (fetch
 (COEFF RES6) of
 COEFF))
          (SETQ RESNP (fetch
 (COEFF RESNP) of
 COEFF))
          (SETQ REG1P (fetch
 (MEMORY REG1P) of
 MEMORY))
          (SETQ REG2P (fetch
 (MEMORY REG2P) of
 MEMORY))
          (SETQ REG3P (fetch
 (MEMORY REG3P) of
 MEMORY))
          (SETQ REG4P (fetch
 (MEMORY REG4P) of
 MEMORY))
          (SETQ REG5P (fetch
 (MEMORY REG5P) of
 MEMORY))
          (SETQ REG6P (fetch
 (MEMORY REG6P) of
 MEMORY))
          (SETQ REGN (fetch
 (MEMORY REGN) of
 MEMORY))        (* First formant F1. Excited by voicing only.

							     *)

          (COEWAVE.STEP.RES
 (FTIMES (fetch
 (COEFF A1) of
 COEFF)
				    (fetch
 (MEMORY UGLOT) of
 MEMORY))
			    RES1 REG1P)                      (* Nasal pole NP. Excited by first diff of voicing 

							     source. *)

          (replace
 (MEMORY UDIF) of
 MEMORY with
 (FDIFFERENCE (fetch
 (MEMORY UGLOT) of
 MEMORY)
							     (fetch
 (MEMORY UGLOT1) of
 MEMORY)))
          (COEWAVE.STEP.RES
 (FTIMES (fetch
 (COEFF ANP) of
 COEFF)
				    (fetch
 (MEMORY UDIF) of
 MEMORY))
			    RESNP REGN)                      (* Excite formants F2-F4 with fric noise plus first diff

							     voicing. *)

          (replace
 (MEMORY USUMP) of
 MEMORY with
 (FPLUS (fetch
 (MEMORY UDIF) of
 MEMORY)
							(fetch
 (MEMORY UFRIC) of
 MEMORY)))
          (COEWAVE.STEP.RES
 (FTIMES (fetch
 (COEFF A2) of
 COEFF)
				    (fetch
 (MEMORY USUMP) of
 MEMORY))
			    RES2 REG2P)
          (COEWAVE.STEP.RES
 (FTIMES (fetch
 (COEFF A3) of
 COEFF)
				    (fetch
 (MEMORY USUMP) of
 MEMORY))
			    RES3 REG3P)
          (COEWAVE.STEP.RES
 (FTIMES (fetch
 (COEFF A4) of
 COEFF)
				    (fetch
 (MEMORY USUMP) of
 MEMORY))
			    RES4 REG4P)                      (* Excite formant resonators F5-F6 with fric noise.

							     *)

          (COEWAVE.STEP.RES
 (FTIMES (fetch
 (COEFF A5) of
 COEFF)
				    (fetch
 (MEMORY UFRIC) of
 MEMORY))
			    RES5 REG5P)
          (COEWAVE.STEP.RES
 (FTIMES (fetch
 (COEFF A6) of
 COEFF)
				    (fetch
 (MEMORY UFRIC) of
 MEMORY))
			    RES6 REG6P))))

(COEWAVE.SUM

  (LAMBDA (COEFF MEMORY)                                     (* kbr: "25-Jul-84 15:30")

                                                             (* Sum up outputs. *)

    (PROG (REG1P REG2P REG3P REG4P REG5P REG6P REGN REGNPC OUTPUT UCASC UPAR)
          (SETQ REG1P (fetch
 (MEMORY REG1P) of
 MEMORY))
          (SETQ REG2P (fetch
 (MEMORY REG2P) of
 MEMORY))
          (SETQ REG3P (fetch
 (MEMORY REG3P) of
 MEMORY))
          (SETQ REG4P (fetch
 (MEMORY REG4P) of
 MEMORY))
          (SETQ REG5P (fetch
 (MEMORY REG5P) of
 MEMORY))
          (SETQ REG6P (fetch
 (MEMORY REG6P) of
 MEMORY))
          (SETQ REGN (fetch
 (MEMORY REGN) of
 MEMORY))
          (SETQ REGNPC (fetch
 (MEMORY REGNPC) of
 MEMORY))    (* Cascade output. *)

          (SETQ UCASC (fetch
 (MEMORY UCASC) of
 MEMORY))      (* Add up outputs from NP%, F1-F6%, and bypass path.

							     *)

          (SETQ UPAR (FPLUS (fetch
 (REG T1) of
 REG1P)
			    (FMINUS (fetch
 (REG T1) of
 REG2P))
			    (fetch
 (REG T1) of
 REG3P)
			    (FMINUS (fetch
 (REG T1) of
 REG4P))
			    (fetch
 (REG T1) of
 REG5P)
			    (FMINUS (fetch
 (REG T1) of
 REG6P))
			    (fetch
 (REG T1) of
 REGN)
			    (FMINUS (FTIMES (fetch
 (COEFF AB) of
 COEFF)
					    (fetch
 (MEMORY UFRIC) of
 MEMORY)))))
          (replace
 (MEMORY UPAR) of
 MEMORY with
 UPAR)        (* Add cascade and parallel vocal tract outputs.

							     *)

          (replace
 (MEMORY ULIPS) of
 MEMORY with
 (FPLUS UCASC UPAR (fetch
 (MEMORY PLSTEP)
								      of
 MEMORY)))
          (SETQ OUTPUT (FIXR (fetch
 (MEMORY ULIPS) of
 MEMORY)))
          (replace
 (MEMORY PLSTEP) of
 MEMORY with
 (FTIMES PLCONSTANT (fetch
 (MEMORY PLSTEP)
									of
 MEMORY)))
          (replace
 (MEMORY OUTPUT) of
 MEMORY with
 OUTPUT))))

(COEWAVE.STEP.RES

  (LAMBDA (INPUT RES REG)                                    (* kbr: "25-Jul-84 15:30")

                                                             (* Update memory REG. *)

    (PROG (T1 T2 A B C OUTPUT)
          (SETQ T1 (fetch
 (REG T1) of
 REG))
          (SETQ T2 (fetch
 (REG T2) of
 REG))
          (SETQ A (fetch
 (RES A) of
 RES))
          (SETQ B (fetch
 (RES B) of
 RES))
          (SETQ C (fetch
 (RES C) of
 RES))
          (SETQ OUTPUT (FPLUS (FTIMES A INPUT)
			      (FTIMES B T1)
			      (FTIMES C T2)))
          (replace
 (REG T2) of
 REG with
 T1)
          (replace
 (REG T1) of
 REG with
 OUTPUT)
          (RETURN OUTPUT))))

(COEWAVE.STEP.ANTIRES

  (LAMBDA (INPUT RES REG)                                    (* kbr: "25-Jul-84 15:30")

                                                             (* Update memory REG. *)

    (PROG (T1 T2 A B C OUTPUT)
          (SETQ T1 (fetch
 (REG T1) of
 REG))
          (SETQ T2 (fetch
 (REG T2) of
 REG))
          (SETQ A (fetch
 (RES A) of
 RES))
          (SETQ B (fetch
 (RES B) of
 RES))
          (SETQ C (fetch
 (RES C) of
 RES))
          (SETQ OUTPUT (FPLUS (FTIMES A INPUT)
			      (FTIMES B T1)
			      (FTIMES C T2)))
          (replace
 (REG T2) of
 REG with
 T1)
          (replace
 (REG T1) of
 REG with
 INPUT)
          (RETURN OUTPUT))))

(COEWAVE.NOISE

  (LAMBDA NIL                                                (* kbr: "25-Jul-84 15:30")

                                                             (* Pseudo GAUSSIAN *)

    (PROG (GAUSSIAN)
          (SETQ GAUSSIAN 0.0)
          (FOR
 I FROM
 1 TO
 16 DO
 (SETQ GAUSSIAN (FPLUS GAUSSIAN (RAND -.5 .5))))
          (RETURN GAUSSIAN))))

(COEWAVE.TRACE

  (LAMBDA (SIGNAL)                                           (* kbr: "25-Jul-84 15:30")

    (PROG NIL
          (COND
	    ((NOT (MEMB SIGNAL MEMORY.FIELDNAMES))
	      (LISPERROR "Can't trace " SIGNAL)))
          (COND
	    ((NULL COEWAVE.WINDOW)
	      (SETQ COEWAVE.WINDOW (WDISPLAY.CREATEW "Coewave Window"))))
          (WINDOWPROP COEWAVE.WINDOW 'TITLE (CONCAT "Coewave Window: " SIGNAL))
          (SETQ COEWAVE.TRACE SIGNAL))))

(COEWAVE.UNBREAK

  (LAMBDA NIL                                                (* kbr: "25-Jul-84 15:30")

    (PROG NIL
          (SETQ COEWAVE.TRACE NIL))))

(COEWAVE.TRACEUPDATE

  (LAMBDA (X MEMORY WAVE)                                    (* kbr: "25-Jul-84 15:30")

    (PROG (Y)
          (COND
	    ((IEQP X 1)
	      (WINDOWPROP COEWAVE.WINDOW 'WAVE WAVE)
	      (WDISPLAY.CLEARW COEWAVE.WINDOW)))
          (SETQ Y (MEMORY.GET
 MEMORY COEWAVE.TRACE))
          (COND
	    ((LISTP Y)                                       (* Y is a REG *)

	      (SETQ Y (fetch
 (REG T1) of
 Y)))
	    (T                                               (* Y is a number *)
))
          (WDISPLAY.DRAWXY X Y COEWAVE.WINDOW)
          (replace
 (MEMORY OUTPUT) of
 MEMORY with
 Y)
          (SETA WAVE X Y))))
)
(SETQ COEFF.FIELDNAMES (CAR (NTH (RECLOOK 'COEFF)
				 4)))
(SETQ MEMORY.FIELDNAMES (CAR (NTH (RECLOOK 'MEMORY)
				  4)))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (3072 29057 (COEFF.GET 3082 . 3455) (COEFF.PUT 3457 . 3838) (COEFF.INDEX 3840 . 4066) (
COEWAVE.CREATE.COEFF 4068 . 4641) (COEWAVE.INIT.COEFF 4643 . 6825) (MEMORY.GET 6827 . 7204) (
MEMORY.PUT 7206 . 7591) (MEMORY.INDEX 7593 . 7821) (COEWAVE.CREATE.MEMORY 7823 . 8736) (
COEWAVE.INIT.MEMORY 8738 . 11714) (COEWAVE.INIT 11716 . 11953) (COEWAVE.CTW 11955 . 13193) (
COEWAVE.CTW1 13195 . 13887) (COEWAVE.GLOTTAL 13889 . 16725) (COEWAVE.TURBULENCE 16727 . 17926) (
COEWAVE.CASCADE 17928 . 20933) (COEWAVE.PARALLEL 20935 . 23949) (COEWAVE.SUM 23951 . 25918) (
COEWAVE.STEP.RES 25920 . 26648) (COEWAVE.STEP.ANTIRES 26650 . 27381) (COEWAVE.NOISE 27383 . 27759) (
COEWAVE.TRACE 27761 . 28220) (COEWAVE.UNBREAK 28222 . 28386) (COEWAVE.TRACEUPDATE 28388 . 29055)))))
STOP