;;; -*- syntax: common-lisp; base: 10; mode: lisp -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; File:             convolve.ins
;;;
;;; Purpose:          Convolution of one sound file by another for
;;;                   cross-synthesis/morphing purposes.  
;;;
;;; Author:           Michael Edwards - m@michael-edwards.org
;;;
;;; $$ Last modified: 14:34:49 Wed Mar 27 2013 GMT
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package :clm)

;;; Bill has now incorporated my constant power panning routine into the CLM
;;; distribution but we'll still need to load it, so change path as required:
(load "/lisp/clm-4/panning.lsp")

(defun get-start-and-end-times (file start end)
  (let ((snd-dur (sound-duration file)))
    (when (> start end)
      (error "Start time > end time? Start = ~a, End = ~a" start end))
    (when (< start 0)
      (error "Start time < 0?  Start = ~a" start))
    (when (> end snd-dur)
      (error "End > file duration?  End = ~a, Duration of file ~a = ~a secs."
             end file snd-dur))
    (list start (if (zerop end) snd-dur end))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(definstrument convins 
  (file1 file2 time &key
        (duration 0)
        (start1 0)
        (end1 0)
        (start2 0)
        (end2 0)
        (amp 1.0)
        (amp-env '(0 1 100 1))
        ;; MDE Wed Mar 27 11:26:11 2013 -- prescaler no longer exists for
        ;; open-input so can't prescale the filter file.  But using amp to
        ;; scale should do us just as well.
        ;; (file2-amp 1.0)
        (degree 45)
        (rev-amt 0)
        (fft-size 128)
        (printing t))
  (let* ((st (floor (* time *srate*)))
         (start-end1 (get-start-and-end-times file1 start1 end1))
         (start-end2 (get-start-and-end-times file2 start2 end2))
         (start-sample1 (floor (* *srate* (first start-end1))))
         (start-sample2 (floor (* *srate* (first start-end2))))
         (stereo-file1 (= 2 (sound-chans file1)))
         (stereo-file2 (= 2 (sound-chans file2)))
         (stereo-out (= 2 (mus-channels *output*)))
         (stereo-reverb (and *reverb* (= 2 (mus-channels *reverb*))))
         (f1L (open-input file1 :start start-sample1))
         (f1R (when stereo-file1
                (open-input file1 :start start-sample1 :channel 1)))
         (f2L (open-input file2 :start start-sample2))
         (f2R (when stereo-file1
                (open-input file2 :start start-sample2
                            :channel (if stereo-file2 1 0))))
         (file1-available-dur (- (second start-end1) (first start-end1)))
         (dur (cond ((zerop duration) file1-available-dur)
                    ((<= duration file1-available-dur) duration)
                    (t (warn "Requested duration longer than available ~
                              duration (using latter): ~a ~a"
                             duration file1-available-dur)
                       file1-available-dur)))
         (ampf (make-env :envelope amp-env :scaler amp 
                         :duration dur))
         ;; get-cpp-scalers comes from panning.lsp in the clm distribution.
         (cpp-scalers (get-cpp-scalers degree))
         (scalerA (first cpp-scalers))
         (scalerB (second cpp-scalers))
         (filter-size (- (floor (* *srate* (second start-end2)))
                         start-sample2))
         (convA (make-convolve :input f1L :filter f2L :fft-size fft-size
                               :filter-size filter-size))
         (convB (when stereo-file1
                  (make-convolve :input f1R :filter f2R :fft-size fft-size
                                 :filter-size filter-size)))
         (count 0)
         (sampA 0.0)
         (sampB 0.0)
         (amp-val 0.0)
         (nd (+ st (floor (* *srate* dur)))))
    (when printing (format t "~&Start time ~a~%" time))
    (run
     (loop for i from st to nd do
           (when (= count *srate*) 
             (setf count 0)
             (print (round (/ i *srate*))))
           (incf count)
           (setf amp-val (env ampf)
                 sampA (* amp-val (convolve convA))
                 sampB (if stereo-file1 
                           (* amp-val (convolve convB))
                         sampA))
           ;; use the constant power panning scalers only with mono input
           (when (and stereo-out (not stereo-file1))
             (setf sampA (* sampA scalerA)
                   sampB (* sampB scalerB)))
           ;; stereo input but mono output
           (when (and stereo-file1 (not stereo-out))
             (setf sampA (/ (+ sampA sampB) 2.0)))
           (outa i sampA)
           (when *reverb*
             (outa i (* rev-amt sampA) *reverb*))
           (when stereo-out
             (outb i sampB)
             (when stereo-reverb
               (outb i (* rev-amt sampB) *reverb*)))))
    (close-input f1L)
    (close-input f2L)
    (when stereo-file1 
      (close-input f1R)
      (close-input f2R))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#|

(with-sound (:statistics t :scaled-to .99) 
  (convins 
   "/snd/samples/slippery/clarinet/bass/bass-fs3-g4-cresc.wav"
   "/snd/samples/slippery/perc/tam-tam-brushes-roll-mp.wav"
   0
   :printing nil
   :amp .1
   :duration 20))

|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; EOF convolve.ins

