(* ;;-*-LISP-*- KEEP EMACS HAPPY ********************************
*
*     SPEECH -- COEFFICIENTS TO WAVE 
*
****************************************************************)


(* ****************************************************************
*
*     COEFFs -- SYNTHESIZER COEFFICIENTS
*
*(1) Amplitudes absolute, frequencies Hertz.
*
*() AB: Bypass amplitude
*() AFRIC: Frication amplitude
*() AFRIC1: Previous frication amplitude
*() AASPIR: Aspiration amplitude
*() AV: Voicing amplitude (IMPULSE)
*() PLSTEP: Plosive step
*() ASV: Sinusoidal voicing amplitude (SINAMP)
*() PULSN: Number of samples before a new glottal pulse may be
*generated.
*() SWITCH: CASCADE or PARALLEL
*() NCF: Number of cascaded formants
****************************************************************)

(RECORD RES (A B C)
  A ← 0.0
  B ← 0.0
  C ← 0.0
  (ACCESSFNS
   ((BANDWIDTH (0-$ (/$ (LOG (0-$ (RES.C DATUM)))
			TWOPIT)))
    (FREQUENCY (/$ (ARCCOS (/$ (RES.B DATUM) 
			      (x$ 2.0 (SQRT (0-$ (RES.C 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))

(SETQ COEFF.FIELDNAMES
  (KTH (RECLOOK 'COEFF) 4))

(DEFEXPR (COEFF.GET COEFF FIELDNAME)
  (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)
))

(DEFEXPR (COEFF.PUT COEFF FIELDNAME VALUE)
  (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)
))

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

(DEFEXPR (COEWAVE.CREATE.COEFF)
  (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)
))

(DEFEXPR (COEWAVE.INIT.COEFF COEFF)
  (* Initialize synthesizer before computing waveform chunk. *)
  (PROG () 
    (SETF (COEFF.AV COEFF) 0.0)
    (SETF (COEFF.ASV COEFF) 0.0)
    (SETF (COEFF.AB COEFF) 0.0)
    (SETF (COEFF.AFRIC COEFF) 0.0)
    (SETF (COEFF.AFRIC1 COEFF) 0.0)
    (SETF (COEFF.AASPIR COEFF) 0.0)
    (SETF (COEFF.A1 COEFF) 0.0)
    (SETF (COEFF.ANP COEFF) 0.0)
    (SETF (COEFF.A2 COEFF) 0.0)
    (SETF (COEFF.A3 COEFF) 0.0)
    (SETF (COEFF.A4 COEFF) 0.0)
    (SETF (COEFF.A5 COEFF) 0.0)
    (SETF (COEFF.A6 COEFF) 0.0)
    (SETF (COEFF.RESGP COEFF) (CREATE RES))
    (SETF (COEFF.RESGZ COEFF) (CREATE RES))
    (SETF (COEFF.RESGS COEFF) (CREATE RES))
    (SETF (COEFF.RES1 COEFF) (CREATE RES))
    (SETF (COEFF.RES2 COEFF) (CREATE RES))
    (SETF (COEFF.RES3 COEFF) (CREATE RES))
    (SETF (COEFF.RES4 COEFF) (CREATE RES))
    (SETF (COEFF.RES5 COEFF) (CREATE RES))
    (SETF (COEFF.RES6 COEFF) (CREATE RES))
    (SETF (COEFF.RESNP COEFF) (CREATE RES))
    (SETF (COEFF.RESNZ COEFF) (CREATE RES))
    (SETF (COEFF.PLSTEP COEFF) 0.0)
    (SETF (COEFF.PULSN COEFF) 0.0)
    (SETF (COEFF.SWITCH COEFF) 'CASCADE)
    (SETF (COEFF.NCF COEFF) 5)
))


(* ****************************************************************
*
*     MEMORY
*
*() UGLOT = Sum of outputs from RGZ & RGS
*() UGLOT1 = Previous UGLOT
*() UASPIR = Aspiration
*() UFRIC = Frication
*() USUMC = Sum of UGLOT & UASPIR
*() UDIF = First difference of UGLOT (UGLOT - UGLOT1)
*() USUMP = Sum of UFRIC & UDIF
****************************************************************)

(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))

(SETQ MEMORY.FIELDNAMES
  (KTH (RECLOOK 'MEMORY) 4))

(DEFEXPR (MEMORY.GET MEMORY FIELDNAME)
  (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)
))

(DEFEXPR (MEMORY.PUT MEMORY FIELDNAME VALUE)
  (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)
))

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

(DEFEXPR (COEWAVE.CREATE.MEMORY)
  (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)
))

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

(DEFVAR COEWAVE.WINDOW)
(DEFEXPR (COEWAVE.INIT)
  (PROG ()
    (SETQ COEWAVE.WINDOW (WDISPLAY.CREATEW "COEWAVE WINDOW"))
    (WDISPLAY.CLEARW COEWAVE.WINDOW)
))

(DEFEXPR (COEWAVE.CTW COEFF MEMORY WAVE N1 N2)
  (* Synthesize elts N1 through N2 of WAVE using COEFF *)
  (PROG (DELTAN)
    (* Delta amplitudes of aspiration and frication. *)
    (SETQ DELTAN (+ N2 (0- N1) 1))
    (SETF (MEMORY.DASPIR MEMORY)
	  (/$ (-$ (COEFF.AASPIR COEFF) (MEMORY.AASPIR MEMORY))
	      DELTAN))
    (SETF (MEMORY.DFRIC MEMORY)
	  (/$ (-$ (COEFF.AFRIC COEFF) (MEMORY.AFRIC MEMORY))
	      DELTAN))
    (* Plosive release. *)
    (SETF (MEMORY.PLSTEP MEMORY) (0-$ (COEFF.PLSTEP COEFF)))
    (* Main loop *)
    (FOR N ← N1 TO N2
     DO (COEWAVE.CTW1 COEFF MEMORY WAVE N))
))

(DEFEXPR (COEWAVE.CTW1 COEFF MEMORY WAVE N)
  (PROG ()
    (COEWAVE.GLOTTAL COEFF MEMORY)
    (COEWAVE.TURBULENCE COEFF MEMORY)
    (* Switch should feed signal to only one of CACADE and PARALLEL. *)
    (SELECTQ (COEFF.SWITCH COEFF)
      (CASCADE (COEWAVE.CASCADE COEFF MEMORY))
      (PARALLEL (COEWAVE.PARALLEL COEFF MEMORY))
      (SHOULDNT))
    (COEWAVE.SUM COEFF MEMORY)
    (SETF (ELT WAVE N) (MEMORY.OUTPUT MEMORY))
    (COND (COEWAVE.TRACE (COEWAVE.TRACEUPDATE N MEMORY WAVE)))
))

(DEFEXPR (COEWAVE.GLOTTAL COEFF MEMORY)
  (PROG (RESGP RESGZ RESGS REGGP REGGZ REGGS1 REGGS2 INPUTV INPUTSV
	       UGLOTV UGLOTSV)
    (SETQ RESGP (COEFF.RESGP COEFF))
    (SETQ RESGZ (COEFF.RESGZ COEFF))    
    (SETQ RESGS (COEFF.RESGS COEFF))
    (SETQ REGGP (MEMORY.REGGP MEMORY))
    (SETQ REGGZ (MEMORY.REGGZ MEMORY))    
    (SETQ REGGS1 (MEMORY.REGGS1 MEMORY))
    (SETQ REGGS2 (MEMORY.REGGS2 MEMORY))
    (SETF (MEMORY.NPULSE MEMORY) (1- (MEMORY.NPULSE MEMORY)))
    (SETF (MEMORY.MPULSE MEMORY) (1- (MEMORY.MPULSE MEMORY)))
    (COND ((AND (<= (MEMORY.NPULSE MEMORY) 0)
		(> (COEFF.PULSN COEFF) 1))
	   (* End of period.  F0 <> 0. *)
	   (SETF (MEMORY.NPULSE MEMORY) (COEFF.PULSN COEFF))
	   (SETF (MEMORY.MPULSE MEMORY) (/ (COEFF.PULSN COEFF) 2))
	   (SETQ INPUTV (COEFF.AV COEFF))
	   (SETQ INPUTSV (COEFF.ASV COEFF)))
	  (T (* Set INPUTV to 0 between glottal impulses. *)
	     (SETQ INPUTV 0.0)
	     (SETQ INPUTSV 0.0)))
    (* Subtract out DC voltage. *)
    (SETQ INPUTV (-$ INPUTV (/$ (COEFF.AV COEFF) (COEFF.PULSN COEFF))))
    (SETQ INPUTSV (-$ INPUTSV (/$ (COEFF.ASV COEFF) (COEFF.PULSN COEFF))))
    (SETF (MEMORY.INPUTV MEMORY) INPUTV)
    (SETF (MEMORY.INPUTSV MEMORY) INPUTSV)
    (* GP, GZ, GP, GS. *)
    (COEWAVE.STEP.RES INPUTV RESGP REGGP)
    (SETQ UGLOTV (COEWAVE.STEP.ANTIRES (REG.T1 REGGP) RESGZ REGGZ))
    (SETF (MEMORY.UGLOTV MEMORY) UGLOTV)
    (COEWAVE.STEP.RES INPUTSV RESGS REGGS1)
    (COEWAVE.STEP.RES (REG.T1 REGGS1) RESGP REGGS2)
    (* Calc glottal volume velocity. *)
    (SETF (MEMORY.UGLOT1 MEMORY) (MEMORY.UGLOT MEMORY))
    (SETF (MEMORY.UGLOT MEMORY) (+$ UGLOTV (REG.T1 REGGS2)))
))

(DEFEXPR (COEWAVE.TURBULENCE COEFF MEMORY)
  (* Turbulence noise of aspiration and fircation. *)
  (PROG (NOISE)
    (SETQ NOISE (COEWAVE.NOISE))
    (* Modulate noise during second half of a glottal period. *)
    (COND ((<= (MEMORY.MPULSE MEMORY) 0)
	   (SETQ NOISE (/$ NOISE 2.0))))
    (* Glottal AND frication source volume velocities. *)
    (SETF (MEMORY.AASPIR MEMORY) 
	  (+$ (MEMORY.AASPIR MEMORY) (MEMORY.DASPIR MEMORY)))
    (SETF (MEMORY.UASPIR MEMORY) (x$ (MEMORY.AASPIR MEMORY) NOISE))
    (SETF (MEMORY.AFRIC MEMORY)
	  (+$ (MEMORY.AFRIC MEMORY) (MEMORY.DFRIC MEMORY)))
    (SETF (MEMORY.UFRIC MEMORY) (x$ (MEMORY.AFRIC MEMORY) NOISE))
))

(DEFEXPR (COEWAVE.CASCADE COEFF MEMORY)
  (PROG (RES1 RES2 RES3 RES4 RES5 RES6 RESNP RESNZ
	 REG1C REG2C REG3C REG4C REG5C REG6C 
	 REGNPC REGNZC REG5P REG6P UCASC)
    (SETQ RES1 (COEFF.RES1 COEFF))
    (SETQ RES2 (COEFF.RES2 COEFF))    
    (SETQ RES3 (COEFF.RES3 COEFF))
    (SETQ RES4 (COEFF.RES4 COEFF))
    (SETQ RES5 (COEFF.RES5 COEFF))
    (SETQ RES6 (COEFF.RES6 COEFF))
    (SETQ RESNP (COEFF.RESNP COEFF))
    (SETQ RESNZ (COEFF.RESNZ COEFF))
    (SETQ REG1C (MEMORY.REG1C MEMORY))
    (SETQ REG2C (MEMORY.REG2C MEMORY))    
    (SETQ REG3C (MEMORY.REG3C MEMORY))
    (SETQ REG4C (MEMORY.REG4C MEMORY))
    (SETQ REG5C (MEMORY.REG5C MEMORY))
    (SETQ REG6C (MEMORY.REG6C MEMORY))
    (SETQ REGNPC (MEMORY.REGNPC MEMORY))
    (SETQ REGNZC (MEMORY.REGNZC MEMORY))
    (SETQ REG5P (MEMORY.REG5P MEMORY))
    (SETQ REG6P (MEMORY.REG6P MEMORY))
    (SETF (MEMORY.USUMC MEMORY)
	  (+$ (MEMORY.UGLOT MEMORY) (MEMORY.UASPIR MEMORY)))
    (* Formants. *)
    (COND ((< (COEFF.NCF COEFF) 6)
	   (SETF (REG.T1 REG6C) (MEMORY.USUMC MEMORY)))
	  (T (COEWAVE.STEP.RES (MEMORY.USUMC MEMORY) RES6 REG6C)))
    (COND ((< (COEFF.NCF COEFF) 5)
	   (SETF (REG.T1 REG5C) (MEMORY.USUMC MEMORY)))
	  (T (COEWAVE.STEP.RES (REG.T1 REG6C) RES5 REG5C)))
    (COEWAVE.STEP.RES (REG.T1 REG5C) RES4 REG4C)
    (COEWAVE.STEP.RES (REG.T1 REG4C) RES3 REG3C)
    (COEWAVE.STEP.RES (REG.T1 REG3C) RES2 REG2C)
    (COEWAVE.STEP.RES (REG.T1 REG2C) RES1 REG1C)
    (* Nasal. *)
    (SETQ UCASC (COEWAVE.STEP.ANTIRES (REG.T1 REG1C) RESNZ REGNZC))
    (SETQ UCASC (COEWAVE.STEP.RES UCASC RESNP REGNPC))
    (SETF (MEMORY.UCASC MEMORY) UCASC)
    (* Excite formant resonators F5-F6 with fric noise. *)
    (COEWAVE.STEP.RES (MEMORY.UFRIC MEMORY) RES5 REG5P)
    (COEWAVE.STEP.RES (MEMORY.UFRIC MEMORY) RES6 REG6P)
))

(DEFEXPR (COEWAVE.PARALLEL COEFF MEMORY)
  (* 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 (COEFF.RES1 COEFF))
    (SETQ RES2 (COEFF.RES2 COEFF))    
    (SETQ RES3 (COEFF.RES3 COEFF))
    (SETQ RES4 (COEFF.RES4 COEFF))
    (SETQ RES5 (COEFF.RES5 COEFF))
    (SETQ RES6 (COEFF.RES6 COEFF))
    (SETQ RESNP (COEFF.RESNP COEFF))
    (SETQ REG1P (MEMORY.REG1P MEMORY))
    (SETQ REG2P (MEMORY.REG2P MEMORY))    
    (SETQ REG3P (MEMORY.REG3P MEMORY))
    (SETQ REG4P (MEMORY.REG4P MEMORY))
    (SETQ REG5P (MEMORY.REG5P MEMORY))
    (SETQ REG6P (MEMORY.REG6P MEMORY))
    (SETQ REGN (MEMORY.REGN MEMORY))
    (* First formant F1.  Excited by voicing only. *)
    (COEWAVE.STEP.RES (x$ (COEFF.A1 COEFF) (MEMORY.UGLOT MEMORY))
		       RES1 REG1P)
    (* Nasal pole NP.  Excited by first diff of voicing source. *)
    (SETF (MEMORY.UDIF MEMORY)
	  (-$ (MEMORY.UGLOT MEMORY) (MEMORY.UGLOT1 MEMORY)))
    (COEWAVE.STEP.RES (x$ (COEFF.ANP COEFF) (MEMORY.UDIF MEMORY))
		       RESNP REGN)
    (* Excite formants F2-F4 with fric noise plus first diff 
       voicing. *)
    (SETF (MEMORY.USUMP MEMORY)
	  (+$ (MEMORY.UDIF MEMORY) (MEMORY.UFRIC MEMORY)))
    (COEWAVE.STEP.RES (x$ (COEFF.A2 COEFF) (MEMORY.USUMP MEMORY))
		       RES2 REG2P)
    (COEWAVE.STEP.RES (x$ (COEFF.A3 COEFF) (MEMORY.USUMP MEMORY))
		       RES3 REG3P)
    (COEWAVE.STEP.RES (x$ (COEFF.A4 COEFF) (MEMORY.USUMP MEMORY))
		       RES4 REG4P)
    (* Excite formant resonators F5-F6 with fric noise. *)
    (COEWAVE.STEP.RES (x$ (COEFF.A5 COEFF) (MEMORY.UFRIC MEMORY))
		       RES5 REG5P)
    (COEWAVE.STEP.RES (x$ (COEFF.A6 COEFF) (MEMORY.UFRIC MEMORY))
		       RES6 REG6P)
))

(DEFEXPR (COEWAVE.SUM COEFF MEMORY)
  (* Sum up outputs. *)
  (PROG (REG1P REG2P REG3P REG4P REG5P REG6P REGN REGNPC OUTPUT UCASC
	       UPAR) 
    (SETQ REG1P (MEMORY.REG1P MEMORY))
    (SETQ REG2P (MEMORY.REG2P MEMORY))    
    (SETQ REG3P (MEMORY.REG3P MEMORY))
    (SETQ REG4P (MEMORY.REG4P MEMORY))
    (SETQ REG5P (MEMORY.REG5P MEMORY))
    (SETQ REG6P (MEMORY.REG6P MEMORY))
    (SETQ REGN (MEMORY.REGN MEMORY))
    (SETQ REGNPC (MEMORY.REGNPC MEMORY))
    (* Cascade output. *)
    (SETQ UCASC (MEMORY.UCASC MEMORY))
    (* Add up outputs from NP, F1-F6, and bypass path. *)
    (SETQ UPAR (+$ (REG.T1 REG1P)
		    (0-$ (REG.T1 REG2P))
		    (REG.T1 REG3P)
		    (0-$ (REG.T1 REG4P))
		    (REG.T1 REG5P)
		    (0-$ (REG.T1 REG6P))
		    (REG.T1 REGN)
		    (0-$ (x$ (COEFF.AB COEFF) (MEMORY.UFRIC MEMORY)))))
    (SETF (MEMORY.UPAR MEMORY) UPAR)
    (* Add cascade and parallel vocal tract outputs. *)
    (SETF (MEMORY.ULIPS MEMORY) (+$ UCASC UPAR (MEMORY.PLSTEP MEMORY)))
    (SETQ OUTPUT (FIXR (MEMORY.ULIPS MEMORY)))
    (SETF (MEMORY.PLSTEP MEMORY) (x$ PLCONSTANT (MEMORY.PLSTEP MEMORY)))
    (SETF (MEMORY.OUTPUT MEMORY) OUTPUT)
))

(DEFEXPR (COEWAVE.STEP.RES INPUT RES REG)
  (* Update memory REG. *)
  (PROG (T1 T2 A B C OUTPUT)
    (SETQ T1 (REG.T1 REG))
    (SETQ T2 (REG.T2 REG))
    (SETQ A (RES.A RES))
    (SETQ B (RES.B RES))
    (SETQ C (RES.C RES))
    (SETQ OUTPUT (+$ (x$ A INPUT) (x$ B T1) (x$ C T2)))
    (SETF (REG.T2 REG) T1)
    (SETF (REG.T1 REG) OUTPUT)
    (RETURN OUTPUT)
))

(DEFEXPR (COEWAVE.STEP.ANTIRES INPUT RES REG)
  (* Update memory REG. *)
  (PROG (T1 T2 A B C OUTPUT)
    (SETQ T1 (REG.T1 REG))
    (SETQ T2 (REG.T2 REG))
    (SETQ A (RES.A RES))
    (SETQ B (RES.B RES))
    (SETQ C (RES.C RES))
    (SETQ OUTPUT (+$ (x$ A INPUT) (x$ B T1) (x$ C T2)))
    (SETF (REG.T2 REG) T1)
    (SETF (REG.T1 REG) INPUT)
    (RETURN OUTPUT)
))

(DEFEXPR (COEWAVE.NOISE)
  (* Pseudo GAUSSIAN *)
  (PROG (GAUSSIAN)
    (SETQ GAUSSIAN 0.0)
    (FOR I FROM 1 TO 16
     DO (SETQ GAUSSIAN (+$ GAUSSIAN (RAND -0.5 0.5))))
    (RETURN GAUSSIAN)))


(* ****************************************************************
*
*     DEBUGGING ETC
*
****************************************************************)

(DEFVAR COEWAVE.TRACE)
(DEFEXPR (COEWAVE.TRACE SIGNAL)
  (PROG ()
    (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)
))

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

(DEFEXPR (COEWAVE.TRACEUPDATE X MEMORY WAVE)
  (PROG (Y)
    (COND ((= 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 (REG.T1 Y)))
	  (T (* Y is a number *)))
    (WDISPLAY.DRAWXY X Y COEWAVE.WINDOW)
    (SETF (MEMORY.OUTPUT MEMORY) Y)
    (SETF (ELT WAVE X) Y)
))

(* ****************************************************************
*STOP
****************************************************************)

STOP