You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

137 lines
4.7 KiB

  1. $nyquist plug-in
  2. $version 4
  3. $type process spectral
  4. $name (_ "Spectral Delete")
  5. $manpage "Spectral_Delete"
  6. $author (_ "Steve Daulton")
  7. $release 2.4.0
  8. $copyright (_ "Released under terms of the GNU General Public License version 2")
  9. ;; Released under terms of the GNU General Public License version 2:
  10. ;; http://www.gnu.org/licenses/old-licenses/gpl-2.0.html
  11. ;;
  12. ;; For information about writing and modifying Nyquist plug-ins:
  13. ;; https://wiki.audacityteam.org/wiki/Nyquist_Plug-ins_Reference
  14. (defun sinc (x fc)
  15. ;; http://www.dspguide.com/ch16/1.htm
  16. ;; Note that fc is a fraction of the sample rate.
  17. (if (= x 0)
  18. (* 2 pi fc)
  19. (/ (sin (* 2 pi fc x)) x)))
  20. (defun blackman (i M)
  21. ;; Where: 0 <= i <= M
  22. (+ 0.42
  23. (* -0.5 (cos (/ (* 2.0 pi i) M)))
  24. (* 0.08 (cos (/ (* 4 pi i) M)))))
  25. (defun calc-kernel (size fc)
  26. ;; Generate windowed sinc kernel impulse
  27. (when (oddp size)
  28. (error "Size of sinc filter must be even"))
  29. (let ((ar (make-array (1+ size)))
  30. (norm 0) ;Normalization factor
  31. val)
  32. (do ((i 0 (1+ i))
  33. (j size (1- j))
  34. (x (- halfk) (1+ x)))
  35. ((> i j))
  36. (setf val (* (sinc x fc)(blackman i size)))
  37. (setf norm (+ norm val))
  38. (setf (aref ar i) val)
  39. (setf (aref ar j) val))
  40. ;; norm is sum of all samples, but don't count middle value twice.
  41. (setf norm (- (* norm 2)(aref ar halfk)))
  42. (dotimes (i size ar)
  43. (setf (aref ar i)(/ (aref ar i) norm)))))
  44. (defun get-kernel (size fc type)
  45. ;; type: 0 (low pass) or 1 (highpass)
  46. ;; Returns filter kernel as a sound.
  47. (let ((kernel (calc-kernel size fc)))
  48. (when (= type 1)
  49. ;; Convert kernel to high pass
  50. ;; https://tomroelandts.com/articles/how-to-create-a-simple-high-pass-filter
  51. (dotimes (i size kernel)
  52. (setf (aref kernel i)(* -1 (aref kernel i))))
  53. (incf (aref kernel halfk)))
  54. (snd-from-array 0 *sound-srate* kernel)))
  55. (defun sinc-filter (sig start end impulse)
  56. (extract-abs start end (convolve sig impulse)))
  57. (defmacro validate-low-hz (hz fmin fmax)
  58. ;; Discard if out of valid range.
  59. ;; Do NOT coerce into range if too high - if multiple tracks with
  60. ;; different sample rates, that could cause very unepected results.
  61. `(if (or (not ,hz) (< ,hz fmin) (> ,hz fmax))
  62. (setf ,hz nil)))
  63. (defmacro validate-high-hz (hz fmin fmax)
  64. ;; Discard if too high. Coerce into range if too low.
  65. `(if (or (not ,hz) (>= ,hz fmax))
  66. (setf ,hz nil)
  67. (setf ,hz (max ,hz fmin))))
  68. (defun dofilter (cf bw type)
  69. ;; type: 0 (low pass) or 1 (highpass)
  70. ;; Calculate kernel length (must be even)
  71. ;; http://www.dspguide.com/ch16/2.htm
  72. (setf klength (/ 4.0 bw))
  73. (setf halfk (round (/ klength 2)))
  74. (setf klength (* 2 halfk))
  75. (let ((imp (get-kernel klength cf type))
  76. (start (/ halfk *sound-srate*))
  77. (dur (get-duration 1)))
  78. (multichan-expand #'sinc-filter *track* start (+ start dur) imp)))
  79. (defun bandwidth (hz)
  80. ;; Set bandwidth ratio of each filter as 1% of filter frequency.
  81. (* hz 0.01))
  82. (defun bw-ratio (hz)
  83. ;; Bandwidth ratio is required as a fraction of the sampling rate
  84. (/ (bandwidth hz) *sound-srate*))
  85. (defun filter ()
  86. (when (< *sound-srate* 100)
  87. (throw 'err (_ "Error.~%Track sample rate below 100 Hz is not supported.")))
  88. (let* ((f0 (get '*selection* 'low-hz))
  89. (f1 (get '*selection* 'high-hz))
  90. (fc (get '*selection* 'center-hz))
  91. ; If frequency too low, filter length is too large.
  92. (fmin (* 0.002 *sound-srate*))
  93. (fmax (* 0.498 *sound-srate*))
  94. (tn (truncate len))
  95. (transition (truncate (* 0.01 *sound-srate*))) ; 10 ms
  96. (t1 (min transition (/ tn 2))) ; fade in length (samples)
  97. (t2 (max (- tn transition) (/ tn 2))) ; length before fade out (samples)
  98. (breakpoints (list t1 1.0 t2 1.0 tn))
  99. (env (snd-pwl 0.0 *sound-srate* breakpoints)))
  100. (validate-low-hz f0 fmin fmax)
  101. (validate-high-hz f1 fmin fmax)
  102. ;; Handle very narrow selections.
  103. ;; This may cause f0 or f1 to 'slightly' exceed fmin fmax.
  104. (when (and f0 f1 (< (- f1 f0) (* fc 0.02)))
  105. (setf f0 (* fc 0.99))
  106. (setf f1 (* fc 1.01)))
  107. (when f0
  108. (setf lp-width (bw-ratio f0))
  109. (setf f0 (/ f0 *sound-srate*)))
  110. (when f1
  111. (setf hp-width (bw-ratio f1))
  112. (setf f1 (/ f1 *sound-srate*)))
  113. ;(format t "Low: ~a High: ~a" (if f0 (* f0 *sound-srate*) nil) (if f1 (* f1 *sound-srate*) nil))
  114. (if (not (or f0 f1))
  115. "" ;may occur if multiple tracks with diferent sample rates
  116. (sim
  117. (mult env
  118. (if f0 (dofilter f0 lp-width 0) 0))
  119. (mult env
  120. (if f1 (dofilter f1 hp-width 1) 0))
  121. (mult (diff 1.0 env) *track*)))))
  122. (catch 'err (filter))