(* ;;-*-LISP-*- KEEP EMACS HAPPY ********************************
*
*     FOO BAR
*
****************************************************************)

(RECORD REG (T1 T2))

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

(DEFVAR F0)
(DEFVAR PERIOD)
(DEFVAR RES1)
(DEFVAR RES2)
(DEFVAR RES3)
(DEFVAR REG1)
(DEFVAR REG2)
(DEFVAR REG3)
(DEFVAR AMP 1.0)
(DEFVAR AV 128)
(DEFEXPR (FOOBAR.INIT)
  (PROG ()
    (SETQ F0 125)
    (SETQ PERIOD (/ 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)
))

(DEFEXPR (FOOBAR.TEST)
  (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 (0- (/ AV PERIOD)))
    (SETQ HINPUT (/ (x AV (1- PERIOD)) PERIOD))
    (FOR I FROM 0 TO (x 6 PERIOD)
     DO (COND ((EVENP I PERIOD)
	       (SETQ INPUT HINPUT))
	      (T (SETQ INPUT LINPUT)))
     (FOOBAR.STEP STREAM INPUT))
    (RETURN (CLOSEF STREAM))
))

(DEFVAR FOOBAR.TRACE 'OUTPUT3)
(DEFEXPR (FOOBAR.STEP STREAM INPUT)
  (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 (+ 128 (FIXR (x$ AMP OUTPUT))) 0 255))
    (\BOUT STREAM OUTPUT)
))

(DEFEXPR (SPEECH.UPDATE.RES INPUT RES REG)
  (* Update memory REG. *)
  (PROG (T1 T2 A B C UPDATE)
    (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 UPDATE (+$ (x$ A INPUT) (x$ B T1) (x$ C T2)))
    (SETF (REG.T2 REG) T1)
    (SETF (REG.T1 REG) UPDATE)
    (RETURN UPDATE)
))

(DEFCONST PI 3.141592)
(DEFVAR ANALYZE.S)
(DEFVAR ANALYZE.C)
(DEFVAR ANALYZE.A)
(DEFVAR ANALYZE.PHI)
(DEFVAR ANZLYZE.FREQ)
(DEFEXPR (ANALYZE FILE PERIOD N)
  (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 (/$ (x$ 2.0 PI N) PERIOD))
    (RETURN (LIST ANALYZE.A ANALYZE.FREQ ANALYZE.PHI))
))

(DEFEXPR (ANALYZE.S FILE PERIOD N)
  (PROG (STREAM SUM L FREQ ANSWER)
    (SETQ STREAM (OPENSTREAM FILE 'INPUT))
    (SETQ SUM 0.0)
    (SETQ L (FIXR (x 8 PERIOD)))
    (SETQ FREQ (/$ (x$ 2.0 PI N) PERIOD))
    (FOR I FROM 1 TO L
     DO (SETQ SUM
	      (+$ SUM
		  (x$ (/$ (SPEECH.BIN STREAM) 128.0)
		      (SIN (x$ FREQ I) T)))))
    (CLOSEF STREAM)
    (SETQ ANSWER (/$ SUM (FLOAT L)))
    (RETURN ANSWER)
))

(DEFEXPR (ANALYZE.C FILE PERIOD N)
  (PROG (STREAM SUM L FREQ ANSWER)
    (SETQ STREAM (OPENSTREAM FILE 'INPUT))
    (SETQ SUM 0.0)
    (SETQ L (FIXR (x 8 PERIOD)))
    (SETQ FREQ (/$ (x$ 2.0 PI N) PERIOD))
    (FOR I FROM 1 TO L
     DO (SETQ SUM
	      (+$ SUM
		  (x$ (/$ (SPEECH.BIN STREAM) 128.0)
		      (COS (x$ FREQ I) T)))))
    (CLOSEF STREAM)
    (SETQ ANSWER (/$ SUM (FLOAT L)))
    (RETURN ANSWER)
))

(DEFEXPR (ANALYZE.A S C)
  (x$ 2.0 (SQRT (x$ S S) (x$ C C))))

(DEFEXPR (ANALYZE.PHI S C)
  (ARCTAN2 C S T))

(DEFEXPR (SPEECH.BIN STREAM)
  (PROG (CODE)
    (SETQ CODE (\BIN STREAM))
    (COND ((< CODE 128)
	   (SETQ CODE (+ CODE 128)))
	  (T (SETQ CODE (- 256 CODE))))
    (RETURN CODE)
))

(DEFEXPR (SPEECH.BOUT STREAM CODE)
  (PROG ()
    (COND ((< CODE 128)
	   (SETQ CODE (- 256 CODE)))
	  (T (SETQ CODE (- CODE 128))))
    (\BOUT STREAM CODE)
))

(DEFEXPR (SYNTH COEFFS FILE)
  (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 (+$ SUM (x$ A (SIN (+$ (x$ FREQ I) PHI) T)))))
     (SPEECH.BOUT STREAM (+ 128 (FIXR (x$ 128.0 SUM)))))
    (RETURN (CLOSEF STREAM))
))

(DEFEXPR (SUBTRACT FILE1 FILE2 FILE3)
  (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
	 (+ 128 (- (SPEECH.BIN STREAM1)
		   (SPEECH.BIN STREAM2)))))
    (CLOSEF STREAM1)
    (CLOSEF STREAM2)
    (RETURN (CLOSEF STREAM3))
))

(DEFEXPR (ANALYZE.RUN FILE PERIOD)
  (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))
))

STOP