;; dspprims.lsp -- interface to dsp primitives

;; ARESON - notch filter
;; 
(defun areson (s c b &optional (n 0))
  (multichan-expand #'nyq:areson s c b n))

(setf areson-implementations
      (vector #'snd-areson #'snd-aresonvc #'snd-aresoncv #'snd-aresonvv))

;; NYQ:ARESON - notch filter, single channel
;;
(defun nyq:areson (signal center bandwidth normalize)
  (select-implementation-1-2 areson-implementations 
   signal center bandwidth normalize))


;; ATONE - highpass filter
;; 
(defun atone (s c)
  (multichan-expand #'nyq:atone s c))

(setf atone-implementations
      (vector #'snd-atone #'snd-atonev))

;; NYQ:ATONE - highpass filter, single channel
;;
(defun nyq:atone (s c)
  (select-implementation-1-1 atone-implementations s c))


;; COMB - comb filter
;; 
;; this is just a feedback-delay with different arguments
;;
(defun comb (snd hz decay)
  (let (delay feedback len d)
    (cond ((arrayp hz)
           (setf len (length hz))
           (setf delay (make-array len))
           (dotimes (i len)
               (let ((h (aref hz i)))
                 (cond ((numberp h)
                        (setf (aref delay i) (/ (float h))))
                       (t
                        (error "bad argument type" h))))))
          ((numberp hz)
           (setf delay (/ (float hz))))
          (t
           (error "comb hz must be a number" h)))
    (cond ((arrayp decay)
           (setf len (length decay))
           (setf feedback (make-array len))
           (dotimes (i len)
               (setf d delay)
               (cond ((arrayp d)
                      (setf d (aref delay i))))
               (setf (aref feedback i)
                     (s-exp (scale (* -6.9078 d)
                                   (recip (aref decay i)))))))
          (t
           (setf feedback (exp (/ (* -6.9078 delay) decay)))))
    (feedback-delay snd delay feedback)))


;; CONST -- a constant at control-srate
;;
(defun const (value &optional (dur 1.0))
  (let ((start (local-to-global 0))
	(stop (local-to-global dur)))
    (snd-const value start *CONTROL-SRATE* (- stop start))))


;; FEEDBACK-DELAY -- (delay is quantized to sample period)
;;
(defun feedback-delay (snd delay feedback)
  (multichan-expand #'nyq:feedback-delay snd delay feedback))


;; SND-DELAY-ERROR -- report type error
;;
(defun snd-delay-error (snd delay feedback)
  (error "feedback-delay with variable delay is not implemented"))


(setf feedback-delay-implementations
      (vector #'snd-delay #'snd-delay-error #'snd-delaycv #'snd-delay-error))


;; NYQ:FEEDBACK-DELAY -- single channel delay
;;
(defun nyq:feedback-delay (snd delay feedback)
  (select-implementation-1-1 feedback-delay-implementations 
                             snd delay feedback))


;; S-EXP -- exponentiate a sound
;;
(defun s-exp (s) (multichan-expand #'nyq:exp s))


;; NYQ:EXP -- exponentiate number or sound
;;
(defun nyq:exp (s) (if (soundp s) (snd-exp s) (exp s)))


;; HP -- high pass filter
;;
(setfn hp atone)


;; INTEGRATE -- integration
;;
(defun integrate (s) (multichan-expand #'snd-integrate s))


;; S-LOG -- natural log of a sound
;;
(defun s-log (s) (multichan-expand #'nyq:log s))


;; NYQ:LOG -- log of a number or sound
;;
(defun nyq:log (s) (if (soundp s) (snd-log s) (log s)))


;; LP -- low pass filter
;;
;(setfn lp tone) -- defined after tone, see below


;; NOISE -- white noise
;;
(defun noise (&optional (dur 1.0))
  (let ((start (local-to-global 0))
	(stop (local-to-global dur)))
    (snd-white start *SOUND-SRATE* (- stop start))))


;; RECIP -- reciprocal of a sound
;;
(defun recip (s) (multichan-expand #'nyq:recip s))


;; NYQ:RECIP -- reciprocal of a number or sound
;;
(defun nyq:recip (s) (if (soundp s) (snd-recip s) (/ (float s))))


;; RESON - bandpass filter
;; 
(defun reson (s c b &optional (n 0))
  (multichan-expand #'nyq:reson s c b n))

(setf reson-implementations
      (vector #'snd-reson #'snd-resonvc #'snd-resoncv #'snd-resonvv))

;; NYQ:RESON - bandpass filter, single channel
;;
(defun nyq:reson (signal center bandwidth normalize)
  (select-implementation-1-2 reson-implementations 
   signal center bandwidth normalize))


;; SHAPE -- waveshaper
;;
(defun shape (snd shape origin)
  (multichan-expand #'snd-shape snd shape origin))


;; SLOPE -- calculate the first derivative of a signal
;;
(defun slope (s) (multichan-expand #'nyq:slope s))


;; NYQ:SLOPE -- first derivative of single channel
;;
(defun nyq:slope (s)
  (let* ((sr (snd-srate s))
         (sr-inverse (/ sr)))
    (snd-xform (snd-slope s) sr (- sr-inverse) 0.0 MAX-STOP-TIME 1.0)))


;; TONE - lowpass filter
;; 
(defun tone (s c)
  (multichan-expand #'nyq:tone s c))

(setf tone-implementations
      (vector #'snd-tone #'snd-tonev))

;; NYQ:TONE - lowpass filter, single channel
;;
(defun nyq:tone (s c)
  (select-implementation-1-1 tone-implementations s c))

(setfn lp tone)

