;;; -*- syntax: common-lisp; base: 10; mode: lisp -*-

(definstrument jl-reverb
  (start-time duration
	      &key (low-pass nil) 
	      (volume 1.0)
	      (double nil)
	      (delay1 .013) 
	      (delay2 .011)
	      (delay3 .015)
	      (delay4 .017)
	      (amp-env nil))
  (let* ((allpass1 (make-all-pass -0.700 0.700 2111))
	 (allpass2 (make-all-pass -0.700 0.700  673))
	 (allpass3 (make-all-pass -0.700 0.700  223))
	 (comb1 (make-comb 0.742 9601))
	 (comb2 (make-comb 0.733 10007))
	 (comb3 (make-comb 0.715 10799))
	 (comb4 (make-comb 0.697 11597))
	 (chan2 (> (mus-channels *output*) 1))
	 (chan4 (= (mus-channels *output*) 4))
	 (outdel1 (make-delay (* delay1 *srate*)))
	 (outdel2 (if chan2 (make-delay (* delay2 *srate*))))
	 (outdel3 (if (or double chan4) (make-delay (* delay3 *srate*))))
	 (outdel4 (if (or chan4 (and double chan2)) (make-delay (* delay4 *srate*))))
	 (allpass-sum 0.0)
	 (comb-sum 0.0)
	 (comb-sum-1 0.0)
	 (comb-sum-2 0.0)
	 (all-sums 0.0)
	 (delA 0.0)
	 (delB 0.0)
	 (envA (if amp-env (make-env :envelope amp-env :scaler volume :duration duration)))
	 (vol volume)
	 (beg (floor (* start-time *srate*)))
	 (end (+ beg (floor (* duration *srate*)))))
    (if (and double chan4) (warn "jc-reverb is not set up for doubled reverb in quad"))
    (run
     (loop for i from beg to end do
       (setf allpass-sum (all-pass allpass3
				   (all-pass allpass2
					     (all-pass allpass1 (ina i *reverb*)))))
       (setf comb-sum-2 comb-sum-1)
       (setf comb-sum-1 comb-sum)
       (setf comb-sum 
	 (+ (comb comb1 allpass-sum)
	    (comb comb2 allpass-sum)
	    (comb comb3 allpass-sum)
	    (comb comb4 allpass-sum)))
       (if low-pass
	   (setf all-sums (+ (* .25 (+ comb-sum comb-sum-2)) (* .5 comb-sum-1)))
	 (setf all-sums comb-sum))
       ;; "modified least squares low pass filter"
       (setf delA (delay outdel1 all-sums))
       (if double (incf delA (delay outdel3 all-sums)))
       (if envA (setf vol (env envA)))
       (outa i (* vol delA))
       (when chan2
	 (setf delB (delay outdel2 all-sums))
	 (if double (incf delB (delay outdel4 all-sums)))
	 (outb i (* vol delB))
	 (when chan4
	   (outc i (* vol (delay outdel3 all-sums)))
	   (outd i (* vol (delay outdel4 all-sums)))))))
    ))
  
