| commit | author | age | ||
| 92c40d | 1 | ; ******************************************************************** |
| AN | 2 | ; OM-SoX, (c) 2011-2014 Marlon Schumacher (CIRMMT/McGill University) * |
| 3 | ; http://sourceforge.net/projects/omsox/ * | |
| 4 | ; * | |
| 5 | ; Multichannel Audio Manipulation and Functional Batch Processing. * | |
| 6 | ; DSP based on SoX - (c) C.Bagwell and Contributors * | |
| 7 | ; http://sox.sourceforge.net/ * | |
| 8 | ; ******************************************************************** | |
| 9 | ; | |
| 10 | ;This program is free software; you can redistribute it and/or | |
| 11 | ;modify it under the terms of the GNU General Public License | |
| 12 | ;as published by the Free Software Foundation; either version 2 | |
| 13 | ;of the License, or (at your option) any later version. | |
| 14 | ; | |
| 15 | ;See file LICENSE for further informations on licensing terms. | |
| 16 | ; | |
| 17 | ;This program is distributed in the hope that it will be useful, | |
| 18 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 20 | ;GNU General Public License for more details. | |
| 21 | ; | |
| 22 | ;You should have received a copy of the GNU General Public License | |
| 23 | ;along with this program; if not, write to the Free Software | |
| 24 | ;Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,10 USA. | |
| 25 | ; | |
| 26 | ;Authors: M. Schumacher | |
| 27 | ||
| 28 | (in-package :om) | |
| 29 | ||
| 30 | ;; Sox-Biquad ================================================================ | |
| 31 | ||
| 32 | (defmethod! sox-biquad ((b0 number) (b1 number) (b2 number) (a0 number) (a1 number) (a2 number) &key sox-append) | |
| 33 | :icon 10 | |
| 34 | :initvals '(nil nil nil nil nil nil nil) | |
| 35 | :indoc (list "b0" "b1" "b2" "a0" "a1" "a2" *sox-append-doc*) | |
| 36 | :doc "Apply a biquad RBJ IIR filter with the given coefficients (where a0=1)." | |
| 37 | ||
| 38 | (setf thestring (format nil "biquad ~d ~d ~d ~d ~d ~d" b0 b1 b2 a0 a1 a2)) | |
| 39 | (sox-concat sox-append thestring) | |
| 40 | ) | |
| 41 | ||
| 42 | ;; Sox-Biquad ================================================================ | |
| 43 | ||
| 44 | (defmethod! sox-hilbert ((taps number) &key sox-append) | |
| 45 | :icon 10 | |
| 46 | :initvals '(32767 nil) | |
| 47 | :indoc (list "number of taps (must be an odd number between 3 and 32767)" *sox-append-doc*) | |
| 48 | :doc "Apply a Hilbert transform FIR filter." | |
| 49 | ||
| 50 | (setf thestring (format nil "hilbert -n ~d" taps)) | |
| 51 | (sox-concat sox-append thestring) | |
| 52 | ) | |
| 53 | ||
| 54 | ; Sox-sinc ================================================== | |
| 55 | ||
| 56 | ||
| 57 | (defmethod! sox-sinc ((mode string) (Low-Boundary number) (High-Boundary number) &key attenuation transition-bandwidth filter-taps kaiser-beta sox-append) | |
| 58 | :icon 10 | |
| 59 | :initvals '("bandpass" 0 20000 120 nil nil nil nil) | |
| 60 | :menuins (list (list 0 *sox-filter-types*)) | |
| 61 | :indoc (list "Mode: lowpass, highpass, band-pass, band-reject" "Low-Boundary frequency (in Hz)" "High-Boundary frequency (in Hz)" "Stop-band attenuation (in db, between 40 and 180)" | |
| 62 | "Transition bandwidth (in Hz)" "Number of filter taps" "Beta value for Kaiser window" *sox-append-doc*) | |
| 63 | :doc "Apply a sinc kaiser-windowed low-pass, high-pass, band-pass, or band-reject FIR filter with 120dB stopband attenuation. | |
| 64 | ||
| 65 | The default stop-band attenuation of 120dB can be overridden via <attenuation>. | |
| 66 | Alternatively, the kaiser-window 'beta' parameter can be given directly via <kaiser-beta>. | |
| 67 | The default transition band-width of 5% of the total band can be overridden with <transition-bandwidth> (in Hz). | |
| 68 | Alternatively, the number of filter taps can be given directly via <filter-taps>. | |
| 69 | " | |
| 70 | ||
| 71 | (let* ( | |
| 72 | (thestring (format nil " sinc"))) | |
| 73 | (cond (attenuation (setf thestring (string+ thestring (format nil " -a ~d" (clip attenuation 40 180))))) | |
| 74 | (kaiser-beta (setf thestring (string+ thestring (format nil " -b ~d" kaiser-beta))))) | |
| 75 | (cond (transition-bandwidth (setf thestring (string+ thestring (format nil " -t ~d" transition-bandwidth)))) | |
| 76 | (filter-taps (setf thestring (string+ thestring (format nil " -n ~d" filter-taps))))) | |
| 77 | (cond | |
| 78 | ((equal mode "bandpass") | |
| 79 | (setf thestring (concatenate 'string thestring | |
| 80 | (format nil " ~d-~d " Low-Boundary High-Boundary)))) | |
| 81 | ((equal mode "bandreject") | |
| 82 | (setf thestring (concatenate 'string thestring | |
| 83 | (format nil " ~d-~d " High-Boundary Low-Boundary)))) | |
| 84 | ((equal mode "lowpass") | |
| 85 | (setf thestring (concatenate 'string thestring | |
| 86 | (format nil " -~d " Low-Boundary)))) | |
| 87 | ((equal mode "highpass") | |
| 88 | (setf thestring (concatenate 'string thestring | |
| 89 | (format nil " ~d " High-Boundary))))) | |
| 90 | ||
| 91 | (sox-concat sox-append thestring)) | |
| 92 | ) | |
| 93 | ||
| 94 | (defmethod! sox-band-fft ((mode string) (center-freq number) (bandwidth number) &key attenuation transition-bandwidth filter-taps kaiser-beta sox-append) | |
| 95 | :icon 10 | |
| 96 | :initvals '("bandpass" 1000 100 120 nil nil nil nil) | |
| 97 | :menuins (list (list 0 (list (list "bandpass" "bandpass") (list "bandreject" "bandreject")))) | |
| 98 | (sox-sinc mode (om-clip (- center-freq (* 0.5 bandwidth)) 0 nil) (+ center-freq (* 0.5 bandwidth)) | |
| 99 | :attenuation attenuation | |
| 100 | :transition-bandwidth transition-bandwidth | |
| 101 | :filter-taps filter-taps | |
| 102 | :kaiser-beta kaiser-beta | |
| 103 | :sox-append sox-append | |
| 104 | ) | |
| 105 | ) | |
| 106 | ||
| 107 | ||
| 108 | ||
| 109 | ;; Sox-Bandfilter ================================================== | |
| 110 | ||
| 111 | (defmethod! sox-band ((frequency number) (bandwidth number) (mode string) &key unit sox-append) | |
| 112 | :icon 10 | |
| 113 | :initvals '(1000 100 "bandpass" "Hz" nil) | |
| 114 | :menuins (list (list 2 (list (list "bandpass" "bandpass") (list "bandreject" "bandreject") (list "SPKit resonator (normal)" "band") (list "SPKit resonator (noise)" "band -n"))) | |
| 115 | (list 3 *sox-unit-menu*)) | |
| 116 | :indoc (list "Center-frequency (Hz)" "Filter-bandwidth" "Bandpass, Bandreject, SPKit resonator (normal), SPKit resonator (noise)" *sox-unit-doc* *sox-append-doc*) | |
| 117 | :doc "Apply a band-filter with center frequency <frequency> and 3dB-point bandwidth <bandwidth>. | |
| 118 | ||
| 119 | Available modes are (two-pole) Butterworth bandpass/bandreject or SPKit resonator bandpass (normal and noise)." | |
| 120 | ||
| 121 | (let* ( | |
| 122 | (thestring (format nil "~a ~d ~d" mode frequency bandwidth))) | |
| 123 | (when unit | |
| 124 | (setf thestring (sox-units thestring unit))) | |
| 125 | (sox-concat sox-append thestring)) | |
| 126 | ) | |
| 127 | ||
| 128 | ||
| 129 | ;; Sox-1pole ================================================================ | |
| 130 | ||
| 131 | (defmethod! sox-1pole ((frequency number) (mode string) &key sox-append) | |
| 132 | :icon 10 | |
| 133 | :initvals '(nil "lowpass" nil) | |
| 134 | :menuins '((1 (("lowpass" "lowpass") ("highpass" "highpass")))) | |
| 135 | :indoc (list "Cutoff-Frequency (Hz)" "Filter mode (highpass/lowpass)" *sox-append-doc*) | |
| 136 | :doc "A 1-pole RBJ high-/lowpass-filter." | |
| 137 | ||
| 138 | (setf thestring | |
| 139 | (cond ((equal mode "highpass") | |
| 140 | (format nil "~a -1 ~d" mode frequency)) | |
| 141 | ((equal mode "lowpass") | |
| 142 | (format nil "~a -1 ~d" mode frequency)))) | |
| 143 | (sox-concat sox-append thestring) | |
| 144 | ) | |
| 145 | ||
| 146 | ;; Sox-2pole ================================================================ | |
| 147 | ||
| 148 | (defmethod! sox-2pole ((frequency number) (width number) (mode string) &key unit sox-append) | |
| 149 | :icon 10 | |
| 150 | :initvals '(1000 nil "lowpass" "Hz" nil) | |
| 151 | :menuins (list (list 2 *sox-filter-types-all*) (list 3 *sox-unit-menu*)) | |
| 152 | :indoc (list "Filter frequency (Hz)" "Filter width (default unit: Hz)" "Mode: Bandpass or Bandreject" *sox-unit-doc* *sox-append-doc*) | |
| 153 | :doc "A 2-pole RBJ lowpass, highpass, band-pass or band-reject filter with frequency <frequency> and bandwidth <width>." | |
| 154 | ||
| 155 | (setf thestring | |
| 156 | (cond ((equal mode "allpass") | |
| 157 | (format nil "~a ~d ~d" mode frequency width)) | |
| 158 | ((equal mode "highpass") | |
| 159 | (format nil "~a -2 ~d ~d" mode frequency width)) | |
| 160 | ((equal mode "lowpass") | |
| 161 | (format nil "~a -2 ~d ~d" mode frequency width)) | |
| 162 | ((equal mode "bandpass") | |
| 163 | (format nil "~a ~d ~d" mode frequency width)) | |
| 164 | ((equal mode "bandreject") | |
| 165 | (format nil "~a ~d ~d" mode frequency width)))) | |
| 166 | (setf thestring (sox-units thestring unit)) | |
| 167 | (sox-concat sox-append thestring) | |
| 168 | ) | |
| 169 | ||
| 170 | ||
| 171 | ;;; Sox-Shelving ================================================== | |
| 172 | ||
| 173 | (defmethod! sox-shelving-eq ((mode string) (frequency number) (width number) (gain number) &key unit sox-append) | |
| 174 | :icon 10 | |
| 175 | :initvals '("bass" nil nil 6 "Hz" nil) | |
| 176 | :menuins (list (list 0 (list (list "bass" "bass") (list "treble" "treble"))) (list 4 *sox-unit-menu*)) | |
| 177 | :indoc (list "Mode: bass/treble" "Frequency (Hz)" "Width (default unit: Hz)" "Gain (dB)" *sox-unit-doc* *sox-append-doc*) | |
| 178 | :doc "Apply a two-pole shevling filter to boost or cut the bass (lower) or treble (higher) frequencies of the audio." | |
| 179 | (let* ( | |
| 180 | (thestring (format nil "~a ~d" mode gain))) | |
| 181 | (setf thestring (concatenate 'string thestring | |
| 182 | (format nil " ~d ~d" frequency width))) | |
| 183 | (setf thestring (sox-units thestring unit)) | |
| 184 | (sox-concat sox-append thestring)) | |
| 185 | ) | |
| 186 | ||
| 187 | ||
| 188 | ;;; Sox-EQ ================================================= | |
| 189 | ||
| 190 | (defmethod! sox-peak-eq ((frequency number) (bandwidth number) (gain number) &key unit sox-append) | |
| 191 | :icon 10 | |
| 192 | :initvals '(1000 100 -12 "Hz" nil) | |
| 193 | :menuins (list (list 3 *sox-unit-menu*)) | |
| 194 | ||
| 195 | :indoc (list "Frequency (in Hz)" "Bandwidth (default unit: Hz)" "Gain in dB" *sox-unit-doc* *sox-append-doc*) | |
| 196 | :doc "Apply a two-pole peaking equalisation (EQ) filter. With this filter, the signal-level at and around a selected frequency can be increased or decreased, whilst (unlike band-pass and band-reject filters) that at all other frequencies is unchanged." | |
| 197 | ||
| 198 | (let* ((thestring (format nil "equalizer ~d ~d" frequency bandwidth))) | |
| 199 | (setf thestring (sox-units thestring unit)) | |
| 200 | (setf thestring (concatenate 'string thestring (format nil " ~d" gain))) | |
| 201 | (sox-concat sox-append thestring)) | |
| 202 | ) | |
| 203 | ||
| 204 | ||
| 205 | ;;; Sox-Shelf-EQ =================================== | |
| 206 | ||
| 207 | (defmethod! sox-shelf-eq ((mode string) (frequency number) (bandwidth number) (gain number) &key unit sox-append) | |
| 208 | :icon 10 | |
| 209 | :initvals '("bass" 1000 100 6 "Hz" nil) | |
| 210 | :menuins '((0 (("low-shelf" "bass") ("high-shelf" "treble"))) | |
| 211 | (4 (("Hz" "Hz") ("kHz" "kHz") ("Octaves" "Octaves") ("Q-factor" "Q-factor") ("Slope" "Slope")))) | |
| 212 | :indoc (list "low-shelf, high-shelf" "Frequency" "Bandwidth (default unit: Hz)" "Gain (in dB)" *sox-unit-doc* *sox-append-doc*) | |
| 213 | :doc "Equalize the audio using high- or low-shelf filter." | |
| 214 | ||
| 215 | (setf thestring (format nil " ~a ~d ~d ~d" mode gain frequency bandwidth)) | |
| 216 | (setf thestring (sox-units thestring unit)) | |
| 217 | ||
| 218 | (sox-concat sox-append thestring) | |
| 219 | ) | |
| 220 | ||
| 221 | ;;; Sox-Equalizer ================================== | |
| 222 | ||
| 223 | ; this one 'includes' the above sox-peak-eq | |
| 224 | (defmethod! sox-equalizer ((mode string) (frequency number) (bandwidth number) (gain number) &key unit sox-append) | |
| 225 | :icon 10 | |
| 226 | :initvals '("bass" 1000 100 6 "Hz" nil) | |
| 227 | :menuins '((0 (("low-shelf" "bass") ("high-shelf" "treble") ("peak" "peak"))) | |
| 228 | (4 (("Hz" "Hz") ("kHz" "kHz") ("Octaves" "Octaves") ("Q-factor" "Q-factor") ("Slope" "Slope")))) | |
| 229 | :indoc (list "low-shelf, high-shelf, peak" "Frequency" "Bandwidth (default unit: Hz)" "Gain (in dB)" *sox-unit-doc* *sox-append-doc*) | |
| 230 | :doc "Equalize the audio using high/low-shelf or peak filters." | |
| 231 | (if (equal mode "peak") | |
| 232 | (progn | |
| 233 | (setf thestring (format nil " equalizer ~d ~d" frequency bandwidth)) | |
| 234 | (setf thestring (sox-units thestring unit)) | |
| 235 | (setf thestring (concatenate 'string thestring (format nil " ~d" gain)))) | |
| 236 | (progn | |
| 237 | (setf thestring (format nil " ~a ~d ~d ~d" mode gain frequency bandwidth)) | |
| 238 | (setf thestring (sox-units thestring unit)))) | |
| 239 | ||
| 240 | (sox-concat sox-append thestring) | |
| 241 | ) | |
| 242 | ||
| 243 | ; Sox-Bandpass ==================================================== | |
| 244 | ||
| 245 | (defmethod! sox-bandpass ((frequency number) (bandwidth number) (mode string) &key unit sox-append) | |
| 246 | :icon 10 | |
| 247 | :initvals '(1000 100 "normal" "Hz" nil) | |
| 248 | :menuins (list (list 2 (list (list "normal" "normal") (list "noise" "noise"))) (list 3 *sox-unit-menu*)) | |
| 249 | :indoc (list "Cutoff-Frequency (in Hz)" "Bandwidth Hz" "Filtermode (normal/noisy)" *sox-unit-doc* *sox-append-doc*) | |
| 250 | :doc "Apply a SPKit resonator band-pass IIR filter." | |
| 251 | ||
| 252 | (setf thestring | |
| 253 | (cond ((equal mode "normal") | |
| 254 | (format nil " band ~d ~d" frequency bandwidth)) | |
| 255 | ((equal mode "noise") | |
| 256 | (format nil " band -n ~d ~d" frequency bandwidth)))) | |
| 257 | (setf thestring (sox-units thestring unit)) | |
| 258 | ||
| 259 | (sox-concat sox-append thestring) | |
| 260 | ) | |
| 261 | ||
| 262 | ||
| 263 | ;;; Sox-Highpass ================================================== | |
| 264 | ||
| 265 | ; sox-unit should go into all the filter/effects using different units | |
| 266 | ||
| 267 | (defmethod! sox-highpass ((cutoff-frequency number) (width number) (poles string) &key (unit "Hz") sox-append) | |
| 268 | :icon 10 | |
| 269 | :initvals '(10 100 "onepole" "Hz" nil) | |
| 270 | :menuins (list (list 2 (list (list "onepole" "onepole") (list "twopole" "twopole"))) (list 3 *sox-unit-menu*)) | |
| 271 | :indoc (list "Cutoff-frequency" "Filter width (applies only to two-pole filters). Default unit: Hz" "One- or Two-pole filtering" *sox-unit-doc* *sox-append-doc*) | |
| 272 | :doc "Apply a high-pass filter to the audio. | |
| 273 | ||
| 274 | Optional single-pole or double-pole filtering. | |
| 275 | A value of Q = 0.707 for <width> yields a Butterworth response." | |
| 276 | ||
| 277 | (let* ( | |
| 278 | (thestring (format nil "highpass"))) | |
| 279 | (if (equal poles "onepole") | |
| 280 | (progn | |
| 281 | (setf thestring (concatenate 'string thestring | |
| 282 | (format nil " -1 ~d" cutoff-frequency))) | |
| 283 | (sox-concat sox-append thestring)) | |
| 284 | (progn | |
| 285 | (setf thestring (concatenate 'string thestring | |
| 286 | (format nil " -2 ~d ~d" cutoff-frequency width))) | |
| 287 | (sox-concat sox-append (sox-units thestring unit))) | |
| 288 | ) | |
| 289 | ) | |
| 290 | ) | |
| 291 | ||
| 292 | ;;; Sox-Lowpass ================================================== | |
| 293 | ||
| 294 | (defmethod! sox-lowpass ((cutoff-frequency number) (width number) (poles string) &key unit sox-append) | |
| 295 | :icon 10 | |
| 296 | :initvals '(1000 100 "onepole" "Hz" nil) | |
| 297 | :menuins (list (list 2 (list (list "onepole" "onepole") (list "twopole" "twopole"))) (list 3 *sox-unit-menu*)) | |
| 298 | :indoc (list "Cutoff-frequency (Hz)" "Filter width (applies only to two-pole filters). Default unit: Hz" "One- or Two-pole filtering" *sox-unit-doc* *sox-append-doc*) | |
| 299 | :doc "Apply a low-pass filter to the audio. | |
| 300 | ||
| 301 | Optional single-pole or double-pole filtering. | |
| 302 | A value of Q = 0.707 for 'width' yields a Butterworth response." | |
| 303 | ||
| 304 | (let* ( | |
| 305 | (thestring (format nil " lowpass "))) | |
| 306 | (if (equal poles "onepole") | |
| 307 | (setf thestring (concatenate 'string thestring | |
| 308 | (format nil " -1 ~d " cutoff-frequency))) | |
| 309 | (progn | |
| 310 | (setf thestring (concatenate 'string thestring | |
| 311 | (format nil " -2 ~d ~d" cutoff-frequency width))) | |
| 312 | (setf thestring (sox-units thestring unit)) | |
| 313 | )) | |
| 314 | (sox-concat sox-append thestring)) | |
| 315 | ) | |
| 316 | ||
| 317 | ;;; Sox-Allpass ================================================== | |
| 318 | ||
| 319 | (defmethod! sox-allpass ((frequency number) (width number) &key (unit "Hz") sox-append) | |
| 320 | :icon 10 | |
| 321 | :initvals '(1000 100 "Hz" nil) | |
| 322 | :menuins (list (list 2 *sox-unit-menu*)) | |
| 323 | :indoc (list "Frequency (Hz)" "Width (default unit: Hz)" *sox-unit-doc* *sox-append-doc* ) | |
| 324 | :doc "Apply a two-pole all-pass filter with frequency <frequency> and width <width>." | |
| 325 | ||
| 326 | (let* ( | |
| 327 | (thestring (format nil "allpass ~d ~d" frequency width))) | |
| 328 | (setf thestring (sox-units thestring unit)) | |
| 329 | (sox-concat sox-append thestring)) | |
| 330 | ) | |
| 331 | ||
| 332 | ||
| 333 | ;;; Sox-Comb ================================================== | |
| 334 | ||
| 335 | (defmethod! sox-comb ((frequency t) (gain t) &key (mode "serial") (input-gain 0) (output-gain 0) sox-append) ; (polarity symbol) | |
| 336 | ; polarity doesn't work as it's mixed internally | |
| 337 | :icon 10 | |
| 338 | :initvals '(1000 0 "parallel" 0 0 nil) | |
| 339 | :menuins '((2 (("parallel" "parallel") ("serial" "serial")))) | |
| 340 | :indoc (list "frequency (Hz)" "gain (dB)" "Parallel or serial structure for delay lines. The latter means accumulating taps." "Input gain stage (dB)" "Output gain stage (dB)" *sox-append-doc*) | |
| 341 | :doc "Apply a comb-filter to the audio. | |
| 342 | ||
| 343 | <frequency> is the frequency of the filter (Hz). | |
| 344 | <gain> is a list of levels (in dB) for the successive taps. | |
| 345 | <mode> specifies whether the taps are produced in parallel ('parallel') or fed back into the input ('serial'). | |
| 346 | " | |
| 347 | (let ((times (loop for item in (list! frequency) collect (float (om/ 1000 item)))) | |
| 348 | (levels (list! (db->lin gain)))) | |
| 349 | (setf thestring | |
| 350 | (cond ((equal mode "parallel") | |
| 351 | (format nil "echo ~d ~d" (db->lin input-gain) (db->lin output-gain))) | |
| 352 | ((equal mode "serial") | |
| 353 | (format nil "echos ~d ~d" (db->lin input-gain) (db->lin output-gain))))) | |
| 354 | (loop for tim in times do | |
| 355 | for lev in levels do | |
| 356 | (setf thestring (concatenate 'string thestring (format nil " ~d ~d" tim lev )))) | |
| 357 | ||
| 358 | (setf thestring (sox-concat sox-append thestring)) | |
| 359 | thestring)) | |
| 360 | ||
| 361 | ||
| 362 | ;; Sox-FIR ========================================================= | |
| 363 | ||
| 364 | (defmethod! sox-fir ((coefficients list) &key sox-append) | |
| 365 | :icon 10 | |
| 366 | :initvals '(nil nil) | |
| 367 | :indoc (list "Path to coefficients-file or list of coefficients" *sox-append-doc*) | |
| 368 | :doc "Use SoXs FFT convolution engine with given FIR filter coefficients." | |
| 369 | (let* ((thestring (format nil " fir "))) | |
| 370 | (setf thestring (string+ thestring (reduce #'(lambda (s1 s2) (format nil "~d ~d " s1 s2)) coefficients))) | |
| 371 | (sox-concat sox-append thestring) | |
| 372 | )) | |
| 373 | ||
| 374 | (defmethod! sox-fir ((coefficients bpf) &key sox-append) | |
| 375 | (sox-fir (y-points coefficients) :sox-append sox-append)) | |
| 376 | ||
| 377 | (defmethod! sox-fir ((coefficients pathname) &key sox-append) | |
| 378 | (let* ((thestring (format nil " fir ~s" (namestring coefficients)))) | |
| 379 | (add-tmp-file coefficients) | |
| 380 | (sox-concat sox-append thestring) | |
| 381 | )) | |
| 382 | ||
| 383 | ||
| 384 | ; this function might or should be called from within sox-fir (always a text file) | |
| 385 | ; could be optimized by writing using a file-pointer rather than making an object. | |
| 386 | (defmethod! coeffs->textfile ((coeffs list) &optional filename) | |
| 387 | :icon 203 | |
| 388 | :initvals '(nil nil) | |
| 389 | ||
| 390 | (let ((mytextfile (make-instance 'textfile :ed-mode "append" :eval-mode "text" )) | |
| 391 | (outfile (handle-new-file-exists | |
| 392 | (or (and filename (pathnamep filename)) | |
| 393 | (unique-pathname *om-outfiles-folder* "sox-tempcoeffs" "txt"))))) | |
| 394 | ; (om-make-pathname :directory *om-outfiles-folder* :name "sox-tempcoeffs" :type "txt"))))) | |
| 395 | (setf (exp-list mytextfile) coeffs) | |
| 396 | (save-data mytextfile outfile) | |
| 397 | outfile | |
| 398 | )) | |
| 399 | ||
| 400 | ||
| 401 | (defmethod! coeffs->textfile ((coeffs bpf) &optional filename) | |
| 402 | (coeffs->textfile (y-points coeffs) filename)) | |
| 403 | ||
| 404 | ||
| 405 | ; perhaps this duration should rather be in seconds than in samples | |
| 406 | ||
| 407 | (defparameter *sox-convolve-max-samples* 65535) ; max num of samples = 65535 empirically determined (2^16-1) | |
| 408 | *sox-convolve-max-samples* | |
| 409 | ||
| 410 | (defmethod! sox-convolve ((IR sound) &key gain channel clipping amp-env padding) | |
| 411 | :icon 40 | |
| 412 | :initvals '(nil nil nil nil nil nil) | |
| 413 | :indoc (list "Impulse Response" "Gain" "Channel to use from Impulse Response File" "Amplitude-Envelope for Impulse Response" "Padding before and after convolution" *sox-append-doc*) | |
| 414 | :doc "Use SoXs FFT convolution engine for convolution with impulse response files. | |
| 415 | ||
| 416 | <gain> allows to set the gain for the convolution. | |
| 417 | <channel> allows to select the channel used for the convolutoin. | |
| 418 | <clipping> allows to clip the impulse response to a certain range (list). To specify clipping in samples add an \"s\" to the end of the numbers, e.g. (0s 13256s). | |
| 419 | <amp-env> allows to apply an amplitude envelope to the impulse response before convolution. | |
| 420 | <padding> allows to add silence to the beginning (pre-delay) and end of input audio (for the reverb tail). If not supplied get calculated automatically as: predelay=IRsamples/2*SR, tail:IRsamples" | |
| 421 | ||
| 422 | (if (and (not (integerp channel)) (> (sox-sound-channels IR) 1)) | |
| 423 | (progn (om-beep-msg "WARNING: Please specify channel used for convolution kernel.") (om-abort)) | |
| 424 | (let* ((sound-samples (sox-sound-samples IR)) | |
| 425 | (sound-sr (sox-sound-sr IR)) | |
| 426 | (clipping-in-samples (if clipping | |
| 427 | (cond ((symbolp (first clipping)) | |
| 428 | (list | |
| 429 | (string-to-number (string-until-char (symbol-to-string (first clipping)) "s")) | |
| 430 | (string-to-number (string-until-char (symbol-to-string (second clipping)) "s")) | |
| 431 | )) | |
| 432 | ((stringp (first clipping)) | |
| 433 | (list | |
| 434 | (string-to-number (string-until-char (first clipping) "s")) | |
| 435 | (string-to-number (string-until-char (second clipping) "s")) | |
| 436 | )) | |
| 437 | ((numberp (first clipping)) | |
| 438 | (om-round (sec->samples clipping sound-sr)))) | |
| 439 | (list 0 (sox-sound-samples IR)))) | |
| 440 | (samples (or (- (second clipping-in-samples) (first clipping-in-samples)) sound-samples)) | |
| 441 | ||
| 442 | (maxsamples (min samples sound-samples *sox-convolve-max-samples*)) | |
| 443 | ;thesamples is a list | |
| 444 | (thesamples (if (> samples maxsamples) | |
| 445 | (progn | |
| 446 | (om-beep-msg (format nil "Too many samples. Convolution kernel is truncated to ~d samples (max. number of samples)." maxsamples)) | |
| 447 | ;truncate from end of Impulse Response | |
| 448 | (list (first clipping-in-samples) (+ (first clipping-in-samples) *sox-convolve-max-samples*))) | |
| 449 | clipping-in-samples)) | |
| 450 | ||
| 451 | (thecoefficients (second (mat-trans (sox-sound-samplevalues IR :channel channel | |
| 452 | :clipping (list (format nil "~ds" (first thesamples)) | |
| 453 | (format nil "~ds" (second thesamples))))))) | |
| 454 | (scaledcoefficients (if amp-env | |
| 455 | ; this should rather coerce to single-float instead of rounding | |
| 456 | (om-round (om* thecoefficients (third (multiple-value-list (om-sample amp-env maxsamples)))) 20) | |
| 457 | thecoefficients)) | |
| 458 | (thecomplevel (or gain (compensate-fir-gain scaledcoefficients))) | |
| 459 | (thecoeffsfile (coeffs->textfile scaledcoefficients))) | |
| 460 | ||
| 461 | (if padding | |
| 462 | (sox-level thecomplevel | |
| 463 | :sox-append (sox-pad padding :sox-append | |
| 464 | (sox-fir thecoeffsfile))) | |
| 465 | (sox-level thecomplevel ; when no params supplied, the pre-delay and padding are calculated automatically. | |
| 466 | :sox-append (sox-pad (list ;(sox-float-to-string (om-round (/ (- maxsamples 1) (* 2 sound-sr)) 10)) | |
| 467 | (sox-float-to-string (/ (- maxsamples 1) (* 2 sound-sr))) | |
| 468 | (sox-float-to-string (samples->sec maxsamples sound-sr))) :sox-append | |
| 469 | (sox-fir thecoeffsfile)))) | |
| 470 | ))) | |
| 471 | ||
| 472 | ||
| 473 | ||
| 474 | ; this is a kind of exceptional 'hack' (inconsistent with the polymorphism of OM-SoX) as a list of sounds is going to produce a list of sox-convoles | |
| 475 | (defmethod! sox-convolve ((IR list) &key gain channel clipping amp-env padding) | |
| 476 | (mapcar (lambda (thesound) | |
| 477 | (sox-convolve thesound :gain gain :channel channel :clipping clipping :amp-env amp-env :padding padding)) IR) | |
| 478 | ) | |
