dspprims.lsp

一个音频的可执行程序。可以导入MP3/WAV格式的文件后

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


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

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

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


;; comb-delay-from-hz -- compute the delay argument
;;
(defun comb-delay-from-hz (hz caller)
  (recip hz))

;; comb-feedback-from-decay -- compute the feedback argument
;;
(defun comb-feedback (decay delay)
  (s-exp (mult -6.9087 delay (recip decay))))

;; COMB - comb filter
;; 
;; this is just a feedback-delay with different arguments
;;
(defun comb (snd decay hz)
  (multichan-expand #'nyq:comb snd decay hz))

(defun nyq:comb (snd decay hz)
  (let (delay feedback len d)
    ; convert decay to feedback, iterate over array if necessary
    (setf delay (comb-delay-from-hz hz "comb"))
    (setf feedback (comb-feedback decay delay))
    (nyq:feedback-delay snd delay feedback)))

;; ALPASS - all-pass filter
;; 
(defun alpass (snd decay hz &optional min-hz)
  (multichan-expand #'nyq:alpass snd decay hz min-hz))
  


(defun nyq:alpass (snd decay hz min-hz)
  (let (delay feedback len d)
    ; convert decay to feedback, iterate over array if necessary
    (setf delay (comb-delay-from-hz hz "alpass"))
    (setf feedback (comb-feedback decay delay))
    (nyq:alpass1 snd delay feedback min-hz)))


;; CONST -- a constant at control-srate
;;
(defun const (value &optional (dur 1.0))
  (let ((d (get-duration dur)))
    (snd-const value *rslt* *CONTROL-SRATE* d)))


;; CONVOLVE - slow convolution
;; 
(defun convolve (s r)
  (multichan-expand #'snd-convolve s r))


;; 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"))


;; NYQ::DELAYCV -- coerce sample rates and call snd-delaycv
;;
(defun nyq:delaycv (the-snd delay feedback)
  (display "delaycv" the-snd delay feedback)
  (let ((the-snd-srate (snd-srate the-snd))
        (feedback-srate (snd-srate feedback)))
    (cond ((> the-snd-srate feedback-srate)
           (setf feedback (snd-up the-snd-srate feedback)))
          ((< the-snd-srate feedback-srate)
           (format t "Warning: down-sampling feedback in feedback-delay/comb~%")
           (setf feedback (snd-down the-snd-srate feedback))))
    (snd-delaycv the-snd delay feedback)))

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


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


;; SND-ALPASS-ERROR -- report type error
;;
(defun snd-alpass-error (snd delay feedback)
  (error "alpass with constant decay and variable hz is not implemented"))


(if (not (fboundp 'snd-alpasscv))
    (defun snd-alpasscv (snd delay feedback min-hz)
      (error "snd-alpasscv (ALPASS with variable decay) is not implemented")))
(if (not (fboundp 'snd-alpassvv))
    (defun snd-alpassvv (snd delay feedback min-hz)
      (error "snd-alpassvv (ALPASS with variable decay and feedback) is not implemented")))
      
(defun snd-alpass-4 (snd delay feedback min-hz)
    (snd-alpass snd delay feedback))
    

(defun snd-alpasscv-4 (the-snd delay feedback min-hz)
    (display "snd-alpasscv-4" (snd-srate the-snd) (snd-srate feedback))
    (let ((the-snd-srate (snd-srate the-snd))
          (feedback-srate (snd-srate feedback)))
      (cond ((> the-snd-srate feedback-srate)
             (setf feedback (snd-up the-snd-srate feedback)))
            ((< the-snd-srate feedback-srate)
             (format t "Warning: down-sampling feedback in alpass~%")
             (setf feedback (snd-down the-snd-srate feedback))))
      (display "snd-alpasscv-4 after cond" (snd-srate the-snd) (snd-srate feedback))
      (snd-alpasscv the-snd delay feedback)))

    
(defun snd-alpassvv-4 (the-snd delay feedback min-hz)
    ;(display "snd-alpassvv-4" (snd-srate the-snd) (snd-srate feedback))
    (let ((the-snd-srate (snd-srate the-snd))
          (delay-srate (snd-srate delay))
          (feedback-srate (snd-srate feedback))
          max-delay)
      (cond ((or (not (numberp min-hz))
                 (<= min-hz 0))
             (error "alpass needs numeric (>0) 4th parameter (min-hz) when delay is variable")))
      (setf max-delay (/ 1.0 min-hz))
      ; make sure delay is between 0 and max-delay
      ; use clip function, which is symetric, with an offset
      (setf delay (snd-offset (clip (snd-offset delay (* max-delay 0.5))
                                    max-delay)
                              (* max-delay -0.5)))
      ; now delay is between 0 and max-delay, so we won't crash nyquist when
      ; we call snd-alpassvv, which doesn't test for out-of-range data
      (cond ((> the-snd-srate feedback-srate)
             (setf feedback (snd-up the-snd-srate feedback)))
            ((< the-snd-srate feedback-srate)
             (format t "Warning: down-sampling feedback in alpass~%")
             (setf feedback (snd-down the-snd-srate feedback))))
      (cond ((> the-snd-srate delay-srate)
             (setf delay (snd-up the-snd-srate delay)))
            ((< the-snd-srate delay-srate)
             (format t "Warning: down-sampling delay in alpass~%")
             (setf delay (snd-down the-snd-srate delay))))
      ;(display "snd-alpassvv-4 after cond" (snd-srate the-snd) (snd-srate feedback))
      (snd-alpassvv the-snd delay feedback max-delay)))

(setf alpass-implementations
      (vector #'snd-alpass-4 #'snd-alpass-error
              #'snd-alpasscv-4 #'snd-alpassvv-4))



;; NYQ:ALPASS1 -- single channel alpass
;;
(defun nyq:alpass1 (snd delay feedback min-hz)
  (select-implementation-1-2 alpass-implementations
                             snd delay feedback min-hz))

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

;; S-ABS -- absolute value of a sound
;;
(defun s-abs (s) (multichan-expand #'nyq:abs s))

;; NYQ:ABS -- absolute value of number or sound
;;
(defun nyq:abs (s) (if (soundp s) (snd-abs s) (abs s)))

;; S-SQRT -- square root of a sound
;;
(defun s-sqrt (s) (multichan-expand #'nyq:sqrt s))

;; NYQ:SQRT -- square root of a number or sound
;;
(defun nyq:sqrt (s) (if (soundp s) (snd-sqrt s) (sqrt s)))


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


;; NOISE -- white noise
;;
(defun noise (&optional (dur 1.0))
  (let ((d (get-duration dur)))
    (snd-white *rslt* *SOUND-SRATE* d)))


(defun noise-gate (snd &optional (lookahead 0.5) (risetime 0.02) (falltime 0.5)
                                                 (floor 0.01) (threshold 0.01))
  (let ((rms (lp (mult snd snd) (/ *control-srate* 10.0))))
    (setf threshold (* threshold threshold))
    (mult snd (gate rms lookahead risetime falltime floor threshold))))


;; QUANTIZE -- quantize a sound
;;
(defun quantize (s f) (multichan-expand #'snd-quantize s f))


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

;; RMS -- compute the RMS of a sound