; ********************************************************************
; OM-SoX, (c) 2011-2014 Marlon Schumacher (CIRMMT/McGill University) *
;           http://sourceforge.net/projects/omsox/                   *
;                                                                    *
;  Multichannel Audio Manipulation and Functional Batch Processing.  *
;       DSP based on SoX - (c) C.Bagwell and Contributors            *
;               http://sox.sourceforge.net/                          *
; ********************************************************************
;
;This program is free software; you can redistribute it and/or
;modify it under the terms of the GNU General Public License
;as published by the Free Software Foundation; either version 2
;of the License, or (at your option) any later version.
;
;See file LICENSE for further informations on licensing terms.
;
;This program is distributed in the hope that it will be useful,
;but WITHOUT ANY WARRANTY; without even the implied warranty of
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;GNU General Public License for more details.
;
;You should have received a copy of the GNU General Public License
;along with this program; if not, write to the Free Software
;Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307,10 USA.
;
;Authors: M. Schumacher

(in-package :om)

;; Sox-Biquad ================================================================

(defmethod! sox-biquad ((b0 number) (b1 number) (b2 number) (a0 number) (a1 number) (a2 number) &key sox-append) 
  :icon 10
  :initvals '(nil nil nil nil nil nil nil)
  :indoc (list "b0" "b1" "b2" "a0" "a1" "a2" *sox-append-doc*)
  :doc "Apply a biquad RBJ IIR filter with the given coefficients (where a0=1)."  

    (setf thestring (format nil "biquad ~d ~d ~d ~d ~d ~d" b0 b1 b2 a0 a1 a2))
    (sox-concat sox-append thestring)
    )

;; Sox-Biquad ================================================================

(defmethod! sox-hilbert ((taps number) &key sox-append) 
  :icon 10
  :initvals '(32767 nil)
  :indoc (list "number of taps (must be an odd number between 3 and 32767)" *sox-append-doc*)
  :doc "Apply a Hilbert transform FIR filter."  

    (setf thestring (format nil "hilbert -n ~d" taps))
    (sox-concat sox-append thestring)
    )

; Sox-sinc ==================================================


(defmethod! sox-sinc ((mode string) (Low-Boundary number) (High-Boundary number) &key attenuation transition-bandwidth filter-taps kaiser-beta sox-append) 
  :icon 10
  :initvals '("bandpass" 0 20000 120 nil nil nil nil)
  :menuins (list (list 0 *sox-filter-types*))
  :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)" 
               "Transition bandwidth (in Hz)" "Number of filter taps" "Beta value for Kaiser window" *sox-append-doc*)
  :doc "Apply a sinc kaiser-windowed low-pass, high-pass, band-pass, or band-reject FIR filter with 120dB stopband attenuation.

The default stop-band attenuation of 120dB can be overridden via <attenuation>.
Alternatively, the kaiser-window 'beta' parameter can be given directly via <kaiser-beta>.
The default transition band-width of 5% of the total band can be overridden with <transition-bandwidth> (in Hz).
Alternatively, the number of filter taps can be given directly via <filter-taps>.
"
  
  (let* (
         (thestring (format nil " sinc")))
    (cond (attenuation (setf thestring (string+ thestring (format nil " -a ~d" (clip attenuation 40 180)))))
          (kaiser-beta (setf thestring (string+ thestring (format nil " -b ~d" kaiser-beta)))))
    (cond (transition-bandwidth (setf thestring (string+ thestring (format nil " -t ~d" transition-bandwidth))))
          (filter-taps (setf thestring (string+ thestring (format nil " -n ~d" filter-taps)))))
    (cond
     ((equal mode "bandpass")
      (setf thestring (concatenate 'string thestring
                                   (format nil " ~d-~d " Low-Boundary High-Boundary))))
     ((equal mode "bandreject")
      (setf thestring (concatenate 'string thestring
                                   (format nil " ~d-~d " High-Boundary Low-Boundary))))
     ((equal mode "lowpass")
      (setf thestring (concatenate 'string thestring
                                   (format nil " -~d " Low-Boundary))))
     ((equal mode "highpass")
      (setf thestring (concatenate 'string thestring
                                   (format nil " ~d " High-Boundary)))))
 
      (sox-concat sox-append thestring))
  )

