dspprims.lsp

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

;;
(defun rms (s &optional (rate 100.0) window-size)
  (let (rslt step-size)
    (setf step-size (round (/ (snd-srate s) rate)))
    (cond ((null window-size)
               (setf window-size step-size)))
    (setf s (prod s s))
    (setf result (snd-avg s window-size step-size OP-AVERAGE))
        ;; compute square root of average
        (s-exp (scale 0.5 (s-log result)))))


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


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

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

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



;;; fixed-parameter filters based on snd-biquad

(setf Pi 3.14159265358979)

(defun square (x) (* x x))
(defun sinh (x) (* 0.5 (- (exp x) (exp (- x)))))


; remember that snd-biquad uses the opposite sign convention for a_i's 
; than Matlab does.

; convenient biquad: normalize a0, and use zero initial conditions.
(defun biquad (x b0 b1 b2 a0 a1 a2)
  (let ((a0r (/ 1.0 a0)))
    (snd-biquad x (* a0r b0) (* a0r b1) (* a0r b2) 
                             (* a0r a1) (* a0r a2) 0 0)))

; biquad with Matlab sign conventions for a_i's.
(defun biquad-m (x b0 b1 b2 a0 a1 a2)
  (biquad x b0 b1 b2 a0 (- a1) (- a2)))

; two-pole lowpass
(defun lowpass2 (x hz &optional (q 0.7071))
  (let* ((w (* 2.0 Pi (/ hz (snd-srate x))))
         (cw (cos w))
         (sw (sin w))
         (alpha (* sw (sinh (/ 0.5 q))))
         (a0 (+ 1.0 alpha))
         (a1 (* -2.0 cw))
         (a2 (- 1.0 alpha))
         (b1 (- 1.0 cw))
         (b0 (* 0.5 b1))
         (b2 b0))
    (biquad-m x b0 b1 b2 a0 a1 a2)))

; two-pole highpass
(defun highpass2 (x hz &optional (q 0.7071))
  (let* ((w (* 2.0 Pi (/ hz (snd-srate x))))
         (cw (cos w))
         (sw (sin w))
         (alpha (* sw (sinh (/ 0.5 q))))
         (a0 (+ 1.0 alpha))
         (a1 (* -2.0 cw))
         (a2 (- 1.0 alpha))
         (b1 (- -1.0 cw))
         (b0 (* -0.5 b1))
         (b2 b0))
    (biquad-m x b0 b1 b2 a0 a1 a2)))

; two-pole bandpass.  max gain is unity.
(defun bandpass2 (x hz q)
  (let* ((w (* 2.0 Pi (/ hz (snd-srate x))))
         (cw (cos w))
         (sw (sin w))
         (alpha (* sw (sinh (/ 0.5 q))))
         (a0 (+ 1.0 alpha))
         (a1 (* -2.0 cw))
         (a2 (- 1.0 alpha))
         (b0 alpha)
         (b1 0.0)
         (b2 (- alpha)))
    (biquad-m x b0 b1 b2 a0 a1 a2)))

; two-pole notch.
(defun notch2 (x hz q)
  (let* ((w (* 2.0 Pi (/ hz (snd-srate x))))
         (cw (cos w))
         (sw (sin w))
         (alpha (* sw (sinh (/ 0.5 q))))
         (a0 (+ 1.0 alpha))
         (a1 (* -2.0 cw))
         (a2 (- 1.0 alpha))
         (b0 1.0)
         (b1 (* -2.0 cw))
         (b2 1.0))
    (biquad-m x b0 b1 b2 a0 a1 a2)))


; two-pole allpass.
(defun allpass2 (x hz q)
  (let* ((w (* 2.0 Pi (/ hz (snd-srate x))))
         (cw (cos w))
         (sw (sin w))
         (k (exp (* -0.5 w (/ 1.0 q))))
         (a0 1.0)
         (a1 (* -2.0 cw k))
         (a2 (* k k))
         (b0 a2)
         (b1 a1)
         (b2 1.0))
    (biquad-m x b0 b1 b2 a0 a1 a2)))


