;;; -*- syntax: common-lisp; package: clm; base: 10; mode:lisp -*-
;;;
;;; Granular synthesis instrument
;;; Fernando Lopez-Lezcano
;;;
;;;   original grani.ins instrument written for the 220a Course by
;;;   Fernando Lopez-Lezcano & Juan Pampin, November 6 1996
;;;
;;; 3/21/97 Working with hop and grain-dur envelopes
;;; 3/22/97 Working with src envelope (grain wise)& src spread
;;; v7 nando, started work on 1/26/1998
;;; Nov 7 1998: input soundfile duration calculation wrong
;;; Nov 10 1998: bug in in-samples (thanks to Kristopher D. Giesing for this one)

;;;-----------------------------------------------------------------------------
;;; Auxilliary functions

;;; calculate a random spread around a center of 0

(defmacro random-spread (spread)
  `(if (/= ,spread 0)
       (- (random ,spread)
	  (/ ,spread 2))
     0))

;;; convert a time in seconds to a number of samples

(defmacro to-samples (time srate)
  `(floor (* ,time ,srate)))

;;; create a constant envelope if argument is a number

(defun envelope-or-number (in)
  (if (numberp in)(list 0 in 1 in) in))

;;; create an array from an envelope

(defun make-gr-env (env &optional (length 512))
  (let* ((env-arr (make-short-float-array length))
	 (length-1 (1- length)))
    (loop for i from 0 below length do
	  (setf (aref env-arr i)(make-short-float (eref env (/ i length-1)))))
    env-arr))

;;;-----------------------------------------------------------------------------
;;; Grain envelopes

(defun raised-cosine (&key 
		      (duty-cycle 100)
		      (length 128))
  (let* ((a (make-short-float-array length))
	 (active (* length duty-cycle 0.01))
	 (incr (/ pi (1- active)))
	 (start (/ (- length active) 2))
	 (end (/ (+ length active) 2)))
    (loop 
	with s = 0
	for i from 0 below length 
	for sine = (if (and (>= i start)(< i end))
		       (prog1
			 (sin (* s incr))
			 (incf s))
		     0)
	do (setf (aref a i)(make-short-float (* sine sine))))
    a))

;;;=============================================================================
;;; Granular synthesis instrument
;;;=============================================================================

;;; amp-envelope:
;;;   amplitude envelope for the note
;;; grain-envelope:
;;; grain-envelope-end:
;;;   envelopes for each individual grain. The envelope applied in the result
;;;   of interpolating both envelopes. The interpolation is controlled by
;;;   grain-envelope-trasition. If "grain-envelope-end" is nil interpolation
;;;   is turned off and only grain-envelope is applied to the grains. 
;;; grain-envelope-trasition:
;;;   an enveloper that controls the interpolation between the two grain envelopes
;;;   0 -> selects "grain-envelope"
;;;   1 -> selects "grain-envelope-end"
;;; grain-duration:
;;;   envelope that controls grain duration in seconds
;;; srate-linear:
;;;   t -> sample rate envelope is linear
;;;   nil -> sample rate envelope is exponential
;;; srate:
;;;   envelope that controls sample rate conversion. The envelope is an
;;;   exponential envelope, the base and error bound of the conversion
;;;   are controlled by "srate-base" and "srate-error".
;;; srate-spread:
;;;   random spread of sample rate conversion around "srate"
;;; srate-base:
;;;   base for the exponential conversion
;;;   for example: base = (expt 2 (/ 12)) converts a semitone envelope
;;; srate-error:
;;;   error bound for the exponential conversion. 
;;; grain-start:
;;;   envelope that determines the starting point of the current grain in
;;;   the input file. "y"->0 starts the grain at the beginning of the input
;;;   file. "y"->1 starts the grain at the end of the input file.
;;; grain-start-spread:
;;;   random spread around the value of "grain-start"
;;; grain-density:
;;;   envelope that controls the number of grains per second generated in the output file
;;; grain-density-spread:
;;;   envelope that controls a random variation of density

