;;; -*- syntax: common-lisp; base: 10; mode: lisp -*-
;;;
;;; several examples of the convolve unit generator

(definstrument cnv (beg dur filter file &optional (amp 1.0) (chan 0))
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (fil (open-input file :channel chan))
	 (filt (open-input filter))
	 (ff (make-convolve :input fil :filter filt)))
    (run
     (loop for i from start to end do (outa i (* amp (convolve ff)))))
    (close-input filt)
    (close-input fil)))

#|
(with-sound (:output "/zap/1.snd") (outa 0 .5) (outa 3000 .5) (outa 10000 .5))
(with-sound (:output "/zap/v.snd") (fm-violin 0 1 440 .1 :amp-env '(0 1 100 1)))
(with-sound (:statistics t) (cnv 0 1 "/zap/1.snd" "/zap/v.snd"))
(with-sound (:statistics t) (cnv 0 6 "fyow.snd" "fyow.snd" .1))
|#

(definstrument cnvo (beg dur filter file &optional (size 512))
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (fil (open-input file))
	 (filt (make-double-float-array (length filter) :initial-contents filter))
	 (ff (make-convolve :input fil :filter filt :fft-size size)))
    (run
     (loop for i from start to end do (outa i (convolve ff))))
    (close-input fil)))

#|
(with-sound (:statistics t) (cnvo 0 1 '(.5 .2 .1 .05 0 0 0 0) "/zap/v.snd" 64))
|#

;;; reverberation via convolution with exponentially decaying Gaussian white noise,
;;;   this kind of reverb was recommended many years ago by J.A.Moorer in
;;;   "About this Reverberation Business" reprinted in "Foundations of Computer Music".

(defvar last-decay-time 0.0)
(defvar last-decay-expt 0.0)
(defvar decay-file "/zap/decay.snd")

(definstrument cnv-reverb (beg dur &key (rev-amt .1) (decay-time 1.0) (decay-expt 32.0))
  ;; this performs the convolution as one huge fft operation
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (reverb-file *input*)
	 (len (floor (* *srate* decay-time)))
	 (start-samp (floor (* .022 *srate*))))
    (when (or (/= last-decay-time decay-time)
	      (/= last-decay-expt decay-expt))
      (princ "creating impulse response...") (force-output)
      (let* ((fe (make-env :envelope '(0 1 100 0) :start start-samp :end len :scaler .1 :base decay-expt))
	     (ofile (open-output decay-file)))
	(setf last-decay-time decay-time)
	(setf last-decay-expt decay-expt)
	(outa (floor (* .01 *srate*)) .2 ofile)
	(outa (floor (* .014 *srate*)) .15 ofile)
	(outa (floor (* .02 *srate*)) .12 ofile)
	(loop for i from start-samp below len do
	  (let ((sum 0.0))
	    (dotimes (i 10) (incf sum (- (random .4) .2))) 
	    ;;Gaussian noise -- 0 centered much better than pure positive case
	    (outa i (* (env fe) sum) ofile)))
	(close-output ofile))
	(print "done!") (force-output))
    (let* ((ifile (open-input decay-file))
	   (ff (make-convolve :input reverb-file :filter ifile)))
      (run
       (loop for i from start to end do (outa i (* rev-amt (convolve ff)))))
      (close-input ifile))))

#|
(with-sound (:reverb cnv-reverb :statistics t) (fm-violin 0 .1 440 .1 :reverb-amount .1) (fm-violin 2 .1 660 .1 :reverb-amount .05))
|#

;;; similar but use an array to hold the impulse response (and therefore use overlap-add internally --
;;;   this is less sensitive to memory limitations than the cnv-reverb above).

(definstrument cnvrev (file impulse &optional (rev-amt .1))
  (let* ((file-len (sound-frames file))
	 (filter-len (sound-frames impulse))
	 (filter-chan0 (make-double-float-array filter-len))
	 (filter-chan1 (if (and (= (mus-channels *output*) 2) (> (sound-chans impulse) 1))
			   (make-double-float-array filter-len))))
    (file->array impulse 0 0 filter-len filter-chan0)
    (if filter-chan1
	(file->array impulse 1 0 filter-len filter-chan1)
      (setf filter-chan1 filter-chan0))
    (let* ((fd (open-input file))
	   (fd1 (if (and (= (mus-channels *output*) 2) (> (sound-chans file) 1)) (open-input file :channel 1)))
	   (ff0 (make-convolve :input fd :filter filter-chan0))
	   (ff1 (if (and (= (mus-channels *output*) 2) (> (sound-chans file) 1))
		    (make-convolve :input fd1 :filter filter-chan1))))
      (run
       (loop for i from 0 to (+ file-len filter-len) do
	 (outa i (* rev-amt (convolve ff0)))
	 (if (and (= (mus-channels *output*) 2) ff1) (outb i (* rev-amt (convolve ff1))))))
      (close-input fd)
      (if fd1 (close-input fd1)))))

;;; (with-sound (:statistics t :scaled-to .5 :srate 44100 :channels 2) (cnvrev "fy.snd" "fyow.snd"))