(defmethod! sox-band-fft ((mode string) (center-freq number) (bandwidth number) &key attenuation transition-bandwidth filter-taps kaiser-beta sox-append)
            :icon 10
            :initvals '("bandpass" 1000 100 120 nil nil nil nil)
            :menuins (list (list 0 (list (list "bandpass" "bandpass") (list "bandreject" "bandreject"))))
            (sox-sinc mode (om-clip (- center-freq (* 0.5 bandwidth)) 0 nil) (+ center-freq (* 0.5 bandwidth)) 
                      :attenuation attenuation 
                      :transition-bandwidth transition-bandwidth
                      :filter-taps filter-taps
                      :kaiser-beta kaiser-beta
                      :sox-append sox-append
                      )
            )



;; Sox-Bandfilter ==================================================

(defmethod! sox-band ((frequency number) (bandwidth number) (mode string) &key unit sox-append) 
  :icon 10
  :initvals '(1000 100 "bandpass" "Hz" nil)
  :menuins (list (list 2 (list (list "bandpass" "bandpass") (list "bandreject" "bandreject") (list "SPKit resonator (normal)" "band") (list "SPKit resonator (noise)" "band -n"))) 
                 (list 3 *sox-unit-menu*)) 
  :indoc (list "Center-frequency (Hz)" "Filter-bandwidth" "Bandpass, Bandreject, SPKit resonator (normal), SPKit resonator (noise)" *sox-unit-doc* *sox-append-doc*)
  :doc "Apply a band-filter with center frequency <frequency> and 3dB-point bandwidth <bandwidth>.

Available modes are (two-pole) Butterworth bandpass/bandreject or SPKit resonator bandpass (normal and noise)."
  
  (let* (
         (thestring (format nil "~a ~d ~d" mode frequency bandwidth)))
    (when unit
      (setf thestring (sox-units thestring unit)))
    (sox-concat sox-append thestring))
  )


;; Sox-1pole ================================================================

(defmethod! sox-1pole ((frequency number) (mode string) &key sox-append) 
  :icon 10
  :initvals '(nil "lowpass" nil)
  :menuins '((1 (("lowpass" "lowpass") ("highpass" "highpass"))))
  :indoc (list "Cutoff-Frequency (Hz)" "Filter mode (highpass/lowpass)" *sox-append-doc*)
  :doc "A 1-pole RBJ high-/lowpass-filter."  

    (setf thestring
          (cond   ((equal mode "highpass")
                   (format nil "~a -1 ~d" mode frequency))
                  ((equal mode "lowpass")
                   (format nil "~a -1 ~d" mode frequency))))
    (sox-concat sox-append thestring)
    )

;; Sox-2pole ================================================================

(defmethod! sox-2pole ((frequency number) (width number) (mode string) &key unit sox-append) 
  :icon 10
  :initvals '(1000 nil "lowpass" "Hz" nil)
  :menuins (list (list 2 *sox-filter-types-all*) (list 3 *sox-unit-menu*))
  :indoc (list "Filter frequency (Hz)" "Filter width (default unit: Hz)" "Mode: Bandpass or Bandreject" *sox-unit-doc* *sox-append-doc*)
  :doc "A 2-pole RBJ lowpass, highpass, band-pass or band-reject filter with frequency <frequency> and bandwidth <width>."  

    (setf thestring
          (cond ((equal mode "allpass")
                 (format nil "~a ~d ~d" mode frequency width))
                ((equal mode "highpass")
                 (format nil "~a -2 ~d ~d" mode frequency width))
                ((equal mode "lowpass")
                 (format nil "~a -2 ~d ~d" mode frequency width))
                ((equal mode "bandpass")
                 (format nil "~a ~d ~d" mode frequency width))
                ((equal mode "bandreject")
                 (format nil "~a ~d ~d" mode frequency width))))
      (setf thestring (sox-units thestring unit))
    (sox-concat sox-append thestring)
    )


;;; Sox-Shelving ==================================================

(defmethod! sox-shelving-eq ((mode string) (frequency number) (width number) (gain number) &key unit sox-append) 
  :icon 10
  :initvals '("bass" nil nil 6 "Hz" nil)
  :menuins (list (list 0 (list (list "bass" "bass") (list "treble" "treble"))) (list 4  *sox-unit-menu*))
  :indoc (list "Mode: bass/treble" "Frequency (Hz)" "Width (default unit: Hz)" "Gain (dB)" *sox-unit-doc* *sox-append-doc*)
  :doc "Apply a two-pole shevling filter to boost or cut the bass (lower) or treble (higher) frequencies of the audio."  
  (let* (
         (thestring (format nil "~a ~d" mode gain)))
      (setf thestring (concatenate 'string thestring
                                   (format nil " ~d ~d" frequency width)))
      (setf thestring (sox-units thestring unit))
      (sox-concat sox-append thestring))
  )


;;; Sox-EQ =================================================

