
;;; a simple instrument that uses MAKE-ROOMSIG:

(defun remove-duplicates (data)
  (let ((new-data nil)
	(time -1))
    (loop for i in data do
      (if (/= time (round (first i))) (push i new-data))
      (setf time (round (first i))))
    (nreverse new-data)))

(defun sort-data (data)
  (let ((A nil)
	(B nil))
    (loop for i in data do
      (push (list (first i) (third i)) A)
      (push (list (second i) (fourth i)) B))
    (values (sort A #'< :key #'car) (sort B #'< :key #'car))))

(definstrument simp (start-time frq amp rm)
    (multiple-value-bind 
	(A B)
	(sort-data (rmloc-data rm))
      (setf A (remove-duplicates A))
      (setf B (remove-duplicates B))
      (let* ((os (make-oscil :frequency frq))
	     (osfm (make-oscil :frequency frq))
	     (beg (floor (* start-time sampling-rate)))
	     (val 0.0)
	     (tval 0.0)
	     (sum 0.0)
	     (A-total (- (floor (min (first (first A)) (first (first B)))) 3))
	     (B-total A-total)
	     (A-current 0)
	     (B-current 0)
	     (A-len (length A))
	     (B-len (length B))
	     (ampenv (make-env :envelope '(0 0 5 1 25 0 100 0) :scaler amp :duration .5 :start-time start-time))
	     (valA (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valB (make-array B-len :element-type 'short-float :initial-element 0.0))
	     (dlyA (make-array A-len :element-type 'dly))
	     (dlyB (make-array B-len :element-type 'dly))
	     (end (floor (+ beg (* .5 sampling-rate)))))
	(loop for i in A and j in B and k from 0 do
	  (setf (aref valA k) (second i))
 	  (setf A-current (- (round (first i)) A-total))
	  (incf A-total A-current)
	  (setf (aref dlyA k) (make-delay A-current))
	  (setf (aref valB k) (second j))
 	  (setf B-current (- (round (first j)) B-total))
	  (incf B-total B-current)
	  (setf (aref dlyB k) (make-delay B-current)))
	(Run
	 (loop for i from beg to end do
	   (setf val (* (env ampenv) (oscil os (* .1 (oscil osfm)))))
	   (setf sum 0.0)
	   (setf tval val)
	   (dotimes (k A-len)
	     (setf val (delay (aref dlyA k) val))
	     (incf sum (* val (aref valA k))))
	   (outa i sum)
	   (setf sum 0.0)
	   (setf val tval)
	   (dotimes (k B-len)
	     (setf val (delay (aref dlyB k) val))
	     (incf sum (* val (aref valB k))))
	   (outb i sum))))))
	
	
;;; first attempt at head simulation (using comb filters)       

;;; the idea behind all this was: perhaps the ear can tell direction (behind and in front) because
;;; the ears are mounted asymmetrically on a funny shaped box (i.e. your skull) and the echoes
;;; within the skull of sounds coming from different directions are different enough to be a noticeable
;;; timbral effect (the echoes add to become a filter) -- I traced out a skull from an anatomy book
;;; and worked out a bunch of first reflections and managed to convince myself that the resultant
;;; filter looked a lot like the so-called "pinna trransform", and proceeded to build these instruments.
;;; Unfortunately it didn't work -- perhaps the sounds coming in from the headphones were echoing
;;; around and you have the same problem in headphones that any attempt at room simulation has 
;;; in speakers -- the real room echoes confuse the simulated room echoes.  Now I need a direct
;;; connection to my brain.


(defun remove-duplicates (data)
  (let ((new-data nil)
	(time -1))
    (loop for i in data do
      (if (/= time (round (first i))) (push i new-data))
      (setf time (round (first i))))
    (nreverse new-data)))

(defun sort-data (data)
  (let ((A nil)
	(B nil))
    (loop for i in data do
      (push (list (first i) (third i) (- (second i) (first i)) (fifth i)) A)
      (push (list (second i) (fourth i) (- (first i) (second i)) (fifth i)) B))
    (values (sort A #'< :key #'car) (sort B #'< :key #'car))))

(defvar head-width-in-samples 10)

(defun get-len (data)
  ;; third = diff to other, if =0 then front or back (fourth), >0 we are first, <0 they are first
  (let ((diff (third data))
	(quad (fourth data)))
    (floor (* (if (or (equal quad "RB") (equal quad "LB")) 1 3)
	      (* (+ 1.0 (sin (* (- head-width-in-samples (abs diff)) pi 0.5 (/ 1.0 head-width-in-samples)))))))))
 
(defun get-mlt (data)
  (declare (ignore data))
  .5)

(definstrument simp (start-time frq amp rm)
    (multiple-value-bind 
	(A B)
	(sort-data (rmloc-data rm))
      (setf A (remove-duplicates A))
      (setf B (remove-duplicates B))
      (let* ((os (make-oscil :frequency frq))
	     (osfm (make-oscil :frequency frq))
	     (beg (floor (* start-time sampling-rate)))
	     (val 0.0)
	     (tval 0.0)
	     (sum 0.0)
	     (A-total (- (floor (min (first (first A)) (first (first B)))) 3))
	     (B-total A-total)
	     (A-current 0)
	     (B-current 0)
	     (A-len (length A))
	     (B-len (length B))
	     (ampenv (make-env :envelope '(0 0 5 1 25 0 100 0) 
			       :scaler (/ amp (clm::rmloc-distS rm))
			       :duration .5 :start-time start-time))
	     (valA (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valB (make-array B-len :element-type 'short-float :initial-element 0.0))
	     (dlyA (make-array A-len :element-type 'dly))
	     (dlyB (make-array B-len :element-type 'dly))
	     (cmbA (make-array A-len :element-type 'cmbflt))
	     (cmbB (make-array B-len :element-type 'cmbflt))
	     (end (floor (+ beg (* .5 sampling-rate)))))
	(loop for i in A and j in B and k from 0 do
	  (setf (aref valA k) (second i))
 	  (setf A-current (- (round (first i)) A-total))
	  (incf A-total A-current)
	  (setf (aref dlyA k) (make-delay A-current))
	  (setf (aref cmbA k) (make-comb (get-mlt i) (get-len i)))
	  (setf (aref valB k) (second j))
 	  (setf B-current (- (round (first j)) B-total))
	  (incf B-total B-current)
	  (setf (aref dlyB k) (make-delay B-current))
	  (setf (aref cmbB k) (make-comb (get-mlt j) (get-len j))))
	(Run
	 (loop for i from beg to end do
	   (setf val (* (env ampenv) (oscil os (* .1 (oscil osfm)))))
	   (setf sum 0.0)
	   (setf tval val)
	   (dotimes (k A-len)
	     (setf val (delay (aref dlyA k) val))
	     (incf sum (* (comb (aref cmbA k) val) (aref valA k))))
	   (outa i sum)
	   (setf sum 0.0)
	   (setf val tval)
	   (dotimes (k B-len)
	     (setf val (delay (aref dlyB k) val))
	     (incf sum (* (comb (aref cmbB k) val) (aref valB k))))
	   (outb i sum))))))
	
	
       
;;; another -- this time we try to filter the echoes dependent on where they come from

(defun remove-duplicates (data)
  (let ((new-data nil)
	(time -1))
    (loop for i in data do
      (if (/= time (round (first i))) (push i new-data))
      (setf time (round (first i))))
    (nreverse new-data)))

(defun sort-data (data)
  (let ((A nil)
	(B nil))
    (loop for i in data do
      (push (list (first i) (third i) (- (second i) (first i)) (fifth i)) A)
      (push (list (second i) (fourth i) (- (first i) (second i)) (fifth i)) B))
    (values (sort A #'< :key #'car) (sort B #'< :key #'car))))

(defvar head-width-in-samples 10)

(definstrument (simp :exp-env nil) (start-time frq amp rm)
    (multiple-value-bind 
	(A B)
	(sort-data (rmloc-data rm))
      (setf A (remove-duplicates A))
      (setf B (remove-duplicates B))
      (let* ((os (make-oscil :frequency frq))
	     (osfm (make-oscil :frequency frq))
	     (beg (floor (* start-time sampling-rate)))
	     (val 0.0)
	     (tval 0.0)
	     (sum 0.0)
	     (A-total (- (floor (min (first (first A)) (first (first B)))) 3))
	     (B-total A-total)
	     (A-current 0)
	     (B-current 0)
	     (diff 0.0)
	     (quad "RF")
	     (A-len (length A))
	     (B-len (length B))
	     (ampenv (make-env :envelope '(0 0 5 1 25 0 100 0) 
			       :scaler (/ amp (clm::rmloc-distS rm))
			       :duration .5 :start-time start-time))
	     (valA (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valB (make-array B-len :element-type 'short-float :initial-element 0.0))
	     (dlyA (make-array A-len :element-type 'dly))
	     (dlyB (make-array B-len :element-type 'dly))
	     (flFA (make-filter :x-coeffs '(0 0 0 .25 0 0 .1)))
	     (flFB (make-filter :x-coeffs '(0 0 0 .25 0 0 .1)))
	     (flBA (make-filter :x-coeffs '(0 .5 0 .25 0 0 0 .1)))
	     (flBB (make-filter :x-coeffs '(0 .5 0 .25 0 0 0 .1)))
	     (flAA (make-filter :x-coeffs '(0 0 0 0 0 .5 0 0 .2)))
	     (flAB (make-filter :x-coeffs '(0 0 0 0 0 .5 0 0 .2)))
	     (valFLFA (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valFLBA (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valFLAA (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valFLFB (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valFLBB (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valFLAB (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (end (floor (+ beg (* .5 sampling-rate)))))
	(loop for i in A and j in B and k from 0 do
	  (setf diff (third i))
	  (setf quad (fourth i))
	  (setf (aref valA k) (second i))
 	  (setf A-current (- (round (first i)) A-total))
	  (incf A-total A-current)
	  (setf (aref dlyA k) (make-delay A-current))
	  (setf (aref valFLFA k) (if (or (equal quad "RF") (equal quad "LF")) (/ (- 10 (abs diff)) 10) 0.0))
	  (setf (aref valFLBA k) (if (or (equal quad "RB") (equal quad "LB")) (/ (- 10 (abs diff)) 10) 0.0))
	  (setf (aref valFLAA k) (- 1.0 (max (aref valFLFA k) (aref valFLBA k))))
	  (setf (aref valB k) (second j))
 	  (setf B-current (- (round (first j)) B-total))
	  (incf B-total B-current)
	  (setf (aref dlyB k) (make-delay B-current))
	  (setf (aref valFLFB k) (aref valFLFA k))
	  (setf (aref valFLBB k) (aref valFLBA k))
	  (setf (aref valFLAB k) (aref valFLAA k)))
	(Run
	 (loop for i from beg to end do
	   (setf val (* (env ampenv) (oscil os (* .2 (oscil osfm)))))
	   (setf sum 0.0)
	   (setf tval val)
	   (dotimes (k A-len)
	     (setf val (delay (aref dlyA k) val))
	     (incf sum (* (aref valA k) (+ (filter flFA (* val (aref valFLFA k)))
					   (filter flBA (* val (aref valFLBA k)))
					   (filter flAA (* val (aref valFLAA k)))))))
	   (outa i sum)
	   (setf sum 0.0)
	   (setf val tval)
	   (dotimes (k B-len)
	     (setf val (delay (aref dlyB k) val))
	     (incf sum (* (aref valB k) (+ (filter flFB (* val (aref valFLFB k)))
					   (filter flBB (* val (aref valFLBB k)))
					   (filter flAB (* val (aref valFLAB k)))))))
	   (outb i sum))))))
	
	
(defun remove-duplicates (data)
  (let ((new-data nil)
	(time -1))
    (loop for i in data do
      (if (/= time (round (first i))) (push i new-data))
      (setf time (round (first i))))
    (nreverse new-data)))

(defun sort-data (data)
  (let ((A nil)
	(B nil))
    (loop for i in data do
      (push (list (first i) (third i) (- (second i) (first i)) (fifth i)) A)
      (push (list (second i) (fourth i) (- (first i) (second i)) (fifth i)) B))
    (values (sort A #'< :key #'car) (sort B #'< :key #'car))))

(defvar head-width-in-samples 10)

(definstrument (simp :exp-env nil) (start-time frq amp rm)
    (multiple-value-bind 
	(A B)
	(sort-data (rmloc-data rm))
      (setf A (remove-duplicates A))
      (setf B (remove-duplicates B))
      (let* ((os (make-oscil :frequency frq))
	     (osfm (make-oscil :frequency frq))
	     (beg (floor (* start-time sampling-rate)))
	     (val 0.0)
	     (tval 0.0)
	     (sum 0.0)
	     (A-total (- (floor (min (first (first A)) (first (first B)))) 3))
	     (B-total A-total)
	     (A-current 0)
	     (B-current 0)
	     (diff 0.0)
	     (quad "RF")
	     (A-len (length A))
	     (B-len (length B))
	     (ampenv (make-env :envelope '(0 0 5 1 25 0 100 0) 
			       :scaler (/ amp (clm::rmloc-distS rm))
			       :duration .5 :start-time start-time))
	     (valA (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valB (make-array B-len :element-type 'short-float :initial-element 0.0))
	     (dlyA (make-array A-len :element-type 'dly))
	     (dlyB (make-array B-len :element-type 'dly))
	     (flFA (make-filter :x-coeffs '(0 0 0 0 0 0 0 0 0 0 .5 0 0 0 0 .25 0 0 0 0 0 0 0 0 0 .1)))
	     (flFB (make-filter :x-coeffs '(0 0 0 0 0 0 0 0 0 0 .5 0 0 0 0 .25 0 0 0 0 0 0 0 0 0 .1)))
	     (flBA (make-filter :x-coeffs '(0 0 0 0 .5 0 0 0 0 .25 0 0 0 0 0 0 0 .1)))
	     (flBB (make-filter :x-coeffs '(0 0 0 0 .5 0 0 0 0 .25 0 0 0 0 0 0 0 .1)))
	     (flAA (make-filter :x-coeffs '(0 0 0 0 0 0 0 0 0 0 0 .5 0 0 0 0 0 0 0 0 0 0 .25)))
	     (flAB (make-filter :x-coeffs '(0 0 0 0 0 0 0 0 0 0 0 .5 0 0 0 0 0 0 0 0 0 0 .25)))
	     (valFLFA (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valFLBA (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valFLAA (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valFLFB (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valFLBB (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (valFLAB (make-array A-len :element-type 'short-float :initial-element 0.0))
	     (end (floor (+ beg (* .5 sampling-rate)))))
	(loop for i in A and j in B and k from 0 do
	  (setf diff (third i))
	  (setf quad (fourth i))
	  (setf (aref valA k) (second i))
 	  (setf A-current (- (round (first i)) A-total))
	  (incf A-total A-current)
	  (setf (aref dlyA k) (make-delay A-current))
	  (setf (aref valFLFA k) (if (or (equal quad "RF") (equal quad "LF")) (/ (- 10 (abs diff)) 10) 0.0))
	  (setf (aref valFLBA k) (if (or (equal quad "RB") (equal quad "LB")) (/ (- 10 (abs diff)) 10) 0.0))
	  (setf (aref valFLAA k) (- 1.0 (max (aref valFLFA k) (aref valFLBA k))))
	  (setf (aref valB k) (second j))
 	  (setf B-current (- (round (first j)) B-total))
	  (incf B-total B-current)
	  (setf (aref dlyB k) (make-delay B-current))
	  (setf (aref valFLFB k) (aref valFLFA k))
	  (setf (aref valFLBB k) (aref valFLBA k))
	  (setf (aref valFLAB k) (aref valFLAA k)))
	(Run
	 (loop for i from beg to end do
	   (setf val (* (env ampenv) (oscil os (* .2 (oscil osfm)))))
	   (setf sum 0.0)
	   (setf tval val)
	   (dotimes (k A-len)
	     (setf val (delay (aref dlyA k) val))
	     (incf sum (* (aref valA k) (+ (filter flFA (* val (aref valFLFA k)))
					   (filter flBA (* val (aref valFLBA k)))
					   (filter flAA (* val (aref valFLAA k)))))))
	   (outa i sum)
	   (setf sum 0.0)
	   (setf val tval)
	   (dotimes (k B-len)
	     (setf val (delay (aref dlyB k) val))
	     (incf sum (* (aref valB k) (+ (filter flFB (* val (aref valFLFB k)))
					   (filter flBB (* val (aref valFLBB k)))
					   (filter flAB (* val (aref valFLAB k)))))))
	   (outb i sum))))))
	
	
       

