(* ;;-*-LISP-*- KEEP EMACS HAPPY ********************************
*
* PVECTOR.TO.COEF
*
****************************************************************)
(* ****************************************************************
*
* PVECTORs -- PARAMETER VECTORS
*
*(1) SLICE consists of values
*(2) SEGMENT consists of abstract PATHs
*(3) TRAJ consists of real PATHs
*(4) PATH consists of TVPOINTs
****************************************************************)
(DATATYPE PVECTOR
(* Parameter Vector *)
(TYPE SOUND CV COMMENT DURATION
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))
(SETQ PVECTOR.FIELDNAMES
(KTH (RECLOOK 'PVECTOR) 4))
(* The PVECTOR fieldnames which are also pnames *)
(SETQ PVECTOR.PNAMES
(MEMB 'AV PVECTOR.FIELDNAMES))
(DEFEXPR (PVECTOR.GET PVECTOR FIELDNAME)
(PROG (DESCRIPTOR INDEX ANSWER)
(SETQ DESCRIPTOR '(PVECTOR INDEX POINTER))
(SETQ INDEX (PVECTOR.INDEX FIELDNAME))
(RPLACA (CDR DESCRIPTOR) INDEX)
(SETQ ANSWER (FETCHFIELD DESCRIPTOR PVECTOR))
(RETURN ANSWER)
))
(DEFEXPR (PVECTOR.PUT PVECTOR FIELDNAME VALUE)
(PROG (DESCRIPTOR INDEX ANSWER)
(SETQ DESCRIPTOR '(PVECTOR INDEX POINTER))
(SETQ INDEX (PVECTOR.INDEX FIELDNAME))
(RPLACA (CDR DESCRIPTOR) INDEX)
(SETQ ANSWER (REPLACEFIELD DESCRIPTOR PVECTOR VALUE))
(RETURN ANSWER)
))
(DEFEXPR (PVECTOR.INDEX FIELDNAME)
(FOR I ← 0 BY (+ I 2)
AS F IN PVECTOR.FIELDNAMES
WHEN (EQ F FIELDNAME)
DO (RETURN I)))
(DEFVAR DEFAULT.SLICE)
(DEFVAR OW.SLICE)
(DEFEXPR (PARCOE.INIT)
(PROG ()
(SETQ DEFAULT.SLICE
(CREATE PVECTOR
TYPE ← 'SLICE
SOUND ← 'DEFAULT
CV ← ""
COMMENT ← '(* DEFAULT.SLICE *)
DURATION ← 0
AV ← 0
ASV ← 0
AASPIR ← 0
AFRIC ← 0
F0 ← 0
FGP ← 0
BGP ← 400
FGZ ← 1500
BGZ ← 6000
FNP ← 250
BNP ← 100
FNZ ← 250
BNZ ← 100
BGS ← 200
F1 ← 450
B1 ← 50
F2 ← 1450
B2 ← 70
F3 ← 2450
B3 ← 110
F4 ← 3300
B4 ← 250
F5 ← 3850
B5 ← 200
F6 ← 4900
B6 ← 1000
A1 ← 0
ANP ← 0
A2 ← 0
A3 ← 0
A4 ← 0
A5 ← 0
A6 ← 0
AB ← 0
SWITCH ← 'CASCADE
GAIN ← 36
NCF ← 5))
(SETQ OW.SLICE
(CREATE PVECTOR
TYPE ← 'SLICE
SOUND ← 'DEFAULT
CV ← ""
COMMENT ← '(* OW.SLICE *)
DURATION ← NIL
AV ← 60.0
ASV ← 0.0
AASPIR ← 0.0
AFRIC ← 0.0
F0 ← 118.0
FGP ← 0.0
BGP ← 400.0
FGZ ← 1500.0
BGZ ← 6000.0
FNP ← 250.0
BNP ← 100.0
FNZ ← 250.0
BNZ ← 100.0
BGS ← 200.0
F1 ← 510.0
B1 ← 80.0
F2 ← 1033.333
B2 ← 70.0
F3 ← 2300.0
B3 ← 70.0
F4 ← 3300.0
B4 ← 250.0
F5 ← 3850.0
B5 ← 200.0
F6 ← 4900.0
B6 ← 1000.0
A1 ← 0.0
ANP ← 0.0
A2 ← 0.0
A3 ← 0.0
A4 ← 0.0
A5 ← 0.0
A6 ← 0.0
AB ← 0.0
SWITCH ← 'CASCADE
GAIN ← 36.0
NCF ← 5))
))
(* ****************************************************************
*
* INTERPOLATION
*
****************************************************************)
(RECORD TVPOINT (TIME VALUE M B))
(RECORD TVPOINT2 (TIME VALUE))
(DEFEXPR (PARCOE.INTERPOLATE
TIME TRAJ (OPTIONAL OLDSLICE (CREATE PVECTOR)))
(PROG ()
(FOR PNAME IN PVECTOR.PNAMES
DO (PARCOE.INTERPOLATE.PNAME PNAME TIME TRAJ OLDSLICE))
(RETURN OLDSLICE)
))
(DEFEXPR (PARCOE.INTERPOLATE.PNAME PNAME TIME TRAJ PVECTOR)
(PROG (PATH LEFTPOINT RIGHTPOINT LTIME RTIME LVALUE RVALUE K VALUE)
(SETQ PATH (PVECTOR.GET TRAJ PNAME))
(FOR L IN PATH
AS R IN (CDR PATH)
WHEN (AND (<= (TVPOINT.TIME L) TIME)
(> (TVPOINT.TIME R) TIME))
DO (SETQ LEFTPOINT L)
(SETQ RIGHTPOINT R)
(RETURN))
(SETQ LTIME (TVPOINT.TIME LEFTPOINT))
(SETQ RTIME (TVPOINT.TIME RIGHTPOINT))
(SETQ LVALUE (TVPOINT.VALUE LEFTPOINT))
(SETQ RVALUE (TVPOINT.VALUE RIGHTPOINT))
(COND ((MEMB PNAME '(SWITCH NCF))
(SETQ VALUE LVALUE))
(T (SETQ K (/$ (-$ TIME LTIME) (-$ RTIME LTIME)))
(SETQ VALUE (+$ (x$ K RVALUE) (x$ (-$ 1.0 K) LVALUE)))))
(PVECTOR.PUT PVECTOR PNAME VALUE)
))
(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 (PARCOE.PTC PVECTOR COEFF)
(* Calculate synthesizer COEFFicients from PVECTOReters. *)
(PROG ()
(PARCOE.GLOTTAL PVECTOR COEFF)
(PARCOE.VOICING PVECTOR COEFF)
(PARCOE.ASPIRATION PVECTOR COEFF)
(PARCOE.FRICATION PVECTOR COEFF)
(PARCOE.BYPASS PVECTOR COEFF)
(PARCOE.FORMANTS PVECTOR COEFF)
(PARCOE.NASAL PVECTOR COEFF)
))
(DEFEXPR (PARCOE.GLOTTAL PVECTOR COEFF)
(* Glottal resonators and antiresonator. *)
(PROG (F0 AV PULSN)
(SETQ F0 (PVECTOR.F0 PVECTOR))
(* Get voicing amplitude. *)
(SETQ AV
(PARCOE.GET.AMP
(+$ (PVECTOR.AV PVECTOR) (PVECTOR.GAIN PVECTOR) DBSCA.AV)))
(COND ((OR (=$ F0 0.0)
(AND (=$ (PVECTOR.AV PVECTOR) 0.0)
(=$ (PVECTOR.ASV PVECTOR) 0.0)))
(* No pulse issued. *)
(SETQ PULSN 1))
(T (* Waveform more sinusoidal at high fundamental
frequency. *)
(PARCOE.SET.RES
(COEFF.RESGP COEFF)
(PVECTOR.FGP PVECTOR)
(/$ (x$ 100.0 (PVECTOR.BGP PVECTOR)) F0))
(PARCOE.SET.RES
(COEFF.RESGS COEFF)
0.0
(PVECTOR.BGS PVECTOR))
(PARCOE.SET.ANTIRES
(COEFF.RESGZ COEFF)
(PVECTOR.FGZ PVECTOR)
(PVECTOR.BGZ PVECTOR))
(* Set gain to constant in mid-frequency region for
RESGP. *)
(SETF (RES.A (COEFF.RESGP COEFF)) 0.007)
(* Make AMP of AV increase with increasing
F0. *)
(SETQ AV (x$ AV F0))
(* Number of samples before a new glottal pulse may be
generated. *)
(SETQ PULSN (/$ SR F0))))
(SETF (COEFF.AV COEFF) AV)
(SETF (COEFF.PULSN COEFF) PULSN)
))
(DEFEXPR (PARCOE.VOICING PVECTOR COEFF)
(* Get amplitude of quasi-sinusoidal voicing source. *)
(PROG ()
(SETF (COEFF.ASV COEFF)
(x$ 10.0 (PARCOE.GET.AMP
(+$ (PVECTOR.ASV PVECTOR)
(PVECTOR.GAIN PVECTOR)
DBSCA.ASV))))
))
(DEFEXPR (PARCOE.ASPIRATION PVECTOR COEFF)
(* Get aspiration amplitude. *)
(PROG ()
(SETF (COEFF.AASPIR COEFF)
(PARCOE.GET.AMP
(+$ (PVECTOR.AASPIR PVECTOR)
(PVECTOR.GAIN PVECTOR)
DBSCA.AASPIR)))
))
(DEFEXPR (PARCOE.FRICATION PVECTOR COEFF)
(* Get frication amplitude. *)
(PROG (AFRIC AFRIC1 GAIN PLSTEP)
(* AFRIC1 = frication amplitude from previous PARCOE *)
(SETQ AFRIC (PVECTOR.AFRIC PVECTOR))
(SETQ AFRIC1 (COEFF.AFRIC1 COEFF))
(SETQ GAIN (PVECTOR.GAIN PVECTOR))
(SETF (COEFF.AFRIC COEFF)
(PARCOE.GET.AMP (+$ GAIN AFRIC DBSCA.AFRIC)))
(SETF (COEFF.AFRIC1 COEFF) AFRIC)
(* Add a step to waveform at a plosive relase. *)
(COND ((<$ (-$ AFRIC AFRIC1) 49)
(SETQ PLSTEP 0.0))
(T (SETQ PLSTEP (PARCOE.GET.AMP (+$ GAIN DBSCA.AFRIC 44)))))
(SETF (COEFF.PLSTEP COEFF) PLSTEP)
))
(DEFEXPR (PARCOE.BYPASS PVECTOR COEFF)
(* Bypass Amplitude *)
(PROG ()
(SETF (COEFF.AB COEFF)
(PARCOE.GET.AMP (+$ (PVECTOR.AB PVECTOR) DBSCA.AB)))
))
(DEFEXPR (PARCOE.FORMANTS PVECTOR COEFF)
(* Set up resonators for formants F1-F6. *)
(PROG ()
(PARCOE.SET.RES
(COEFF.RES1 COEFF)
(PVECTOR.F1 PVECTOR)
(PVECTOR.B1 PVECTOR))
(PARCOE.SET.RES
(COEFF.RES2 COEFF)
(PVECTOR.F2 PVECTOR)
(PVECTOR.B2 PVECTOR))
(PARCOE.SET.RES
(COEFF.RES3 COEFF)
(PVECTOR.F3 PVECTOR)
(PVECTOR.B3 PVECTOR))
(PARCOE.SET.RES
(COEFF.RES4 COEFF)
(PVECTOR.F4 PVECTOR)
(PVECTOR.B4 PVECTOR))
(PARCOE.SET.RES
(COEFF.RES5 COEFF)
(PVECTOR.F5 PVECTOR)
(PVECTOR.B5 PVECTOR))
(PARCOE.SET.RES
(COEFF.RES6 COEFF)
(PVECTOR.F6 PVECTOR)
(PVECTOR.B6 PVECTOR))
))
(DEFEXPR (PARCOE.NASAL PVECTOR COEFF)
(* Nasal resonator and antiresonator. *)
(PROG ()
(PARCOE.SET.RES
(COEFF.RESNP COEFF)
(PVECTOR.FNP PVECTOR)
(PVECTOR.BNP PVECTOR))
(PARCOE.SET.ANTIRES
(COEFF.RESNZ COEFF)
(PVECTOR.FNZ PVECTOR)
(PVECTOR.BNZ PVECTOR))
(SETF (COEFF.ANP COEFF)
(PARCOE.GET.AMP (+$ (PVECTOR.ANP PVECTOR) DBSCA.ANP)))
))
(* ****************************************************************
*
* SET.RES
*
****************************************************************)
(DEFEXPR (PARCOE.GET.AMP DB)
(* Convert DB attenuation to linear scale factor *)
(EXPT 2.0 (/$ DB 6.0)))
(DEFEXPR (LOG10 X)
(/$ (LOG X) (CONSTANT (LOG 10.0))))
(DEFEXPR (RANGECHECK VALUE MIN MAX)
(* Coerce VALUE to lie in interval (MIN,MAX) *)
(COND ((<$ VALUE MIN) MIN)
((>$ VALUE MAX) MAX)
(T VALUE)))
(DEFEXPR (PARCOE.SET.RES RES FREQUENCY BANDWIDTH)
(* Set up RES coefficients. *)
(PROG (A B C R)
(* Calc difference equation coefficients A, B, C. *)
(SETQ R (ANTILOG (0-$ (x$ PIT BANDWIDTH))))
(SETQ C (0-$ (x$ R R)))
(SETQ B (x$ 2.0 R (COS (x$ TWOPIT FREQUENCY) T)))
(SETQ A (+$ 1.0 (0-$ B) (0-$ C)))
(* Update RES. *)
(SETF (RES.A RES) A)
(SETF (RES.B RES) B)
(SETF (RES.C RES) C)
(RETURN RES)
))
(DEFEXPR (PARCOE.SET.ANTIRES ANTIRES FREQUENCY BANDWIDTH)
(* Set up ANTIRES coefficients. *)
(PROG (A B C R)
(* Calc difference equation coefficients A, B, C. *)
(SETQ R (ANTILOG (0-$ (x$ PIT BANDWIDTH))))
(SETQ C (0-$ (x$ R R)))
(SETQ B (x$ 2.0 R (COS (0-$ (x$ TWOPIT FREQUENCY)) T)))
(SETQ A (+$ 1.0 (0-$ B) (0-$ C)))
(SETQ A (/$ 1.0 A))
(SETQ B (0-$ (x$ A B)))
(SETQ C (0-$ (x$ A C)))
(* Update ANTIRES. *)
(SETF (RES.A ANTIRES) A)
(SETF (RES.B ANTIRES) B)
(SETF (RES.C ANTIRES) C)
(RETURN ANTIRES)
))
(* ****************************************************************
*STOP
****************************************************************)
STOP