(* ;;-*-LISP-*- KEEP EMACS HAPPY ********************************
*
*     PARAM.TO.COEF
*
*(1) SR = 10000
*(2) PLCONSTANT = .995 when SR = 10000
****************************************************************)

(DEFCONST PI 3.14159265)
(DEFVAR SR 10000)
(DEFVAR NWS 50)
(DEFVAR NSAMI .02)
(DEFVAR PERIODT .0001)
(DEFVAR PIT .0003141593)
(DEFVAR TWOPIT .0006283186)
(DEFVAR PLCONSTANT .995)

(DEFEXPR (SPEECH.SR (OPTIONAL SAMPLERATE 10000))
  (PROG ()
    (SETQ SR SAMPLERATE)
    (SETQ NWS (/ SR 200))
    (SETQ NSAMI (/$ 1.0 NWS))
    (SETQ PERIODT (/$ 1.0 SR))
    (SETQ PIT (x$ PI PERIODT))
    (SETQ TWOPIT (x$ 2.0 PIT))
    (SETQ PLCONSTANT (ANTILOG (x$ -50.13705 PERIODT)))
))

(* Parameters *)
(DATATYPE PARAM
  (AV ASV FGP BGP FGZ BGZ BGS SWITCH AFRIC AASPIR NCF
   F0 A1 B1 F1 A2 B2 F2 A3 B3 F3 A4 B4 F4 A5 B5 F5 A6 B6 F6
   FNZ BNZ ANP FNP BNP AB GAIN))

(DEFEXPR (SPEECH.CREATE.PARAM)
  (COPYALL USER.DEFAULT.PARAM)
)


(* ****************************************************************
*
*     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
*() NTIMEP: Cumulative time counter.
*() NTIMED:
****************************************************************)

(DATATYPE COEFF
  (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
   NTIMEP
   NTIMED
))

(* Difference Equation Constants *)

(RECORD RES (A B C)
  (ACCESSFNS
   ((BANDWIDTH (0-$ (/$ (LOG (0-$ (RES.C DATUM)))
		       TWOPIT)))
    (FREQUENCY (/$ (ARCCOS (/$ (RES.B DATUM) 
			      (x$ 2.0 (SQRT (0-$ (RES.C DATUM)))))
			  T)
		   TWOPIT)))
))

(DEFVAR NTIMPR -1)
(DEFVAR NPPBEG 1)
(DEFVAR NPPEND 39)

(DEFCONST DBSCA.A1 -58.0)
(DEFCONST DBSCA.A2 -65.0)
(DEFCONST DBSCA.A3 -73.0)
(DEFCONST DBSCA.A4 -78.0)
(DEFCONST DBSCA.A5 -79.0)
(DEFCONST DBSCA.A6 -80.0)
(DEFCONST DBSCA.ANP -58.0)
(DEFCONST DBSCA.AB -84.0)
(DEFCONST DBSCA.AV -72.0)
(DEFCONST DBSCA.AASPIR -102.0)
(DEFCONST DBSCA.AFRIC -72.0)
(DEFCONST DBSCA.ASV -44.0)

(DEFEXPR (SPEECH.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 (SPEECH.INIT.COEFF PARAM 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)
    (SPEECH.INIT.RES (COEFF.RESGP COEFF))
    (SPEECH.INIT.RES (COEFF.RESGZ COEFF))
    (SPEECH.INIT.RES (COEFF.RESGS COEFF))
    (SPEECH.INIT.RES (COEFF.RES1 COEFF))
    (SPEECH.INIT.RES (COEFF.RES2 COEFF))
    (SPEECH.INIT.RES (COEFF.RES3 COEFF))
    (SPEECH.INIT.RES (COEFF.RES4 COEFF))
    (SPEECH.INIT.RES (COEFF.RES5 COEFF))
    (SPEECH.INIT.RES (COEFF.RES6 COEFF))
    (SPEECH.INIT.RES (COEFF.RESNP COEFF))
    (SPEECH.INIT.RES (COEFF.RESNZ COEFF))
    (SETF (COEFF.PLSTEP COEFF) 0.0)
    (SETF (COEFF.PULSN COEFF) 0.0)
    (SETF (COEFF.SWITCH COEFF) (PARAM.SWITCH PARAM))
    (SETF (COEFF.NCF COEFF) (PARAM.NCF PARAM))
    (* Extra junk *)
    (SETF (COEFF.NTIMEP COEFF) 0.0)
    (SETF (COEFF.NTIMED COEFF) (/$ (x$ NWS 1000.0) SR))
))

(DEFEXPR (SPEECH.INIT.RES RES)
  (PROG ()
    (SETF (RES.A RES) 0.0)
    (SETF (RES.B RES) 0.0)
    (SETF (RES.C RES) 0.0)
))

(DEFEXPR (SPEECH.PARAM.TO.COEFF PARAM COEFF)
  (* Calculate synthesizer COEFFicients from PARAMeters. *)
  (PROG (CORRECTIONS)
    (SETF (COEFF.AB COEFF)
	  (SPEECH.GET.AMP (+$ (PARAM.AB PARAM) DBSCA.AB)))
    (SPEECH.PTC.ASPIRATION PARAM COEFF)
    (SPEECH.PTC.FRICATION PARAM COEFF)
    (SETQ CORRECTIONS (SPEECH.PTC.CORRECTIONS PARAM))
    (SPEECH.PTC.FORMANTS PARAM COEFF CORRECTIONS)
    (SPEECH.PTC.GLOTTAL PARAM COEFF)
    (SPEECH.PTC.NASAL PARAM COEFF)
    (SPEECH.PTC.VOICING PARAM COEFF)
))

(RECORD CORRECTIONS (A2COR A3COR N12COR N23COR N34COR))

(DEFEXPR (SPEECH.PTC.CORRECTIONS PARAM)
  (PROG (F1 F2 F3 F4 A2COR DELF2 A3COR N12COR N23COR N34COR
	    F21 F32 F43 CORRECTIONS)
    (SETQ F1 (PARAM.F1 PARAM))
    (SETQ F2 (PARAM.F2 PARAM))
    (SETQ F3 (PARAM.F3 PARAM))
    (SETQ F4 (PARAM.F4 PARAM))
    (* Compute amplitude corrections. *)
    (SETQ A2COR (EXPT (/$ (FLOAT F1) 500.0) 2.0))
    (SETQ DELF2 (/$ (FLOAT F2) 1500.0))
    (SETQ A3COR (x$ A2COR (x$ DELF2 DELF2)))
    (SETQ A2COR (/$ A2COR DELF2))
    (* Compute amplitude corrections due to proximity of 2 formants. *)
    (SETQ N12COR 0.0)
    (SETQ N23COR 0.0)
    (SETQ N34COR 0.0)
    (SETQ F21 (-$ F2 F1))
    (COND ((<$ F21 50.0)(GO EXIT))
	  ((<$ F21 550.0)
	   (SETQ N12COR (SPEECH.DBCOR F21))))
    (SETQ F32 (+$ F3 (0-$ F2) -50.0))
    (COND ((<$ F32 50.0)(GO EXIT))
	  ((<$ F3