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

(* ****************************************************************
*
*     WAVE CREATION
*
****************************************************************)

(DEFVAR SPEECH.WAVESIZE 1024)

(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 WAVE)
     DO (SPEECH.BOUT 
	 STREAM 
	 (RANGECHECK (FIXR (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 AMP 1 0 (1- PERIOD) SIZE))

(DEFEXPR (WEDIT.BOXWAVE AMP1 PERIOD1 AMP2 PERIOD2 
			(OPTIONAL SIZE SPEECH.WAVESIZE))
  (PROG (ANSWER PERIOD AMP)
    (SETQ ANSWER (ARRAY SIZE))
    (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)
))

(DEFEXPR (WEDIT.CONSTANT AMP (OPTIONAL SIZE SPEECH.WAVESIZE))
  (PROG (ANSWER)
    (SETQ ANSWER (ARRAY SIZE 'POINTER AMP))
    (RETURN ANSWER)
))


(* ****************************************************************
*
*     VECTOR ARITHMETIC
*
****************************************************************)

(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.MINUS WAVE)
  (PROG (SIZE ANSWER)
    (SETQ SIZE (ARRAYSIZE WAVE))
    (SETQ ANSWER (ARRAY SIZE))
    (FOR I FROM 1 TO SIZE
     DO (SETF (ELT ANSWER I) (0-$ (ELT WAVE I))))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.SQUARE WAVE)
  (WEDIT.TIMES WAVE WAVE))

(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))
		  128.0)))
    (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)
	      (/$ (x$ 128.0 (ELT WAVE1 I)) (ELT WAVE2 I))))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.MAX 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)
	      (FMAX (ELT WAVE1 I) (ELT WAVE2 I))))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.MIN 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)
	      (FMIN (ELT WAVE1 I) (ELT WAVE2 I))))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.ABS WAVE)
  (PROG (SIZE ANSWER)
    (SETQ SIZE (ARRAYSIZE WAVE))
    (SETQ ANSWER (ARRAY SIZE))
    (FOR I FROM 1 TO SIZE
     DO (SETF (ELT ANSWER I) (ABS (ELT WAVE I))))
    (RETURN ANSWER)
))


(* ****************************************************************
*
*     SCALAR OPERATIONS
*
****************************************************************)

(DEFEXPR (WEDIT.ROTATE WAVE N)
  (PROG (ANSWER SIZE)
    (SETQ SIZE (ARRAYSIZE WAVE))
    (SETQ N (\ (+ N SIZE) SIZE))
    (SETQ ANSWER (ARRAY SIZE))
    (FOR I FROM 1 TO (- SIZE N)
     DO (SETF (ELT ANSWER (+ I N)) (ELT WAVE I)))
    (FOR I FROM (1+ (- SIZE N)) TO SIZE
     DO (SETF (ELT ANSWER (- (+ I N) SIZE)) (ELT WAVE I)))
    (RETURN ANSWER)
))

(DEFEXPR (WEDIT.EXPANDY WAVE F)
  (PROG (ANSWER)
    (SETQ SIZE (ARRAYSIZE WAVE))
    (SETQ ANSWER (ARRAY SIZE))
    (FOR I FROM 1 TO SIZE
     DO (SETF (ELT ANSWER I) (x$ (ELT WAVE I) F)))
    (RETURN ANSWER)
))


(* ****************************************************************
*
*     MISCELLANEOUS
*
****************************************************************)

(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.AVERAGEY WAVE)
  (PROG (ANSWER SIZE)
    (SETQ SIZE (ARRAYSIZE WAVE))
    (SETQ ANSWER 0.0)
    (FOR I FROM 1 TO SIZE
     DO (SETQ ANSWER (+$ ANSWER (ELT WAVE I))))
    (SETQ ANSWER (/$ ANSWER SIZE))
    (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))))
			1000.0)))
    (RETURN RE)
))

(DEFEXPR (WEDIT.CEPSTRUM WAVE)
  (PROG (ANSWER)
    (SETQ ANSWER (WEDIT.FFT WAVE))
    (FOR I FROM 1 TO (ARRAYSIZE ANSWER)
     DO (SETF (ELT ANSWER I) (x$ 10.0 (LOG (ELT ANSWER I)))))
    (SETQ ANSWER (WEDIT.FFT ANSWER))
    (RETURN ANSWER)))

STOP