;; LOOPS.LISP by Harvey Thornburg 
;; Mar 1 1998

(defun make-ats-data-array (num-partials num-frames)
   (let* ((new (make-array num-partials :element-type 'array)))
       (loop for i from 0 to (- num-partials 1) do
          (setf (aref new i) (make-array num-frames))) new)) 

(defun loop-ats-data-array (array oldframes newframes &key (incr 0))
   (let* ((len (first (array-dimensions array)))
          (new (make-ats-data-array len newframes))
          (incr-multiplier 0))
       (loop for i from 0 to (- len 1) do
          (loop for j from 0 to (- newframes 1) do
              (setf incr-multiplier (floor (/ j oldframes)))
              (setf (aref (aref new i) j) (+ (* incr-multiplier incr)
                 (aref (aref array i) (mod j oldframes)))))) new))

;; Loop-sound takes an existing ATS sound and creates another sound of 
;; a different duration.  The duration can be shorter, in which the
;; sound is truncated, or longer, in which the sound is repeatedly
;; concatenated with itself to fill out the longer duration.  
;; Results of this operation proceed without the sample "clicking" 
;; resulting from self-concatenation of the direct signal.
(defun loop-sound (sound duration &optional (new-name nil)) 
  (let* ((name (if new-name (string new-name) 
		(concatenate 'string (ats-sound-name sound) "-loop")))
         (olddur (ats-sound-dur sound))
         (oldframes (ats-sound-frames sound))
         (framerate (ats-sound-frame-rate sound))
         (newframes (floor (* oldframes (/ duration olddur))))
         (newdur (/ newframes framerate))
         (partials (ats-sound-partials sound))
         (ncoefs (ats-sound-ncoefs sound))
         (loop-count 0)
         (temp 0)) 
       (make-ats-sound 
	:name name
	:type (ats-sound-type sound)          
	:frame-rate framerate
	:frame-size (ats-sound-frame-size sound)
	:partials partials
	:frames newframes
	:stoc-type (ats-sound-stoc-type sound)
	:ncoefs ncoefs
	:optimized (ats-sound-optimized sound)
	:ampmax (ats-sound-ampmax sound)
	:frqmax (ats-sound-frqmax sound)
	:beg (ats-sound-beg sound)
	:dur newdur
	:time (loop-ats-data-array (ats-sound-time sound) oldframes
		 newframes :incr olddur)
	:frq-av (copy-seq (ats-sound-frq-av sound))
	:amp-av (copy-seq (ats-sound-amp-av sound))
	:frq (loop-ats-data-array (ats-sound-frq sound) oldframes newframes)
	:amp (loop-ats-data-array (ats-sound-amp sound) oldframes newframes) 
	:pha (if (ats-sound-pha sound) 
           (loop-ats-data-array (ats-sound-pha sound) oldframes newframes)
               nil)   
	:coeff (if (ats-sound-coeff sound)
           (loop-ats-data-array (ats-sound-coeff sound) oldframes newframes)
	       nil)
	:gain (if (ats-sound-gain sound) 
           (copy-seq (ats-sound-gain sound)) nil))))