(* ;;-*-LISP-*- KEEP EMACS HAPPY ********************************
*
*     WAVE EDITOR
*
****************************************************************)

(* ****************************************************************
*
*     WAVES
*
****************************************************************)

(DEFVAR SPEECH.WAVESIZE 700)
(DEFEXPR (WEDIT.CREATEWAVE)
  (ARRAY SPEECH.WAVESIZE 'FIXP)
)

(DEFEXPR (WEDIT.GET FILENAME (OPTIONAL FROMPTR 0) (OPTIONAL TOPTR))
  (PROG (SIZE STREAM ANSWER)
    (SETQ STREAM (OPENSTREAM FILENAME 'INPUT))
    (COND ((NULL TOPTR)(SETQ TOPTR (1- (GETFILEINFO STREAM 'LENGTH)))))
    (SETQ SIZE (+ TOPTR (0- FROMPTR) 1))
    (SETQ ANSWER (ARRAY SIZE))
    (FOR I FROM 1 TO SIZE
     DO (SETF (ELT ANSWER I) (SPEECH.BIN STREAM)))
    (CLOSEF STREAM)
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.PUT WAVE FILENAME)
  (PROG (STREAM)
    (SETQ STREAM (OPENSTREAM FILENAME 'OUTPUT))
    (FOR I FROM 1 TO (ARRAYSIZE STREAM)
     DO (SPEECH.BOUT 
	 STREAM 
	 (RANGECHECK (ELT WAVE I) -128 127)))
    (RETURN (CLOSEF STREAM))
))

(DEFEXPR (WEDIT.SINEWAVE AMP PERIOD PHASE (OPTIONAL SIZE SPEECH.WAVESIZE))
  (PROG (ANSWER FREQ)
    (SETQ ANSWER (ARRAY SIZE))
    (SETQ FREQ (/$ TWOPI (FLOAT PERIOD)))
    (FOR I FROM 1 TO SIZE
     DO (SETF (ELT ANSWER I)
	      (x$ AMP (SIN (+$ (x$ FREQ I) PHASE) T))))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.DELTAWAVE AMP PERIOD (OPTIONAL SIZE))
  (WEDIT.BOXWAVE 0 (1- PERIOD) AMP 1 SIZE))

(DEFEXPR (WEDIT.BOXWAVE AMP1 PERIOD1 AMP2 PERIOD2 
			(OPTIONAL SIZE SPEECH.WAVESIZE))
  (PROG (ANSWER PERIOD AMP)
    (SETQ ANSWER (WEDIT.CREATEWAVE))
    (SETQ PERIOD (+ PERIOD1 PERIOD2))
    (FOR I FROM 1 TO SIZE
     DO (COND ((< (\ (1- I) PERIOD) PERIOD1)
	       (SETQ AMP AMP1))
	      (T (SETQ AMP AMP2)))
     (SETF (ELT ANSWER I) AMP))
    (RETURN ANSWER)
))


(* ****************************************************************
*
*     OPERATIONS ON WAVES
*
****************************************************************)

(DEFEXPR (WEDIT.PLUS WAVE1 WAVE2)
  (PROG (SIZE ANSWER)
    (SETQ SIZE (ARRAYSIZE WAVE1))
    (COND ((<> (ARRAYSIZE WAVE2) SIZE)
	   (LOSE "Different array sizes")))
    (SETQ ANSWER (ARRAY SIZE))
    (FOR I FROM 1 TO SIZE
     DO (SETF (ELT ANSWER I)
	      (+ (ELT WAVE1 I) (ELT WAVE2 I))))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.DIFFERENCE WAVE1 WAVE2)
  (PROG (SIZE ANSWER)
    (SETQ SIZE (ARRAYSIZE WAVE1))
    (COND ((<> (ARRAYSIZE WAVE2) SIZE)
	   (LOSE "Different array sizes")))
    (SETQ ANSWER (ARRAY SIZE))
    (FOR I FROM 1 TO SIZE
     DO (SETF (ELT ANSWER I)
	      (- (ELT WAVE1 I) (ELT WAVE2 I))))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.TIMES WAVE1 WAVE2)
  (PROG (SIZE ANSWER)
    (SETQ SIZE (ARRAYSIZE WAVE1))
    (COND ((<> (ARRAYSIZE WAVE2) SIZE)
	   (LOSE "Different array sizes")))
    (SETQ ANSWER (ARRAY SIZE))
    (FOR I FROM 1 TO SIZE
     DO (SETF (ELT ANSWER I)
	      (x (ELT WAVE1 I) (ELT WAVE2 I))))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.QUOTIENT WAVE1 WAVE2)
  (PROG (SIZE ANSWER)
    (SETQ SIZE (ARRAYSIZE WAVE1))
    (COND ((<> (ARRAYSIZE WAVE2) SIZE)
	   (LOSE "Different array sizes")))
    (SETQ ANSWER (ARRAY SIZE))
    (FOR I FROM 1 TO SIZE
     DO (SETF (ELT ANSWER I)
	      (/ (ELT WAVE1 I) (ELT WAVE2 I))))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.RES WAVE RES)
  (* Pass WAVE through resonator RES *)
  (PROG (ANSWER SIZE REG)
    (SETQ SIZE (ARRAYSIZE WAVE))
    (SETQ ANSWER (ARRAY SIZE))
    (SETQ REG (CREATE REG))
    (FOR I FROM 1 TO SIZE
     DO (SETF (ELT ANSWER I)
	      (COEWAVE.STEP.RES (ELT WAVE I) RES REG)))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.ANTIRES WAVE ANTIRES)
  (* Pass WAVE through antiresonator ANTIRES *)
  (PROG (ANSWER SIZE REG)
    (SETQ SIZE (ARRAYSIZE WAVE))
    (SETQ ANSWER (ARRAY SIZE))
    (SETQ REG (CREATE REG))
    (FOR I FROM 1 TO SIZE
     DO (SETF (ELT ANSWER I)
	      (COEWAVE.STEP.ANTIRES (ELT WAVE I) ANTIRES REG)))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.RESS WAVE RESS)
  (* Pass WAVE through cascade of resonators RESS *)
  (PROG (ANSWER)
    (SETQ ANSWER WAVE)
    (FOR RES IN RESS
     DO (SETQ ANSWER (WEDIT.RES ANSWER RES)))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.ANTIRESS WAVE ANTIRESS)
  (* Pass WAVE through cascade of antiresonators ANTIRESS *)
  (PROG (ANSWER)
    (SETQ ANSWER WAVE)
    (FOR ANTIRES IN ANTIRESS
     DO (SETQ ANSWER (WEDIT.ANTIRES ANSWER ANTIRES)))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.AVERAGE WAVE PERIOD)
  (* Assume WAVE periodic with period PERIOD.  ANSWER is same as WAVE,
     but with noise smoothed out. *)
  (PROG (ANSWER SIZE N SUM AVG)
    (SETQ SIZE (ARRAYSIZE WAVE))
    (SETQ ANSWER (ARRAY SIZE))
    (FOR I FROM 1 TO PERIOD
     DO (SETQ SUM 0)
     (SETQ N 0)
     (FOR J _ I BY (+ J PERIOD)
      WHILE (<= J SIZE)
      DO (SETQ SUM (+ SUM (ELT WAVE J)))
      (SETQ N (1+ N)))
     (SETQ AVG (/ SUM N))
     (FOR J _ I BY (+ J PERIOD)
      WHILE (<= J SIZE)
      DO (SETF (ELT ANSWER J) AVG)))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.FFT WAVE)
  (PROG (RE IM)
    (* Note: Can't use (ARRAY 1024 NIL 0.0) because of bug in garbage
       collector.  Will crash lisp. *)
    (SETQ RE (ARRAY 1024))
    (SETQ IM (ARRAY 1024))
    (FOR I FROM 1 TO 1024
     DO (SETF (ELT RE I) 0.0)
     (SETF (ELT IM I) 0.0))
    (FOR I FROM 1 TO (IMIN 1024 (ARRAYSIZE WAVE))
     DO (SETF (ELT RE I) (FLOAT (ELT WAVE I))))
    (FFT RE IM)
    (* I'm not sure how 1000.0 comes in here, but it's about right. *)
    (FOR I FROM 1 TO 1024
     DO (SETF (ELT RE I)
	      (/$ (SQRT (+$ (x$ (ELT RE I) (ELT RE I))
			    (x$ (ELT IM I) (ELT IM I))))
		  (SQRT 1000.0))))
    (RETURN RE)
))

STOP