(FILECREATED " 2-Jul-84 17:25:00" {ERIS}<SPEECH>ANALYZE.FPKG;2 8942
changes to: (FNS FOOBAR.INIT FOOBAR.TEST FOOBAR.STEP SPEECH.UPDATE.RES ANALYZE ANALYZE.S
ANALYZE.C ANALYZE.A ANALYZE.PHI SPEECH.BIN SPEECH.BOUT SYNTH SUBTRACT
ANALYZE.RUN))
(PRETTYCOMPRINT ANALYZECOMS)
(RPAQQ ANALYZECOMS ((CONSTANTS (PI 3.141592))
(INITVARS (F0 NIL)
(PERIOD NIL)
(RES1 NIL)
(RES2 NIL)
(RES3 NIL)
(REG1 NIL)
(REG2 NIL)
(REG3 NIL)
(AMP 1.0)
(AV 128)
(FOOBAR.TRACE 'OUTPUT3)
(ANALYZE.S NIL)
(ANALYZE.C NIL)
(ANALYZE.A NIL)
(ANALYZE.PHI NIL)
(ANZLYZE.FREQ NIL))
(RECORDS REG RES)
(FNS FOOBAR.INIT FOOBAR.TEST FOOBAR.STEP SPEECH.UPDATE.RES ANALYZE ANALYZE.S
ANALYZE.C ANALYZE.A ANALYZE.PHI SPEECH.BIN SPEECH.BOUT SYNTH SUBTRACT
ANALYZE.RUN)))
(DECLARE: EVAL@COMPILE
(RPAQQ PI 3.141592)
(CONSTANTS (PI 3.141592))
)
(RPAQ? F0 NIL)
(RPAQ? PERIOD NIL)
(RPAQ? RES1 NIL)
(RPAQ? RES2 NIL)
(RPAQ? RES3 NIL)
(RPAQ? REG1 NIL)
(RPAQ? REG2 NIL)
(RPAQ? REG3 NIL)
(RPAQ? AMP 1.0)
(RPAQ? AV 128)
(RPAQ? FOOBAR.TRACE 'OUTPUT3)
(RPAQ? ANALYZE.S NIL)
(RPAQ? ANALYZE.C NIL)
(RPAQ? ANALYZE.A NIL)
(RPAQ? ANALYZE.PHI NIL)
(RPAQ? ANZLYZE.FREQ NIL)
[DECLARE: EVAL@COMPILE
(RECORD REG (T1 T2))
(RECORD RES (A B C)
(ACCESSFNS ((BANDWIDTH (FMINUS (FQUOTIENT (LOG (FDIFFERENCE (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)))))
]
(DEFINEQ
(FOOBAR.INIT
(LAMBDA NIL (* kbr: " 2-Jul-84 17:24")
(PROG NIL
(SETQ F0 125)
(SETQ PERIOD (IQUOTIENT 10000 F0))
(SETQ RES1 (CREATE RES))
(SETQ RES2 (CREATE RES))
(SETQ RES3 (CREATE RES))
(SPEECH.SET.RES RES1 625 80)
(SPEECH.SET.RES RES2 1275 70)
(SPEECH.SET.RES RES3 2500 70)
(SETQ REG1 (CREATE REG))
(SETQ REG2 (CREATE REG))
(SETQ REG3 (CREATE REG))
(SPEECH.INIT.REG REG1)
(SPEECH.INIT.REG REG2)
(SPEECH.INIT.REG REG3))))
(FOOBAR.TEST
(LAMBDA NIL (* kbr: " 2-Jul-84 17:24")
(PROG (FILE STREAM HINPUT LINPUT)
(SETQ REG1 (CREATE REG))
(SETQ REG2 (CREATE REG))
(SETQ REG3 (CREATE REG))
(SPEECH.INIT.REG REG1)
(SPEECH.INIT.REG REG2)
(SPEECH.INIT.REG REG3)
(SETQ FILE '{CORE}FOOBAR)
(COND
((FULLNAME FILE)
(CLOSEF? FILE)
(DELFILE FILE)))
(SETQ STREAM (OPENSTREAM FILE 'OUTPUT))
(SETQ LINPUT (IMINUS (IQUOTIENT AV PERIOD)))
(SETQ HINPUT (IQUOTIENT (ITIMES AV (SUB1 PERIOD))
PERIOD))
(FOR I FROM 0 TO (ITIMES 6 PERIOD)
DO (COND
((EVENP I PERIOD)
(SETQ INPUT HINPUT))
(T (SETQ INPUT LINPUT)))
(FOOBAR.STEP STREAM INPUT))
(RETURN (CLOSEF STREAM)))))
(FOOBAR.STEP
(LAMBDA (STREAM INPUT) (* kbr: " 2-Jul-84 17:24")
(PROG (OUTPUT1 OUTPUT2 OUTPUT3 OUTPUT)
(SETQ OUTPUT1 (SPEECH.UPDATE.RES INPUT RES1 REG1))
(SETQ OUTPUT2 (SPEECH.UPDATE.RES OUTPUT1 RES2 REG2))
(SETQ OUTPUT3 (SPEECH.UPDATE.RES OUTPUT2 RES3 REG3))
(SETQ OUTPUT (SELECTQ FOOBAR.TRACE
(INPUT INPUT)
(OUTPUT1 OUTPUT1)
(OUTPUT2 OUTPUT2)
(OUTPUT3 OUTPUT3)
(SHOULDNT)))
(SETQ OUTPUT (SPEECH.RANGE.CHECK (IPLUS 128 (FIXR (FTIMES AMP OUTPUT)))
0 255))
(\BOUT STREAM OUTPUT))))
(SPEECH.UPDATE.RES
(LAMBDA (INPUT RES REG) (* kbr: " 2-Jul-84 17:24")
(* Update memory REG. *)
(PROG (T1 T2 A B C UPDATE)
(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 UPDATE (FPLUS (FTIMES A INPUT)
(FTIMES B T1)
(FTIMES C T2)))
(replace (REG T2) of REG with T1)
(replace (REG T1) of REG with UPDATE)
(RETURN UPDATE))))
(ANALYZE
(LAMBDA (FILE PERIOD N) (* kbr: " 2-Jul-84 17:24")
(PROG (A PHI FREQ)
(SETQ ANALYZE.S (ANALYZE.S FILE PERIOD N))
(SETQ ANALYZE.C (ANALYZE.C FILE PERIOD N))
(SETQ ANALYZE.A (ANALYZE.A ANALYZE.S ANALYZE.C))
(SETQ ANALYZE.PHI (ANALYZE.PHI ANALYZE.S ANALYZE.C))
(SETQ ANALYZE.FREQ (FQUOTIENT (FTIMES 2.0 PI N)
PERIOD))
(RETURN (LIST ANALYZE.A ANALYZE.FREQ ANALYZE.PHI)))))
(ANALYZE.S
(LAMBDA (FILE PERIOD N) (* kbr: " 2-Jul-84 17:24")
(PROG (STREAM SUM L FREQ ANSWER)
(SETQ STREAM (OPENSTREAM FILE 'INPUT))
(SETQ SUM 0.0)
(SETQ L (FIXR (ITIMES 8 PERIOD)))
(SETQ FREQ (FQUOTIENT (FTIMES 2.0 PI N)
PERIOD))
(FOR I FROM 1 TO L DO (SETQ SUM (FPLUS SUM (FTIMES (FQUOTIENT (SPEECH.BIN STREAM)
128.0)
(SIN (FTIMES FREQ I)
T)))))
(CLOSEF STREAM)
(SETQ ANSWER (FQUOTIENT SUM (FLOAT L)))
(RETURN ANSWER))))
(ANALYZE.C
(LAMBDA (FILE PERIOD N) (* kbr: " 2-Jul-84 17:24")
(PROG (STREAM SUM L FREQ ANSWER)
(SETQ STREAM (OPENSTREAM FILE 'INPUT))
(SETQ SUM 0.0)
(SETQ L (FIXR (ITIMES 8 PERIOD)))
(SETQ FREQ (FQUOTIENT (FTIMES 2.0 PI N)
PERIOD))
(FOR I FROM 1 TO L DO (SETQ SUM (FPLUS SUM (FTIMES (FQUOTIENT (SPEECH.BIN STREAM)
128.0)
(COS (FTIMES FREQ I)
T)))))
(CLOSEF STREAM)
(SETQ ANSWER (FQUOTIENT SUM (FLOAT L)))
(RETURN ANSWER))))
(ANALYZE.A
(LAMBDA (S C) (* kbr: " 2-Jul-84 17:24")
(FTIMES 2.0 (SQRT (FTIMES S S)
(FTIMES C C)))))
(ANALYZE.PHI
(LAMBDA (S C) (* kbr: " 2-Jul-84 17:24")
(ARCTAN2 C S T)))
(SPEECH.BIN
(LAMBDA (STREAM) (* kbr: " 2-Jul-84 17:24")
(PROG (CODE)
(SETQ CODE (\BIN STREAM))
(COND
((ILESSP CODE 128)
(SETQ CODE (IPLUS CODE 128)))
(T (SETQ CODE (IDIFFERENCE 256 CODE))))
(RETURN CODE))))
(SPEECH.BOUT
(LAMBDA (STREAM CODE) (* kbr: " 2-Jul-84 17:24")
(PROG NIL
(COND
((ILESSP CODE 128)
(SETQ CODE (IDIFFERENCE 256 CODE)))
(T (SETQ CODE (IDIFFERENCE CODE 128))))
(\BOUT STREAM CODE))))
(SYNTH
(LAMBDA (COEFFS FILE) (* kbr: " 2-Jul-84 17:24")
(PROG (STREAM PHI FREQ A SUM)
(SETQ STREAM (OPENSTREAM FILE 'OUTPUT))
(FOR I FROM 1 TO 1000
DO (SETQ SUM 0.0)
(FOR BUCKET IN COEFFS
DO (SETQ A (CAR BUCKET))
(SETQ FREQ (CADR BUCKET))
(SETQ PHI (CADDR BUCKET))
(SETQ SUM (FPLUS SUM (FTIMES A (SIN (FPLUS (FTIMES FREQ I)
PHI)
T)))))
(SPEECH.BOUT STREAM (IPLUS 128 (FIXR (FTIMES 128.0 SUM)))))
(RETURN (CLOSEF STREAM)))))
(SUBTRACT
(LAMBDA (FILE1 FILE2 FILE3) (* kbr: " 2-Jul-84 17:24")
(PROG (STREAM1 STREAM2 STREAM3)
(SETQ STREAM1 (OPENSTREAM FILE1 'INPUT))
(SETQ STREAM2 (OPENSTREAM FILE2 'INPUT))
(SETQ STREAM3 (OPENSTREAM FILE3 'OUTPUT))
(FOR I FROM 1 TO 1000 DO (SPEECH.BOUT STREAM3 (IPLUS 128 (IDIFFERENCE (SPEECH.BIN STREAM1)
(SPEECH.BIN STREAM2)))
))
(CLOSEF STREAM1)
(CLOSEF STREAM2)
(RETURN (CLOSEF STREAM3)))))
(ANALYZE.RUN
(LAMBDA (FILE PERIOD) (* kbr: " 2-Jul-84 17:24")
(PROG (COEFFS)
(FOR N FROM 1
DO (SETQ COEFFS (APPEND COEFFS (LIST (ANALYZE FILE PERIOD N))))
(SYNTH COEFFS '{CORE}SYNTH.WAVE)
(SDF '{CORE}SYNTH.WAVE)
(SUBTRACT FILE '{CORE}SYNTH.WAVE '{CORE}SUBTRACT.WAVE)
(SDF '{CORE}SUBTRACT.WAVE)
(SETQ FILE '{CORE}SUBTRACT.WAVE)))))
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1798 8920 (FOOBAR.INIT 1808 . 2454) (FOOBAR.TEST 2456 . 3344) (FOOBAR.STEP 3346 . 3975)
(SPEECH.UPDATE.RES 3977 . 4706) (ANALYZE 4708 . 5215) (ANALYZE.S 5217 . 5824) (ANALYZE.C 5826 . 6433)
(ANALYZE.A 6435 . 6601) (ANALYZE.PHI 6603 . 6733) (SPEECH.BIN 6735 . 7044) (SPEECH.BOUT 7046 . 7329)
(SYNTH 7331 . 7924) (SUBTRACT 7926 . 8485) (ANALYZE.RUN 8487 . 8918)))))
STOP