(defparameter grani-grains 0)
(defparameter grani-amp-envelope '(0 0 0.3 1 0.7 1 1 0))
(defparameter grani-grain-envelope '(0 0 0.3 1 0.7 1 1 0))
(defparameter grani-grain-envelope-end nil)
(defparameter grani-grain-envelope-transition '(0 0 1 1))
(defparameter grani-grain-duration 0.1)
(defparameter grani-grain-duration-spread 0)
(defparameter grani-grain-duration-limit 0.002)
(defparameter grani-srate 0.0)
(defparameter grani-srate-spread 0.0)
(defparameter grani-srate-linear nil)
(defparameter grani-srate-base (expt 2 (/ 12)))
(defparameter grani-srate-error 0.01)
(defparameter grani-grain-start '(0 0 1 1))
(defparameter grani-grain-start-spread 0)
(defparameter grani-grain-density 10)
(defparameter grani-grain-density-spread 0)
(defparameter grani-reverb-amount 0.01)
(defparameter grani-reverse nil)

(defparameter grani-where-to 0)
(defparameter grani-grain-distance 1)
(defparameter grani-grain-distance-spread 0)
(defparameter grani-grain-degree 0.5)
(defparameter grani-grain-degree-spread 0)
(defparameter grani-where-bins '())

(defconstant grani-to-locsig 0)
(defconstant grani-to-grain-length 1)
(defconstant grani-to-grain-start 2)
(defconstant grani-to-grain-sample-rate 3)
(defconstant grani-to-grain-random 4)

(definstrument grani 
    (start-time duration amplitude file
		&key
		(grains grani-grains)
		(amp-envelope grani-amp-envelope)
		(grain-envelope grani-grain-envelope)
		(grain-envelope-end grani-grain-envelope-end)
		(grain-envelope-transition grani-grain-envelope-transition)
		(grain-duration grani-grain-duration)
		(grain-duration-spread grani-grain-duration-spread)
		(grain-duration-limit grani-grain-duration-limit)
		(srate grani-srate)
		(srate-spread grani-srate-spread)
		(srate-linear grani-srate-linear)
		(srate-base grani-srate-base)
		(srate-error grani-srate-error)
		(grain-start grani-grain-start)
		(grain-start-spread grani-grain-start-spread)
		(grain-density grani-grain-density)
		(grain-density-spread grani-grain-density-spread)
		(reverb-amount grani-reverb-amount)
		(reverse grani-reverse)
		(where-to grani-where-to)
		(where-bins grani-where-bins)
		(grain-distance grani-grain-distance)
		(grain-distance-spread grani-grain-distance-spread)
		(grain-degree grani-grain-degree)
		(grain-degree-spread grani-grain-degree-spread))
  
  (multiple-value-bind (beg end) (get-beg-end start-time duration)
    (let* ((in-file (open-input file))
	   (in-file-sr (snd-srate in-file))
	   (in-file-dur  (/ (snd-frames in-file) in-file-sr))
       	   (last-in-sample (floor (* in-file-dur in-file-sr)))
	   ;; ratio between input and output sampling rates
	   (srate-ratio (/ in-file-sr sampling-rate))
	   ;; sample rate converter for input samples
           (in-file-reader (make-src :file in-file 
				     :start-time 0
				     :srate 1.0))
	   ;; sample rate conversion envelope
	   (sr-linear (if srate-linear 1 0))
	   (sr-env (make-env :envelope (if srate-linear
					   (envelope-or-number srate)
					 (exp-env (envelope-or-number srate) 
						  :base srate-base 
						  :error srate-error))
			     :scaler srate-ratio
			     :start-time start-time
			     :duration duration))
	   ;; sample rate conversion random spread
	   (sr-spread-env (make-env :envelope (envelope-or-number srate-spread)
				    :start-time start-time
				    :duration duration))			 
	   ;; amplitude envelope for the note
	   (amp-env (make-env :envelope amp-envelope
			      :scaler amplitude
			      :start-time start-time
			      :duration duration))
	   ;; grain duration envelope
	   (gr-dur (make-env :envelope (envelope-or-number grain-duration)
			     :start-time start-time
			     :duration duration))
	   (gr-dur-spread (make-env :envelope (envelope-or-number grain-duration-spread)
				    :start-time start-time
				    :duration duration))
	   ;; position in the input file where the grain starts
	   (gr-start-env (make-env :envelope (envelope-or-number grain-start)
				   :start-time start-time
				   :duration duration))
	   ;; random variation in the position in the input file
	   (gr-start-spread (make-env :envelope (envelope-or-number grain-start-spread)
				      :start-time start-time
				      :duration duration))			  
	   ;; density envelope in grains per second
	   (gr-dens-env (make-env :envelope (envelope-or-number grain-density)
				  :start-time start-time
				  :duration duration))
	   ;; density spread envelope in grains per second
	   (gr-dens-spread-env (make-env :envelope (envelope-or-number grain-density-spread)
					 :start-time start-time
					 :duration duration))
	   ;; grain envelope
	   (gr-env (make-table-lookup :frequency 1.0
				      :initial-phase 0.0
				      :wave (if (arrayp grain-envelope)
						grain-envelope
					      (make-gr-env grain-envelope))))
	   ;; grain envelope
	   (gr-env-end (make-table-lookup :frequency 1.0
					  :initial-phase 0.0
					  :wave (if grain-envelope-end
						    (if (arrayp grain-envelope-end)
							grain-envelope-end
						      (make-gr-env grain-envelope-end))
						  (make-table))))
	   ;; envelope for transition between grain envelopes
	   (gr-int-env (make-env :envelope (envelope-or-number grain-envelope-transition)
				 :start-time start-time
				 :duration duration))
	   (interp-gr-envs (not (null grain-envelope-end)))
	   ;; envelope for distance of grains (for using in locsig)
	   (gr-dist (make-env :envelope (envelope-or-number grain-distance)
			      :start-time start-time
			      :duration duration))
	   (gr-dist-spread (make-env :envelope (envelope-or-number grain-distance-spread)
				     :start-time start-time
				     :duration duration))
	   ;; envelopes for angular location and spread of grain in the stereo field
	   (gr-degree (make-env :envelope (envelope-or-number grain-degree)
				:start-time start-time
				:duration duration))
	   (gr-degree-spread (make-env :envelope (envelope-or-number grain-degree-spread)
				       :start-time start-time
				       :duration duration))
	   ;; signal locator in the stereo image
	   (loc (make-locsig :degree 45
			     :distance 1))
	   ;; array of condition bins
	   (bins (make-array (length where-bins) :initial-contents where-bins))

	   ;; variables used and initialized inside the run loop
	   (in-samples 0)
	   (gr-start beg)
	   (gr-from-beg 0)
	   (in-start 0)
	   (in-start-percent 0)
	   (gr-duration 0)
       	   (gr-samples 0)
	   (gr-offset (1+ gr-samples))
	   (gr-dens 0)
	   (gr-dens-spread 0)
	   (gr-srate 0)
	   (grain-counter 0)
	   (samples 0)
	   (first-grain t)
	   (gr-where 0)
	   (where)
	   (deg 0)
	   (dist 0)
	   (dist-scl 0))
      (if reverse (read-backward in-file-reader))
      (run
       (loop for i from beg do
	     (if (< gr-offset gr-samples)
		 ;;
		 ;; send sample to output
		 ;;
		 (progn
		   (if interp-gr-envs (setf gr-where (env gr-int-env)))
		   (locsig loc (floor (+ gr-start gr-offset)) 
			   (* (if interp-gr-envs 
				  (+ (* (- 1 gr-where) (table-lookup gr-env))
				     (* gr-where (table-lookup gr-env-end)))
				(table-lookup gr-env))
			      (env amp-env)
			      (src in-file-reader)))
		   ;; increment pointer in grain
		   (incf gr-offset))
	       (progn
		 ;;
		 ;; start of a new grain
		 ;;
		 ;; now, why do we zero this sample? If we don't then some grains have
		 ;; a missing tail and we get clicks in the output. Putting a call to
		 ;; locsig does _not_ get rid of the clicks, only doing explicit outs. 
		 ;; If this sample is not zeroed then we would not call outn during
		 ;; one iteration of the loop. Maybe there's a connection between that
		 ;; and the cause of the problem. 
		 (loop
		   with now = (floor (+ gr-start gr-offset))
		   for chan from 0 below (channels *current-output-file*) do
		   (out-any now 0 chan))
		 (if first-grain
		     ;; first grain always start at 0
		     (setf first-grain nil
			   gr-start beg)
		   (progn
		     ;; start grain in output file using increments from previous grain
		     (setf gr-start (+ gr-start (to-samples (/ (+ gr-dens gr-dens-spread)) 
							    sampling-rate)))
		     ;; finish if start of grain falls outside of note bounds or number of grains exceeded
		     (if (or (> gr-start end)
			     (if (/= grains 0)
				 (>= grain-counter grains)
			       nil))
			 (progn
			   (clm-print "; grains: ~d, sample ratio: ~f~%" grain-counter (/ samples (- end beg)))
			   (clm::loop-finish)))))
		 (setf 
		     ;; back to the beginning of the grain
		     gr-offset 0
		     ;; start of grain in samples from beginning of note
		     gr-from-beg (floor (- gr-start beg))
		     ;; reset out-time dependent envelopes to current time
		     (read-position amp-env) gr-from-beg
		     (read-position gr-dur) gr-from-beg
		     (read-position gr-dur-spread) gr-from-beg
		     (read-position sr-env) gr-from-beg
		     (read-position sr-spread-env) gr-from-beg
		     (read-position gr-start-env) gr-from-beg
		     (read-position gr-start-spread) gr-from-beg
		     (read-position gr-dens-env) gr-from-beg
		     (read-position gr-dens-spread-env) gr-from-beg
		     ;; start of grain in input file
		     in-start-percent (+ (env gr-start-env)
					 (random-spread (env gr-start-spread)))
		     in-start (to-samples (* in-file-dur in-start-percent) in-file-sr)
		     ;; duration in seconds of the grain
		     gr-duration (max grain-duration-limit (+ (env gr-dur)
							      (random-spread (env gr-dur-spread))))
		     ;; number of samples in the grain
		     gr-samples (to-samples gr-duration sampling-rate)
		     ;; new sample rate for grain
		     gr-srate (if (= sr-linear 0)
				  (* (env sr-env)
				     (expt srate-base (random-spread (env sr-spread-env))))
				(+ (env sr-env)
				   (random-spread (env sr-spread-env))))
		     ;; set new sampling rate conversion factor
		     (sr-incr in-file-reader) gr-srate
		     ;; number of samples in input
		     in-samples (floor gr-samples (/ 1 srate-ratio))
		     ;; restart grain envelopes
		     (tbl-phase gr-env) 0.0
		     (tbl-phase gr-env-end) 0.0
		     ;; reset grain envelope durations
		     (frequency gr-env)(/ 1 gr-duration)
		     (frequency gr-env-end)(/ 1 gr-duration)
		     ;;
		     ;; move position in output file for next grain
		     ;;
		     gr-dens (env gr-dens-env)
		     ;; increment spread in output file for next grain
		     gr-dens-spread (random-spread (env gr-dens-spread-env))
		     ;; gather some statistics
		     samples (+ samples gr-samples)
		     grain-counter (+ grain-counter 1))

		 ;; decide where this grain is going to go
		 (setf where
		   (cond (;; use length of grains as delimiter
			  (= where-to grani-to-grain-length) gr-duration)
			 (;; use start in input file as delimiter
			  (= where-to grani-to-grain-start) in-start-percent)
			 (;; use sampling rate as delimiter
			  (= where-to grani-to-grain-sample-rate) gr-srate)
			 (;; use a random number as delimiter
			  (= where-to grani-to-grain-random)(random 1.0))))
		 (if where
		     (loop 
			 for c from 0 below (- (length bins) 1) do
			   (setf (aref (locs-outn loc) c)
			     (if (< (aref bins c) where (aref bins (+ c 1)))
				 1.0 0.0)))
		   ;; cero or unknown: use normal n-channel locsig
		   (setf (read-position gr-dist) gr-from-beg
			 (read-position gr-dist-spread) gr-from-beg
			 (read-position gr-degree) gr-from-beg
			 (read-position gr-degree-spread) gr-from-beg
			 ;; set locsig parameters, for now only understands stereo
			 deg (+ (env gr-degree)(random-spread (env gr-degree-spread)))
			 dist (+ (env gr-dist)(random-spread (env gr-dist-spread)))
			 dist-scl (/ 1.0 dist)
			 (aref (locs-outn loc) 0)(* (- 1.0 deg) dist-scl)
			 (aref (locs-outn loc) 1)(* deg dist-scl)
			 (aref (locs-revn loc) 0)(* reverb-amount (sqrt dist-scl))))
		 ;; check for out of bounds condition in in-file pointers
		 (if (> (+ in-start in-samples) last-in-sample)
		       (setf in-start (- last-in-sample in-samples))
		   (if (< in-start 0)
			 (setf in-start 0)))
		 ;; reset position of input file reader
		 (setf (read-position in-file-reader) in-start)))))
      ;; close file 
      (close-input in-file))))