(defmethod! sox-peak-eq ((frequency number) (bandwidth number) (gain number) &key unit sox-append) 
  :icon 10
  :initvals '(1000 100 -12 "Hz" nil)
  :menuins (list (list 3 *sox-unit-menu*)) 

  :indoc (list "Frequency (in Hz)" "Bandwidth (default unit: Hz)" "Gain in dB" *sox-unit-doc* *sox-append-doc*)
  :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."  

  (let* ((thestring (format nil "equalizer ~d ~d" frequency bandwidth)))
    (setf thestring (sox-units thestring unit))
    (setf thestring (concatenate 'string thestring (format nil " ~d" gain)))
    (sox-concat sox-append thestring))
  )


;;; Sox-Shelf-EQ ===================================

(defmethod! sox-shelf-eq ((mode string) (frequency number) (bandwidth number) (gain number) &key unit sox-append) 
  :icon 10
  :initvals '("bass" 1000 100 6 "Hz" nil)
  :menuins '((0 (("low-shelf" "bass") ("high-shelf" "treble"))) 
             (4 (("Hz" "Hz") ("kHz" "kHz") ("Octaves" "Octaves") ("Q-factor" "Q-factor") ("Slope" "Slope"))))
  :indoc (list "low-shelf, high-shelf" "Frequency" "Bandwidth (default unit: Hz)" "Gain (in dB)" *sox-unit-doc* *sox-append-doc*)
  :doc "Equalize the audio using high- or low-shelf filter."

      (setf thestring (format nil " ~a ~d ~d ~d" mode gain frequency bandwidth))
      (setf thestring (sox-units thestring unit))

  (sox-concat sox-append thestring)
  )

;;; Sox-Equalizer ==================================

; this one 'includes' the above sox-peak-eq
(defmethod! sox-equalizer ((mode string) (frequency number) (bandwidth number) (gain number) &key unit sox-append) 
  :icon 10
  :initvals '("bass" 1000 100 6 "Hz" nil)
  :menuins '((0 (("low-shelf" "bass") ("high-shelf" "treble") ("peak" "peak"))) 
             (4 (("Hz" "Hz") ("kHz" "kHz") ("Octaves" "Octaves") ("Q-factor" "Q-factor") ("Slope" "Slope"))))
  :indoc (list "low-shelf, high-shelf, peak" "Frequency" "Bandwidth (default unit: Hz)" "Gain (in dB)" *sox-unit-doc* *sox-append-doc*)
  :doc "Equalize the audio using high/low-shelf or peak filters."
  (if (equal mode "peak")
      (progn
        (setf thestring (format nil " equalizer ~d ~d" frequency bandwidth))
        (setf thestring (sox-units thestring unit))    
        (setf thestring (concatenate 'string thestring (format nil " ~d" gain))))
    (progn
      (setf thestring (format nil " ~a ~d ~d ~d" mode gain frequency bandwidth))
      (setf thestring (sox-units thestring unit))))

  (sox-concat sox-append thestring)
  )

; Sox-Bandpass ====================================================

(defmethod! sox-bandpass ((frequency number) (bandwidth number) (mode string) &key unit sox-append) 
  :icon 10
  :initvals '(1000 100 "normal" "Hz" nil)
  :menuins (list (list 2 (list (list "normal" "normal") (list "noise" "noise"))) (list 3 *sox-unit-menu*))
  :indoc (list "Cutoff-Frequency (in Hz)" "Bandwidth Hz" "Filtermode (normal/noisy)" *sox-unit-doc* *sox-append-doc*)
  :doc "Apply a SPKit resonator band-pass IIR filter."  

    (setf thestring
          (cond   ((equal mode "normal")
                   (format nil " band ~d ~d" frequency bandwidth))
                  ((equal mode "noise")
                   (format nil " band -n ~d ~d" frequency bandwidth))))
    (setf thestring (sox-units thestring unit))

    (sox-concat sox-append thestring)
    )


;;; Sox-Highpass ==================================================

; sox-unit should go into all the filter/effects using different units

(defmethod! sox-highpass ((cutoff-frequency number) (width number) (poles string) &key (unit "Hz") sox-append) 
  :icon 10
  :initvals '(10 100 "onepole" "Hz" nil)
  :menuins (list (list 2 (list (list "onepole" "onepole") (list "twopole" "twopole"))) (list 3 *sox-unit-menu*)) 
  :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*)
  :doc "Apply a high-pass filter to the audio.

Optional single-pole or double-pole filtering. 
A value of Q = 0.707 for <width> yields a Butterworth response." 
 
  (let* (
         (thestring (format nil "highpass")))
    (if (equal poles "onepole")
        (progn
          (setf thestring (concatenate 'string thestring
                                       (format nil " -1 ~d" cutoff-frequency)))
          (sox-concat sox-append thestring))
      (progn
        (setf thestring (concatenate 'string thestring
                                     (format nil " -2 ~d ~d" cutoff-frequency width)))
        (sox-concat sox-append (sox-units thestring unit)))
      )
    )
  )

;;; Sox-Lowpass  ==================================================

(defmethod! sox-lowpass ((cutoff-frequency number) (width number) (poles string) &key unit sox-append) 
  :icon 10
  :initvals '(1000 100 "onepole" "Hz" nil)
  :menuins (list (list 2 (list (list "onepole" "onepole") (list "twopole" "twopole"))) (list 3 *sox-unit-menu*))
  :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*)
  :doc "Apply a low-pass filter to the audio.

Optional single-pole or double-pole filtering. 
A value of Q = 0.707 for 'width' yields a Butterworth response."
  
  (let* (
         (thestring (format nil " lowpass ")))
    (if (equal poles "onepole")
        (setf thestring (concatenate 'string thestring
                                     (format nil " -1 ~d " cutoff-frequency)))
      (progn
        (setf thestring (concatenate 'string thestring
                                   (format nil " -2 ~d ~d" cutoff-frequency width)))
        (setf thestring (sox-units thestring unit))
        ))
    (sox-concat sox-append thestring))
  )

;;; Sox-Allpass ==================================================

(defmethod! sox-allpass ((frequency number) (width number) &key (unit "Hz") sox-append) 
  :icon 10
  :initvals '(1000 100 "Hz" nil)
  :menuins (list (list 2 *sox-unit-menu*)) 
  :indoc (list "Frequency (Hz)" "Width (default unit: Hz)" *sox-unit-doc* *sox-append-doc* )
  :doc "Apply a two-pole all-pass filter with frequency <frequency> and width <width>."
  
  (let* (
         (thestring (format nil "allpass ~d ~d" frequency width)))
    (setf thestring (sox-units thestring unit))         
    (sox-concat sox-append thestring))
  )


;;; Sox-Comb ==================================================

(defmethod! sox-comb ((frequency t) (gain t) &key (mode "serial") (input-gain 0) (output-gain 0) sox-append) ; (polarity symbol)
; polarity doesn't work as it's mixed internally
            :icon 10
            :initvals '(1000 0 "parallel" 0 0 nil)
            :menuins '((2 (("parallel" "parallel") ("serial" "serial"))))
            :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*)
            :doc "Apply a comb-filter to the audio.

<frequency> is the frequency of the filter (Hz).
<gain> is a list of levels (in dB) for the successive taps.
<mode> specifies whether the taps are produced in parallel ('parallel') or fed back into the input ('serial').
"
            (let ((times (loop for item in (list! frequency) collect (float (om/ 1000 item))))
                  (levels (list! (db->lin gain))))
              (setf thestring 
                    (cond ((equal mode "parallel")
                           (format nil "echo ~d ~d" (db->lin input-gain) (db->lin output-gain)))
                          ((equal mode "serial")
                           (format nil "echos ~d ~d" (db->lin input-gain) (db->lin output-gain)))))
              (loop for tim in times do
                    for lev in levels do            
                    (setf thestring (concatenate 'string thestring (format nil " ~d ~d" tim lev ))))

              (setf thestring (sox-concat sox-append thestring))
            thestring))


;; Sox-FIR =========================================================

(defmethod! sox-fir ((coefficients list) &key sox-append) 
  :icon 10
  :initvals '(nil nil)
  :indoc (list "Path to coefficients-file or list of coefficients" *sox-append-doc*)
  :doc "Use SoXs FFT convolution engine with given FIR filter coefficients."  
  (let* ((thestring (format nil " fir ")))
    (setf thestring (string+ thestring (reduce #'(lambda (s1 s2) (format nil "~d ~d " s1 s2)) coefficients)))            
    (sox-concat sox-append thestring)                
    ))

(defmethod! sox-fir ((coefficients bpf) &key sox-append) 
            (sox-fir (y-points coefficients) :sox-append sox-append))

(defmethod! sox-fir ((coefficients pathname) &key sox-append) 
  (let* ((thestring (format nil " fir ~s" (namestring coefficients))))
    (add-tmp-file coefficients)
    (sox-concat sox-append thestring)
    ))


; this function might or should be called from within sox-fir (always a text file)
; could be optimized by writing using a file-pointer rather than making an object.
(defmethod! coeffs->textfile ((coeffs list) &optional filename)
            :icon 203
            :initvals '(nil nil)
            
            (let ((mytextfile (make-instance 'textfile :ed-mode "append" :eval-mode "text" ))
                  (outfile (handle-new-file-exists 
                            (or (and filename (pathnamep filename))
                                (unique-pathname *om-outfiles-folder* "sox-tempcoeffs" "txt")))))
                               ; (om-make-pathname :directory *om-outfiles-folder* :name "sox-tempcoeffs" :type "txt")))))              
              (setf (exp-list mytextfile) coeffs)
              (save-data mytextfile outfile)
              outfile
            ))


(defmethod! coeffs->textfile ((coeffs bpf) &optional filename)
            (coeffs->textfile (y-points coeffs) filename))


; perhaps this duration should rather be in seconds than in samples

(defparameter *sox-convolve-max-samples* 65535) ; max num of samples = 65535 empirically determined (2^16-1)
*sox-convolve-max-samples*

(defmethod! sox-convolve ((IR sound) &key gain channel clipping amp-env padding)
            :icon 40
            :initvals '(nil nil nil nil nil nil)
            :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*)
            :doc "Use SoXs FFT convolution engine for convolution with impulse response files.

<gain> allows to set the gain for the convolution.
<channel> allows to select the channel used for the convolutoin.
<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).
<amp-env> allows to apply an amplitude envelope to the impulse response before convolution.
<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"  

            (if (and (not (integerp channel)) (> (sox-sound-channels IR) 1)) 
                (progn (om-beep-msg "WARNING: Please specify channel used for convolution kernel.") (om-abort))
            (let* ((sound-samples (sox-sound-samples IR)) 
                   (sound-sr (sox-sound-sr IR))
                   (clipping-in-samples (if clipping
                                            (cond ((symbolp (first clipping)) 
                                                   (list
                                                    (string-to-number (string-until-char (symbol-to-string (first clipping)) "s"))
                                                    (string-to-number (string-until-char (symbol-to-string (second clipping)) "s")) 
                                                    ))
                                                  ((stringp (first clipping))
                                                   (list
                                                    (string-to-number (string-until-char (first clipping) "s"))
                                                    (string-to-number (string-until-char (second clipping) "s")) 
                                                    ))
                                                  ((numberp (first clipping))
                                                   (om-round (sec->samples clipping sound-sr))))
                                             (list 0 (sox-sound-samples IR))))
                   (samples (or (- (second clipping-in-samples) (first clipping-in-samples)) sound-samples))
                   
                   (maxsamples (min samples sound-samples *sox-convolve-max-samples*))                  
                   ;thesamples is a list
                   (thesamples (if (> samples maxsamples)
                                   (progn 
                                     (om-beep-msg (format nil "Too many samples. Convolution kernel is truncated to ~d samples (max. number of samples)." maxsamples)) 
                                     ;truncate from end of Impulse Response
                                     (list (first clipping-in-samples) (+ (first clipping-in-samples) *sox-convolve-max-samples*)))
                                 clipping-in-samples))

                   (thecoefficients (second (mat-trans (sox-sound-samplevalues IR :channel channel 
                                                                               :clipping (list (format nil "~ds" (first thesamples)) 
                                                                                               (format nil "~ds" (second thesamples)))))))
                   (scaledcoefficients (if amp-env 
                                           ; this should rather coerce to single-float instead of rounding
                                           (om-round (om* thecoefficients (third (multiple-value-list (om-sample amp-env maxsamples)))) 20) 
                                         thecoefficients))
                   (thecomplevel (or gain (compensate-fir-gain scaledcoefficients)))
                   (thecoeffsfile (coeffs->textfile scaledcoefficients)))
           
              (if padding
                  (sox-level thecomplevel 
                             :sox-append (sox-pad padding :sox-append
                                                  (sox-fir thecoeffsfile)))
                (sox-level thecomplevel ; when no params supplied, the pre-delay and padding are calculated automatically.
                           :sox-append (sox-pad (list ;(sox-float-to-string (om-round (/ (- maxsamples 1) (* 2 sound-sr)) 10)) 
                                                      (sox-float-to-string (/ (- maxsamples 1) (* 2 sound-sr)))
                                                      (sox-float-to-string (samples->sec maxsamples sound-sr))) :sox-append
                                                (sox-fir thecoeffsfile))))
              )))



; 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 
(defmethod! sox-convolve ((IR list) &key gain channel clipping amp-env padding)
            (mapcar (lambda (thesound)
                      (sox-convolve thesound :gain gain :channel channel :clipping clipping :amp-env amp-env :padding padding)) IR)
            )