;;; -*- Lisp -*-
;;;

(defvar amp-env-array (make-array 14))
(defvar frq-env-array (make-array 14))

(setf (aref amp-env-array 0) '(0 0 .038 0.126 .081 0.581 .122 0.675 .224 0.158 .344 0))
(setf (aref amp-env-array 1) '(0 0 .041 .041 .067 .115 .101 .143 .199 .015 .277 0 .344 0))
(setf (aref amp-env-array 2) '(0 0 .005 0 .066 .026 .083 .021 .106 .018 .127 .006 .212 0 .344 0))
(setf (aref amp-env-array 3) '(0 0 .008 0 .031 .01 .058 .018 .091 .019 .141 .005 .183 0 .344 0))
(setf (aref amp-env-array 4) '(0 0 .015 0 .052 .022 .072 .03 .088 .025 .126 .004 .138 0 .344 0))
(setf (aref amp-env-array 5) '(0 0 .023 0 .033 .006 .047 .007 .067 .006 .084 .003 .094 0 .344 0))
(setf (aref amp-env-array 6) '(0 0 .002 0 .018 .007 .038 .0001 .049 .009 .079 .004 .12 0 .344 0))
(setf (aref amp-env-array 7) '(0 0 .009 0 .029 .003 .063 .005 .097 .002 .117 .001 .133 0 .344 0))
(setf (aref amp-env-array 8) '(0 0 .013 0 .027 .0035 .044 .004 .061 .008 .101 .001 .109 0 .344 0))
(setf (aref amp-env-array 9) '(0 0 .012 0 .022 .0035 .055 .005 .074 .002 .094 .002 .101 0 .344 0))
(setf (aref amp-env-array 10) '(0 0 .019 0 .023 .001 .040 .002 .056 .002 .067 .001 .074 0 .344 0))
(setf (aref amp-env-array 11) '(0 0 .022 0 .029 .001 .038 .0015 .051 .001 .063 .0015 .072 0 .344 0))
(setf (aref amp-env-array 12) '(0 0 .019 0 .022 .0015 .024 .002 .038 .0005 .052 .0015 .058 0 .344 0))
(setf (aref amp-env-array 13) '(0 0 .02 0 .024 .0005 .033 .0005 .040 .001 .049 .0005 .056 0 .344 0))


(setf (aref frq-env-array 0) '(0 95 .006 299 .043 314 .086 312 .274 313 .344 314))
(setf (aref frq-env-array 1) '(0 339 .009 605 .036 629 .119 627 .244 629 .277 626 .278 0 .344 0))
(setf (aref frq-env-array 2) '(0 0 .004  0 .005 540 .009 915 .029 938 .083 949 .183 950 .212 946 .213 0 .344 0))
(setf (aref frq-env-array 3) '(0 0 .006 0 .008 780 .013 1225 .040 1258 .115 1259 .167 1265 .183 1255 .184 0 .344 0))
(setf (aref frq-env-array 4) '(0 0 .013 0 .015 1342 .019 1589 .023 1554 .099 1583 .133 1581 .138 1501 .140 0 .344 0))
(setf (aref frq-env-array 5) '(0 0 .022 0 .023 1344 .031 1874 .062 1903 .072 1903 .081 1899 .094 1771 .095 0 .344 0))
(setf (aref frq-env-array 6) '(0 0 .002 1470 .006 2121 .020 2188 .074 2193 .101 2214 .120 2193 .122 0 .344 0))
(setf (aref frq-env-array 7) '(0 0 .008 0 .009 1655 .013 2459 .026 2513 .049 2510 .080 2530 .133 2525 .134 0 .344 0))
(setf (aref frq-env-array 8) '(0 0 .012 0 .013 2464 .015 2704 .022 2815 .072 2845 .095 2841 .109 2803 .110 0 .344 0))
(setf (aref frq-env-array 9) '(0 0 .011 0 .012 2483 .015 3107 .045 3151 .079 3169 .095 3169 .101 3158 .102 0 .344 0))
(setf (aref frq-env-array 10) '(0 0 .018 0 .019 3131 .022 3463 .029 3438 .038 3459 .052 3467 .074 3451 .076 0 .344 0))
(setf (aref frq-env-array 11) '(0 0 .020 0 .022 3156 .024 3778 .029 3741 .034 3743 .051 3775 .072 3753 .073 0 .344 0))
(setf (aref frq-env-array 12) '(0 0 .018 0 .019 3278 .023 4078 .030 4063 .037 4087 .048 4092 .058 4079 .059 0 .344 0))
(setf (aref frq-env-array 13) '(0 0 .019 0 .020 3573 .022 4069 .029 4362 .040 4377 .047 4342 .056 4358 .058 0 .344 0))


(definstrument (complete-add :exp-env nil)
    (begin-time duration amplitude amp-arr frq-arr)
  (let* ((beg (floor (* begin-time sampling-rate)))
	 (end (+ beg (floor (* duration sampling-rate))))
	 (sum 0.0)
  	 (siz (min (array-dimension amp-arr 0) (array-dimension frq-arr 0)))
	 (s (make-array siz :element-type 'osc))
	 (ae (make-array siz :element-type 'envelope))
	 (fe (make-array siz :element-type 'envelope)))
    (loop for i below siz do
      (setf (aref s i) (make-oscil :frequency 0.0)) ; dealt with directly by the frequency function
      (setf (aref ae i) (make-func :envelope (aref amp-arr i)
				   :scaler amplitude :start-time begin-time :duration duration))
      (setf (aref fe i) (make-func :envelope (aref frq-arr i)
				   :scaler (in-Hz 1.0) :start-time begin-time :duration duration)))
    (Run
     (loop for i from beg to end do
       (setf sum 0.0)
       (dotimes (j siz)
	 (incf sum (* (env (aref ae j)) 
		      (oscil (aref s j) (env (aref fe j))))))
       (outa i sum)))))
				   
(defun test-add () (complete-add 0 .5 .5 amp-env-array frq-env-array))