(FILECREATED " 2-Jul-84 17:51:13" {ERIS}<SPEECH>PARCOE.FPKG;3 20092
previous date: "27-Jun-84 17:58:20" {ERIS}<SPEECH>PARCOE.FPKG;2)
(* Copyright (c) 1984 by I. All rights reserved.)
(PRETTYCOMPRINT PARCOECOMS)
(RPAQQ PARCOECOMS ((INITVARS (PI 3.141593)
(SR 10000)
(NWS 50)
(NSAMI .02)
(PERIODT .0001)
(PIT .0003141593)
(TWOPIT .0006283186)
(PLCONSTANT .995)
(NTIMPR -1)
(NPPBEG 1)
(NPPEND 39)
(DBSCA.A1 -58.0)
(DBSCA.A2 -65.0)
(DBSCA.A3 -73.0)
(DBSCA.A4 -78.0)
(DBSCA.A5 -79.0)
(DBSCA.A6 -80.0)
(DBSCA.ANP -58.0)
(DBSCA.AB -84.0)
(DBSCA.AV -72.0)
(DBSCA.AASPIR -102.0)
(DBSCA.AFRIC -72.0)
(DBSCA.ASV -44.0))
(RECORDS PVECTOR COEFF RES CORRECTIONS)
(FNS SPEECH.SR SPEECH.CREATE.PVECTOR SPEECH.CREATE.COEFF SPEECH.INIT.COEFF SPEECH.INIT.RES
SPEECH.PVECTOR.TO.COEFF SPEECH.PTC.CORRECTIONS SPEECH.PTC.ASPIRATION
SPEECH.PTC.FRICATION SPEECH.PTC.FORMANTS SPEECH.PTC.NASAL SPEECH.PTC.GLOTTAL
SPEECH.PTC.VOICING SPEECH.DBCOR SPEECH.GET.AMP SPEECH.RANGE.CHECK LOG10 SPEECH.SET.RES)))
(RPAQ? PI 3.141593)
(RPAQ? SR 10000)
(RPAQ? NWS 50)
(RPAQ? NSAMI .02)
(RPAQ? PERIODT .0001)
(RPAQ? PIT .0003141593)
(RPAQ? TWOPIT .0006283186)
(RPAQ? PLCONSTANT .995)
(RPAQ? NTIMPR -1)
(RPAQ? NPPBEG 1)
(RPAQ? NPPEND 39)
(RPAQ? DBSCA.A1 -58.0)
(RPAQ? DBSCA.A2 -65.0)
(RPAQ? DBSCA.A3 -73.0)
(RPAQ? DBSCA.A4 -78.0)
(RPAQ? DBSCA.A5 -79.0)
(RPAQ? DBSCA.A6 -80.0)
(RPAQ? DBSCA.ANP -58.0)
(RPAQ? DBSCA.AB -84.0)
(RPAQ? DBSCA.AV -72.0)
(RPAQ? DBSCA.AASPIR -102.0)
(RPAQ? DBSCA.AFRIC -72.0)
(RPAQ? DBSCA.ASV -44.0)
[DECLARE: EVAL@COMPILE
(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))
(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))
(RECORD RES (A B C)
[ACCESSFNS ((BANDWIDTH (0-$ (/$ (LOG (-$ (RES.C DATUM)))
TWOPIT)))
(FREQUENCY (/$ (ARCCOS [/$ (RES.B DATUM)
(x$ 2.0 (SQRT (0-$ (RES.C DATUM]
T)
TWOPIT])
(RECORD CORRECTIONS (A2COR A3COR N12COR N23COR N34COR))
]
(/DECLAREDATATYPE 'PVECTOR
'(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 POINTER))
(/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
POINTER POINTER))
(DEFINEQ
(SPEECH.SR
[LAMBDA (SAMPLERATE) (* kbr: "16-May-84 14:02")
(COND
((NULL SAMPLERATE)
(SETQ SAMPLERATE 10000)))
(PROG NIL
(SETQ SR SAMPLERATE)
(SETQ NWS (IQUOTIENT SR 200))
(SETQ NSAMI (FQUOTIENT 1.0 NWS))
(SETQ PERIODT (FQUOTIENT 1.0 SR))
(SETQ PIT (FTIMES PI PERIODT))
(SETQ TWOPIT (FTIMES 2.0 PIT))
(SETQ PLCONSTANT (ANTILOG (FTIMES -50.13705 PERIODT])
(SPEECH.CREATE.PVECTOR
[LAMBDA NIL (* kbr: "16-May-84 14:02")
(COPYALL USER.DEFAULT.PVECTOR])
(SPEECH.CREATE.COEFF
[LAMBDA NIL (* kbr: "16-May-84 14:02")
(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])
(SPEECH.INIT.COEFF
[LAMBDA (PVECTOR COEFF) (* kbr: "16-May-84 14:02")
(* 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)
(SPEECH.INIT.RES (fetch (COEFF RESGP) of COEFF))
(SPEECH.INIT.RES (fetch (COEFF RESGZ) of COEFF))
(SPEECH.INIT.RES (fetch (COEFF RESGS) of COEFF))
(SPEECH.INIT.RES (fetch (COEFF RES1) of COEFF))
(SPEECH.INIT.RES (fetch (COEFF RES2) of COEFF))
(SPEECH.INIT.RES (fetch (COEFF RES3) of COEFF))
(SPEECH.INIT.RES (fetch (COEFF RES4) of COEFF))
(SPEECH.INIT.RES (fetch (COEFF RES5) of COEFF))
(SPEECH.INIT.RES (fetch (COEFF RES6) of COEFF))
(SPEECH.INIT.RES (fetch (COEFF RESNP) of COEFF))
(SPEECH.INIT.RES (fetch (COEFF RESNZ) of COEFF))
(replace (COEFF PLSTEP) of COEFF with 0.0)
(replace (COEFF PULSN) of COEFF with 0.0)
(replace (COEFF SWITCH) of COEFF with (fetch (PVECTOR SWITCH) of PVECTOR))
(replace (COEFF NCF) of COEFF with (fetch (PVECTOR NCF) of PVECTOR))
(* Extra junk *)
(replace (COEFF NTIMEP) of COEFF with 0.0)
(replace (COEFF NTIMED) of COEFF with (FQUOTIENT (FTIMES NWS 1000.0)
SR])
(SPEECH.INIT.RES
[LAMBDA (RES) (* kbr: "16-May-84 14:02")
(PROG NIL
(replace (RES A) of RES with 0.0)
(replace (RES B) of RES with 0.0)
(replace (RES C) of RES with 0.0])
(SPEECH.PVECTOR.TO.COEFF
[LAMBDA (PVECTOR COEFF) (* kbr: "16-May-84 14:02")
(* Calculate synthesizer COEFFicients from PVECTOReters.
*)
(PROG (CORRECTIONS)
(replace (COEFF AB) of COEFF with (SPEECH.GET.AMP (FPLUS (fetch (PVECTOR AB) of PVECTOR)
DBSCA.AB)))
(SPEECH.PTC.ASPIRATION PVECTOR COEFF)
(SPEECH.PTC.FRICATION PVECTOR COEFF)
(SETQ CORRECTIONS (SPEECH.PTC.CORRECTIONS PVECTOR))
(SPEECH.PTC.FORMANTS PVECTOR COEFF CORRECTIONS)
(SPEECH.PTC.GLOTTAL PVECTOR COEFF)
(SPEECH.PTC.NASAL PVECTOR COEFF)
(SPEECH.PTC.VOICING PVECTOR COEFF])
(SPEECH.PTC.CORRECTIONS
[LAMBDA (PVECTOR) (* kbr: "16-May-84 14:02")
(PROG (F1 F2 F3 F4 A2COR DELF2 A3COR N12COR N23COR N34COR F21 F32 F43 CORRECTIONS)
(SETQ F1 (fetch (PVECTOR F1) of PVECTOR))
(SETQ F2 (fetch (PVECTOR F2) of PVECTOR))
(SETQ F3 (fetch (PVECTOR F3) of PVECTOR))
(SETQ F4 (fetch (PVECTOR F4) of PVECTOR)) (* Compute amplitude corrections.
*)
(SETQ A2COR (EXPT (FQUOTIENT (FLOAT F1)
500.0)
2.0))
(SETQ DELF2 (FQUOTIENT (FLOAT F2)
1500.0))
(SETQ A3COR (FTIMES A2COR (FTIMES DELF2 DELF2)))
(SETQ A2COR (FQUOTIENT 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 (FDIFFERENCE F2 F1))
[COND
((FLESSP F21 50.0)
(GO EXIT))
((FLESSP F21 550.0)
(SETQ N12COR (SPEECH.DBCOR F21]
(SETQ F32 (FPLUS F3 (FMINUS F2)
-50.0))
[COND
((FLESSP F32 50.0)
(GO EXIT))
((FLESSP F32 550.0)
(SETQ N23COR (SPEECH.DBCOR F32]
(SETQ F43 (FPLUS F4 (FMINUS F3)
-50.0))
[COND
((FLESSP F43 50.0)
(GO EXIT))
((FLESSP F43 550.0)
(SETQ N34COR (SPEECH.DBCOR F43]
EXIT(SETQ CORRECTIONS
(create CORRECTIONS
A2COR ← A2COR
A3COR ← A3COR
N12COR ← N12COR
N23COR ← N23COR
N34COR ← N34COR))
(RETURN CORRECTIONS])
(SPEECH.PTC.ASPIRATION
[LAMBDA (PVECTOR COEFF) (* kbr: "16-May-84 14:02")
(* Get aspiration amplitude. *)
(PROG NIL
(replace (COEFF AASPIR) of COEFF with (SPEECH.GET.AMP (FPLUS (fetch (PVECTOR GAIN)
of PVECTOR)
(fetch (PVECTOR AV)
of PVECTOR)
DBSCA.AASPIR])
(SPEECH.PTC.FRICATION
[LAMBDA (PVECTOR COEFF) (* kbr: "16-May-84 14:02")
(* Get frication amplitude. *)
(PROG (AASPIR AFRIC GAIN SWITCH PLSTEP)
(SETQ AASPIR (fetch (PVECTOR AASPIR) of PVECTOR))
(SETQ AFRIC (fetch (PVECTOR AFRIC) of PVECTOR))
(SETQ GAIN (fetch (PVECTOR GAIN) of PVECTOR))
(SETQ SWITCH (fetch (PVECTOR SWITCH) of PVECTOR))
(COND
((AND (FGREATERP AASPIR AFRIC)
(EQ SWITCH 'PARALLEL))
(SETQ AFRIC AASPIR))) (* Add a step to waveform at a plosive relase.
*)
[COND
((FLESSP (FDIFFERENCE AFRIC (fetch (COEFF AFRIC1) of COEFF))
49)
(SETQ PLSTEP 0.0))
(T (SETQ PLSTEP (SPEECH.GET.AMP (FPLUS GAIN DBSCA.AFRIC 44]
(replace (COEFF AFRIC) of COEFF with (SPEECH.GET.AMP (FPLUS GAIN AFRIC DBSCA.AFRIC)))
(replace (COEFF AFRIC1) of COEFF with AFRIC)
(replace (COEFF PLSTEP) of COEFF with PLSTEP])
(SPEECH.PTC.FORMANTS
[LAMBDA (PVECTOR COEFF CORRECTIONS) (* kbr: "16-May-84 14:02")
(* Set up resonators for formants F1-F6.
*)
(PROG (A2COR A3COR N12COR N23COR N34COR) (* Unpack CORRECTIONS. *)
(SETQ A2COR (fetch (CORRECTIONS A2COR) of CORRECTIONS))
(SETQ A3COR (fetch (CORRECTIONS A3COR) of CORRECTIONS))
(SETQ N12COR (fetch (CORRECTIONS N12COR) of CORRECTIONS))
(SETQ N23COR (fetch (CORRECTIONS N23COR) of CORRECTIONS))
(SETQ N34COR (fetch (CORRECTIONS N34COR) of CORRECTIONS))
(* Set up resonators. *)
(SPEECH.SET.RES (fetch (COEFF RES1) of COEFF)
(fetch (PVECTOR F1) of PVECTOR)
(fetch (PVECTOR B1) of PVECTOR))
(SPEECH.SET.RES (fetch (COEFF RES2) of COEFF)
(fetch (PVECTOR F2) of PVECTOR)
(fetch (PVECTOR B2) of PVECTOR))
(SPEECH.SET.RES (fetch (COEFF RES3) of COEFF)
(fetch (PVECTOR F3) of PVECTOR)
(fetch (PVECTOR B3) of PVECTOR))
(SPEECH.SET.RES (fetch (COEFF RES4) of COEFF)
(fetch (PVECTOR F4) of PVECTOR)
(fetch (PVECTOR B4) of PVECTOR))
(SPEECH.SET.RES (fetch (COEFF RES5) of COEFF)
(fetch (PVECTOR F5) of PVECTOR)
(fetch (PVECTOR B5) of PVECTOR))
(SPEECH.SET.RES (fetch (COEFF RES6) of COEFF)
(fetch (PVECTOR F6) of PVECTOR)
(fetch (PVECTOR B6) of PVECTOR))
(replace (COEFF A1) of COEFF with (SPEECH.GET.AMP (FPLUS (fetch (PVECTOR A1) of PVECTOR)
N12COR DBSCA.A1)))
[replace (COEFF A2) of COEFF with (FTIMES A2COR (SPEECH.GET.AMP (FPLUS (fetch (PVECTOR
A2)
of PVECTOR)
(FTIMES 2 N12COR)
N23COR DBSCA.A2]
[replace (COEFF A3) of COEFF with (FTIMES A3COR (SPEECH.GET.AMP (FPLUS (fetch (PVECTOR
A3)
of PVECTOR)
(FTIMES 2 N23COR)
N34COR DBSCA.A3]
[replace (COEFF A4) of COEFF with (FTIMES A3COR (SPEECH.GET.AMP (FPLUS (fetch (PVECTOR
A4)
of PVECTOR)
(FTIMES 2 N34COR)
DBSCA.A4]
[replace (COEFF A5) of COEFF with (FTIMES A3COR (SPEECH.GET.AMP (FPLUS (fetch (PVECTOR
A5)
of PVECTOR)
DBSCA.A5]
(replace (COEFF A6) of COEFF with (FTIMES A3COR (SPEECH.GET.AMP (FPLUS (fetch (PVECTOR
A6)
of PVECTOR)
DBSCA.A6])
(SPEECH.PTC.NASAL
[LAMBDA (PVECTOR COEFF) (* kbr: "16-May-84 14:02")
(* Nasal resonator and antiresonator.
*)
(PROG NIL
(SPEECH.SET.RES (fetch (COEFF RESNP) of COEFF)
(fetch (PVECTOR FNP) of PVECTOR)
(fetch (PVECTOR BNP) of PVECTOR))
(SPEECH.SET.RES (fetch (COEFF RESNZ) of COEFF)
(SPEECH.RANGE.CHECK (FMINUS (fetch (PVECTOR FNZ) of PVECTOR))
MIN.FIXP -1)
(fetch (PVECTOR BNZ) of PVECTOR))
(replace (COEFF ANP) of COEFF with (SPEECH.GET.AMP (FPLUS (fetch (PVECTOR ANP)
of PVECTOR)
DBSCA.ANP])
(SPEECH.PTC.GLOTTAL
[LAMBDA (PVECTOR COEFF) (* kbr: "16-May-84 14:02")
(* Glottal resonators and antiresonator.
*)
(PROG (F0 AV PULSN)
(SETQ F0 (fetch (PVECTOR F0) of PVECTOR)) (* Get voicing amplitude. *)
(SETQ AV (SPEECH.GET.AMP (FPLUS (fetch (PVECTOR GAIN) of PVECTOR)
(fetch (PVECTOR AV) of PVECTOR)
DBSCA.AV)))
[COND
([OR (NOT (FGREATERP F0 0.0))
(AND (NOT (FGREATERP (fetch (PVECTOR AV) of PVECTOR)
0.0))
(NOT (FGREATERP (fetch (PVECTOR ASV) of PVECTOR)
0.0] (* No pulse issued. *)
(SETQ PULSN 1))
(T (* Waveform more sinusoidal at high fundamental
frequency. *)
(SPEECH.SET.RES (fetch (COEFF RESGP) of COEFF)
(fetch (PVECTOR FGP) of PVECTOR)
(FQUOTIENT (FTIMES 100.0 (fetch (PVECTOR BGP) of PVECTOR))
F0))
(SPEECH.SET.RES (fetch (COEFF RESGS) of COEFF)
0.0
(fetch (PVECTOR BGS) of PVECTOR))
(SPEECH.SET.RES (fetch (COEFF RESGZ) of COEFF)
(FMINUS (fetch (PVECTOR FGZ) of PVECTOR))
(fetch (PVECTOR BGZ) of PVECTOR))
(* Set gain to constant in mid-frequency region for
RESGP. *)
(replace (RES A) of (fetch (COEFF RESGP) of COEFF) with .007)
(* Do not let F0 drop below 40HZ.
*)
(SETQ F0 (SPEECH.RANGE.CHECK F0 40 MAX.FIXP))
(* Make AMP of AV increase with increasing F0.
*)
(SETQ AV (FTIMES AV F0)) (* Number of samples before a new glottal pulse may be
generated. *)
(SETQ PULSN (FQUOTIENT SR F0]
(replace (COEFF AV) of COEFF with AV)
(replace (COEFF PULSN) of COEFF with PULSN])
(SPEECH.PTC.VOICING
[LAMBDA (PVECTOR COEFF) (* kbr: "16-May-84 14:02")
(* Get amplitude of quasi-sinusoidal voicing source.
*)
(PROG NIL
(replace (COEFF ASV) of COEFF with (FTIMES 10.0 (SPEECH.GET.AMP (FPLUS (fetch (PVECTOR
GAIN)
of PVECTOR)
(fetch (PVECTOR
ASV)
of PVECTOR)
DBSCA.ASV])
(SPEECH.DBCOR
[LAMBDA (DB) (* kbr: "16-May-84 14:02")
(* Increment in DB to adjust formant AMPs of parallel
branch. *)
(FDIFFERENCE 11.0 (FQUOTIENT DB 50.0])
(SPEECH.GET.AMP
[LAMBDA (DB) (* pkh: "31-May-84 18:11")
(* Convert DB attenuation to linear scale factor *)
(EXPT 2.0 (FIXR (FQUOTIENT (SPEECH.RANGE.CHECK DB -72.0 96.0)
6.0])
(SPEECH.RANGE.CHECK
[LAMBDA (VALUE MIN MAX) (* kbr: "16-May-84 14:02")
(* Coerce VALUE to lie in interval
(MIN%,MAX) *)
(COND
((FLESSP VALUE MIN)
MIN)
((FGREATERP VALUE MAX)
MAX)
(T VALUE])
(LOG10
[LAMBDA (X) (* kbr: "16-May-84 14:02")
(FQUOTIENT (LOG X)
(CONSTANT (LOG 10.0])
(SPEECH.SET.RES
[LAMBDA (RES FREQUENCY BANDWIDTH) (* kbr: "16-May-84 14:02")
(* Set up RES coefficients. *)
(PROG (A B C R) (* Calc difference equation coefficients A%, B%, C.
*)
[SETQ R (ANTILOG (FMINUS (FTIMES PIT BANDWIDTH]
(SETQ C (FMINUS (FTIMES R R)))
(SETQ B (FTIMES 2.0 R (COS (FTIMES TWOPIT FREQUENCY)
T)))
(SETQ A (FPLUS 1.0 (FMINUS B)
(FMINUS C)))
[COND
((FLESSP FREQUENCY 0.0)
(SETQ A (FQUOTIENT 1.0 A))
(SETQ B (FMINUS (FTIMES A B)))
(SETQ C (FMINUS (FTIMES A C] (* Update RES. *)
(replace (RES A) of RES with A)
(replace (RES B) of RES with B)
(replace (RES C) of RES with C)
(RETURN RES])
)
(PUTPROPS PARCOE.FPKG COPYRIGHT ("I" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3293 20026 (SPEECH.SR 3303 . 3789) (SPEECH.CREATE.PVECTOR 3791 . 3945) (
SPEECH.CREATE.COEFF 3947 . 4517) (SPEECH.INIT.COEFF 4519 . 6958) (SPEECH.INIT.RES 6960 . 7255) (
SPEECH.PVECTOR.TO.COEFF 7257 . 8065) (SPEECH.PTC.CORRECTIONS 8067 . 9739) (SPEECH.PTC.ASPIRATION 9741
. 10206) (SPEECH.PTC.FRICATION 10208 . 11378) (SPEECH.PTC.FORMANTS 11380 . 14312) (SPEECH.PTC.NASAL
14314 . 15108) (SPEECH.PTC.GLOTTAL 15110 . 17415) (SPEECH.PTC.VOICING 17417 . 17951) (SPEECH.DBCOR
17953 . 18252) (SPEECH.GET.AMP 18254 . 18568) (SPEECH.RANGE.CHECK 18570 . 18910) (LOG10 18912 . 19067)
(SPEECH.SET.RES 19069 . 20024)))))
STOP