; bass shelving EQ.  gain in dB; Fc is halfway point.
; response becomes peaky at slope > 1.
(defun eq-lowshelf (x hz gain &optional (slope 1.0))
  (let* ((w (* 2.0 Pi (/ hz (snd-srate x))))
         (sw (sin w))
         (cw (cos w))
         (A (expt 10.0 (/ gain (* 2.0 20.0))))
         (b (sqrt (- (/ (+ 1.0 (square A)) slope) (square (- A 1.0)))))
         (apc (* cw (+ A 1.0)))
         (amc (* cw (- A 1.0)))
         (bs (* b sw))

         (b0 (*      A (+ A  1.0 (- amc)    bs  )))
         (b1 (*  2.0 A (+ A -1.0 (- apc)        )))
         (b2 (*      A (+ A  1.0 (- amc) (- bs) )))
         (a0           (+ A  1.0    amc     bs  ))
         (a1 (* -2.0   (+ A -1.0    apc         )))
         (a2           (+ A  1.0    amc  (- bs) )))
    (biquad-m x b0 b1 b2 a0 a1 a2)))


; treble shelving EQ.  gain in dB; Fc is halfway point.
; response becomes peaky at slope > 1.
(defun eq-highshelf (x hz gain &optional (slope 1.0))
  (let* ((w (* 2.0 Pi (/ hz (snd-srate x))))
         (sw (sin w))
         (cw (cos w))
         (A (expt 10.0 (/ gain (* 2.0 20.0))))
         (b (sqrt (- (/ (+ 1.0 (square A)) slope) (square (- A 1.0)))))
         (apc (* cw (+ A 1.0)))
         (amc (* cw (- A 1.0)))
         (bs (* b sw))

         (b0 (*      A (+ A  1.0    amc     bs  )))
         (b1 (* -2.0 A (+ A -1.0    apc         )))
         (b2 (*      A (+ A  1.0    amc  (- bs) )))
         (a0           (+ A  1.0 (- amc)    bs  ))
         (a1 (*  2.0   (+ A -1.0 (- apc)        )))
         (a2           (+ A  1.0 (- amc) (- bs) )))
    (biquad-m x b0 b1 b2 a0 a1 a2)))
    
(defun nyq:eq-band (x hz gain width)
  (cond ((and (numberp hz) (numberp gain) (numberp width))
         (eq-band-ccc x hz gain width))
        ((and (soundp hz) (soundp gain) (soundp width))
         (snd-eqbandvvv x hz (db-to-linear gain) width))
        (t
         (error "eq-band hz, gain, and width must be all numbers or all sounds"))))

; midrange EQ.  gain in dB, width in octaves (half-gain width).
(defun eq-band (x hz gain width)
  (multichan-expand #'nyq:eq-band x hz gain width))
  
  
(defun eq-band-ccc (x hz gain width)
  (let* ((w (* 2.0 Pi (/ hz (snd-srate x))))
         (sw (sin w))
         (cw (cos w))
         (J (sqrt (expt 10.0 (/ gain 20.0))))
         ;(dummy (display "eq-band-ccc" gain J))
         (g (* sw (sinh (* 0.5 (log 2.0) width (/ w sw)))))
         ;(dummy2 (display "eq-band-ccc" width w sw g))
         (b0 (+ 1.0 (* g J)))
         (b1 (* -2.0 cw))
         (b2 (- 1.0 (* g J)))
         (a0 (+ 1.0 (/ g J)))
         (a1 (- b1))
         (a2 (- (/ g J) 1.0)))
    (biquad x b0 b1 b2 a0 a1 a2)))

; see failed attempt in eub-reject.lsp to do these with higher-order fns:

; four-pole Butterworth lowpass
(defun lowpass4 (x hz)
  (lowpass2 (lowpass2 x hz 0.60492333) hz 1.33722126))

; six-pole Butterworth lowpass
(defun lowpass6 (x hz)
  (lowpass2 (lowpass2 (lowpass2 x hz 0.58338080) 
                                  hz 0.75932572) 
                                  hz 1.95302407))

; eight-pole Butterworth lowpass
(defun lowpass8 (x hz)
  (lowpass2 (lowpass2 (lowpass2 (lowpass2 x hz 0.57622191)
                                            hz 0.66045510) 
                                            hz 0.94276399)
                                            hz 2.57900101))

; four-pole Butterworth highpass
(defun highpass4 (x hz)
  (highpass2 (highpass2 x hz 0.60492333) hz 1.33722126))

; six-pole Butterworth highpass
(defun highpass6 (x hz)
  (highpass2 (highpass2 (highpass2 x hz 0.58338080) 
                                     hz 0.75932572) 
                                     hz 1.95302407))

; eight-pole Butterworth highpass
(defun highpass8 (x hz)
  (highpass2 (highpass2 (highpass2 (highpass2 x hz 0.57622191)
                                                hz 0.66045510) 
                                                hz 0.94276399)
                                                hz 2.57900101))