;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; File:             splinter.ins
;;;
;;; Version:          1.0 (for clm-4)
;;;
;;; Purpose:          Common Lisp Music (clm-2) Instrument for multi-voice
;;;                   granulation of a sound file with sampling-rate conversion
;;;                   for each separate voice.  
;;;
;;;                   Accepts mono input files only and produces any number of
;;;                   channels of output, with grains distributed evenly across
;;;                   all channels.
;;;
;;; Author:           Michael Edwards: m@michael-edwards.org
;;;
;;; Courtesy:         If you use this instrument, or any other written by me,
;;;                   please be courteous enough to acknowledge this fact in
;;;                   programme notes etc.
;;;
;;; Usage:            The instrument has the following parameters:
;;;
;;;                   FILE: Input sound file
;;;
;;;                   TIME: output start time (secs.)
;;;                   
;;;                   CHANNEL: If input is multi-channel, which
;;;                   channel to process (0=left, 1=right etc.) 
;;;                   
;;;                   START: input file start time (secs.)
;;;                   
;;;                   END: input file stop time (secs.).  When zero, then the
;;;                   end of the file.  Grains will be generated using samples
;;;                   only between start and end.
;;;                   
;;;                   DURATION: output file duration (secs.).  When zero, then
;;;                   also end - start.
;;;                   
;;;                   GRAIN-ENV: the grain lengths in secs, ranging over the
;;;                   length of the output file.  This will be set to
;;;                   +MIN-GRAIN-LENGTH+ if too small.
;;;                   
;;;                   CENTER-DEVIATION-ENV: the amount by which the grain can
;;;                   randomly deviate from the current input sample (which is
;;;                   incremented as time progresses by an amount related to
;;;                   the input file duration and output file duration--if the
;;;                   input is 10 secs long and the output is to be 100 secs,
;;;                   we will increment the current sample every 10 (output)
;;;                   samples).
;;;                   
;;;                   The envelope values should be between 0 and 1 (0 means
;;;                   use only the current sample as start of grain and 1 means
;;;                   range over the entire length of the sound file (or,
;;;                   rather, between START and END)--before and after current
;;;                   sample).
;;;                   
;;;                   GRAIN-LENGTH-SCALERS: After reading grain-env to
;;;                   calculate the current grain length, the value is scaled
;;;                   by a random amount between these two extremes.  Can only
;;;                   be a list of two values.
;;;                   
;;;                   PRINT-GRAIN-INFO: If t, then information about grain
;;;                   length etc. will be printed each time a new grain is
;;;                   created.
;;;                   
;;;                   DEBUG: If t, more information is printed for debugging
;;;                   purposes, no input samples are read and no output samples
;;;                   are written.
;;;                   
;;;                   SILENCE-ENV: Controls which percentage of the grains will
;;;                   be played.  y values should range between 0.0 and 1.0
;;;                   where 1.0 means all the grains will be silent and 0.0 all
;;;                   will be played.  (The envelope value is used as a
;;;                   threshold against which a random value > 0 and < 1 is
;;;                   compared to decide whether or not the grain will be
;;;                   output.)
;;;                   
;;;                   VOICES: How many grains (or grain layers) are played
;;;                   simultaneously.
;;;                   
;;;                   SRT: This can either be a single value or a list of
;;;                   values.  If a single value, then this will be the
;;;                   sampling-rate conversion factor for every grain in each
;;;                   voice.  If a list, then the values will be the src
;;;                   factors for each successive voice (remains the same for
;;;                   every grain in the voice, though c.f. srt-expt-env).  The
;;;                   number of values does not need to be the same as the
;;;                   number of voices, as they will simply be repeated (if not
;;;                   enough) or ignored (if too many), e.g. srt = (1 2 3)
;;;                   voices = 7, srt for each voice = (1 2 3 1 2 3 1).
;;;                   
;;;                   ***** N.B.  If srt = 1.0, then simple sound file
;;;                   reading is performed (via IN-ANY) instead of
;;;                   SRC, which for me is at least four times faster.
;;;
;;;                   For the case where srt is 1.0 but you want an srt-env,
;;;                   set srt to t 
;;;                   
;;;                   SRC-WIDTH: The sync width for the sampling-rate
;;;                   conversion (5 is the CLM default but a higher value will
;;;                   increase quality at the expense of processing time--try
;;;                   20 for example).
;;;                   
;;;                   SRT-ENV: a transposition envelope for glissandi
;;;                   
;;;                   SRT-EXPT-ENV: This tries to create some pitch development
;;;                   in the output file by raising the srts of each voice to
;;;                   the exponent given by the envelope.  This is done on a
;;;                   grain-by-grain, not a sample-by-sample basis.  If the
;;;                   envelope value is < 1, then the src range of the voices
;;;                   will be narrower, when > 1 wider.
;;;                   
;;;                   SRT-RANDOM-ENV: Another way to vary pitch: the srt of
;;;                   each grain will be scaled by a random factor between 1
;;;                   and 1 +/- the envelope value.
;;;                   
;;;                   GRAIN-FOCUS-ENV: This envelope creates a focus on certain
;;;                   voices in the mix and so only really makes sense when
;;;                   you're using multiple srts.  The y values range from 0 to
;;;                   1 where 0 means that most of the amplitude energy will be
;;;                   given to the first voice; 1 means that most of the energy
;;;                   will be on the highest voice; and .5 means most will be
;;;                   on the middle voice with the outer voices having the same
;;;                   (lowest) energy.
;;;                   
;;;                   GRAIN-FOCUS-ENV-EXPT: The exponent that the amplitudes
;;;                   applied to the grains from grain-focus-env are raised to.
;;;                   
;;;                   GRAIN-FOCUS-ENV-MIN: The minimum amplitude value that a
;;;                   voice should have when processed by grain-focus-env.  NB
;;;                   This does not relate to the actual envelope values (which
;;;                   always range >=0 <= 1) but rather the min value returned
;;;                   by our focussing function.
;;;                   
;;;                   RAMP: how long in samples the ramp up/down will be.  If
;;;                   this is less than +HALF-MIN-GRAIN-LENGTH+, then
;;;                   +HALF-MIN-GRAIN-LENGTH+ will be used instead
;;;                   
;;;                   AMP:  The amplitude
;;;
;;;                   RADIUS: The radius of a formant filter (0.0-1.0). If NIL,
;;;                   no filtering will be done. Can also be an envelope.
;;;
;;;                   FREQ: the frequency of a format filter, in Hertz. Can
;;;                   also be an envelope.
;;;                   
;;;                   AMP-ENV:  Standard amplitude envelope.
;;;                   
;;;                   REV-AMT:  Reverberation amount.
;;;                   
;;;                   REV-ENV: An envelope for reverb amount.  REV-AMT is the
;;;                   scaler to this envelope.
;;;                   
;;;                   START-TOGETHER: All voices will start their first grain
;;;                   at the same time if this parameter is non-nil (and
;;;                   thereafter never again--or at least it is highly
;;;                   unlikely).  This could be seen as a bug as it makes for
;;;                   an attack at the beginning of the output file that is
;;;                   considerably louder than the rest of the file.  This is
;;;                   seen by me at least as a feature and not a bug, however,
;;;                   as these attacks make for some very useful sounds.  If
;;;                   you don't want this, set start-together to nil.
;;;                   
;;;                   PRINTING: Whether to print the progress of the processing
;;;                   on a second-by-second basis.
;;;
;;; $$ Last modified:  15:47:27 Tue Jun 30 2020 CEST
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package :clm)

(defconstant +SPLINTER-MIN-GRAIN-LENGTH+ 256)
(defconstant +HALF-SPLINTER-MIN-GRAIN-LENGTH+ 
  (/ +SPLINTER-MIN-GRAIN-LENGTH+ 2))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defmacro get-grain-amp (focus voice num-voices &key (min 0.1) (expt 1.0))
  `(let* ((voice-val (* ,voice (/ 1.0 (1- ,num-voices))))
          (diff (abs (- ,focus voice-val)))
          (val (+ ,min (* (- 1.0 diff) (- 1.0 ,min)))))
     (if (= ,expt 1.0) val (expt val ,expt))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(definstrument (splinter :c-file
                         "/Users/michael/code/ins/.cins/splinter.c")
    (file time &key
          (channel 0)
          ;; (output-channels 2)
          (start 0)
          (end 0)
          (duration 0)
          (grain-env '(0 .01 100 .01))
          (center-deviation-env '(0 0.5 100 0.5))
          (grain-length-scalers '(.5 2.0))
          (print-grain-info nil)
          (debug nil)
          (silence-env nil)
          (voices 2)
          (srt 1.0)
          (src-width 5)
          (srt-expt-env nil)
          (srt-random-env nil)
          (srt-env '(0 0 100 0))
          (grain-focus-env nil)
          (grain-focus-env-expt 1.0)
          (grain-focus-env-min 0.1)
          (freq nil)
          (radius nil)
          (ramp 0)
          (amp 1.0)
          (amp-env '(0 1 100 1))
          (amp-env-base 1.0)
          (rev-amt 0)
          (rev-env nil)
          (start-together t)
          (printing t))
  (when debug
    (setq print-grain-info t))
  (when (and (listp srt)
             (not voices))
    (setq voices (length srt)))
  (let* ((st (floor (* time *srate*)))
         (file-dur (sound-duration file))
         (ramp-len (max ramp +HALF-SPLINTER-MIN-GRAIN-LENGTH+))
         (current-ramp-len ramp-len)
         (1-minus-ramp-len (1- ramp-len))
         (input-end (if (= end 0) 
                        file-dur 
                        (if (> end file-dur)
                            (progn
                              (warn "end (~f) > file duration (~f).  ~
                                 Using file duration instead of end."
                                    end file-dur)
                              file-dur)
                            end)))
         (real-dur (if (= duration 0) (- input-end start) duration))
         (input-start-samples (floor (* *srate* start)))
         (input-end-samples (floor (* *srate* input-end)))
         (num-input-samples (floor (- input-end-samples input-start-samples)))
         (nd (+ st (floor (* *srate* real-dur))))
         (output-chans (mus-channels *output*))
         (do-src (if (eq srt t)
                     (setf srt 1.0)
                     (or srt-random-env srt-expt-env 
                         (not (and (numberp srt) (= srt 1.0))))))
         (files (when do-src
                  (make-array voices :initial-contents 
                              (loop repeat voices collect
                                   (open-input* file :channel channel)))))
         (fil (unless do-src (open-input* file)))
         (srcs (when do-src
                 (make-array voices :initial-contents
                             (if (listp srt)
                                 (loop for i below voices collect 
                                      (nth (mod i (length srt)) srt))
                                 (loop repeat voices collect srt)))))
         (src-gens (when do-src
                     (make-array voices :initial-contents
                                 (loop for i below voices collect
                                      (make-src :input (aref files i) 
                                                :srate (aref srcs i)
                                                :width src-width)))))
         (sexp-env (when srt-expt-env
                     (make-env :envelope srt-expt-env :duration real-dur )))
         (srtenv (make-env :envelope srt-env :duration real-dur))
         (renv (when rev-env 
                 (make-env :envelope rev-env :duration real-dur
                           :scaler rev-amt)))
         ;; We have a "central" sample which is used as a place from which we
         ;; can deviate when choosing grain starting points.  This is
         ;; incremented over the whole length of the input samples as we
         ;; progress through the algorithm.  We have to pace this so that we
         ;; use all the samples by the time we have finished the output file so
         ;; we calculate the increment here.
         (input-inc (/ (float num-input-samples) (float (- nd st))))
         (ampf (make-env :envelope amp-env :base amp-env-base :scaler amp
                         :duration real-dur))
         (gr-env (make-env :envelope grain-env
                           :duration real-dur)) 
         (dev-env (make-env :envelope center-deviation-env :duration real-dur))
         (s-env (when silence-env
                  (make-env :envelope silence-env :duration real-dur)))
         (srt-renv (when srt-random-env
                     (make-env :envelope srt-random-env :duration real-dur)))
         (gfe (when grain-focus-env 
                (make-env :envelope grain-focus-env :duration real-dur)))
         (min-grain-scaler (min (car grain-length-scalers)
                                (cadr grain-length-scalers)))
         (max-grain-scaler (max (car grain-length-scalers)
                                (cadr grain-length-scalers)))
         (grain-scaler-diff (- max-grain-scaler min-grain-scaler))
         ;; the grain length at the beginning (samples).
         (grain-length-beg (floor (* *srate* (second grain-env))))
         (pos 0.0)
         (1-minus-pos 0.0)
         ;; we use pos to put the sound between two speakers and
         ;; these vars to choose which speakers these will be
         (out1-chan 0)
         (out2-chan 0)
         ;; This number gets incremented by <input-inc> each time through the
         ;; run loop (hence it's a float).  Each time it gets to 1.0 or more,
         ;; we increment the input sample and reset it to 0.0.
         (counter 0.0)
         (current-input-sample 0)
         (gr-len-samples 0)  
         ;; This will hold the envelope value from <center-deviation-env>
         (deviation 0.0)
         ;; The deviation is randomised between 0.0 and <deviation> so this is
         ;; the actual value we will use.
         (random-deviation 0.0)
         ;; The start sample for the current grain.
         (start-sample 0)
         ;; How many samples are before <current-input-sample>.
         (before-current 0)
         ;; How many samples are after <current-input-sample>.
         (after-current 0)
         ;; Sample value for left channel.
         (out1 0.0)
         ;; Sample value for right channel.
         (out2 0.0)
         (ampval 0.0)
         ;; We have to window (ramp up/down) the grains.  This is the current
         ;; window sample used to scale the grain values.
         (scl 1.0)
         ;; Are we going to deviate before or after <current-input-sample> when
         ;; we randomly choose our grain start point.
         (up? nil)
         ;; This one is just for printing seconds computed.
         (count 0)
         (gr-len-warnings 0)
         (srt-warnings 0)
         (grain-index 0)
         (actual-grain-length 0)
         (do-grain t)
         (steady-begins ramp-len)
         (sample 0.0)
         (samps-needed 0)
         (s-val 0.0)
         (srt-renv-val 0.0)
         (sexp-val 0.0)
         (gfe-val 0.0)
         (srt-offset 0.0)
         (gr-val 0.0)
         (current-srt 0.0)
         (actual-srt 0.0)
         ;;  MDE Mon Sep  7 13:57:04 2015 
         (have-radius-env (and radius (listp radius)))
         (initial-radius (if have-radius-env (second radius) radius))
         (radius-env (when have-radius-env
                       (make-env :envelope radius :duration real-dur)))
         (have-freq-env (and freq (listp freq)))
         (initial-freq (if have-freq-env (second freq) freq))
         (freq-env (when have-freq-env
                     (make-env :envelope freq :duration real-dur)))
         (formant-fil (when radius (make-firmant initial-freq initial-radius)))
         (ramp-down-begins 0)
         (ramp-inc 1)
         ;; We do this here because we can't call make-fft-window inside run.
         (window (make-fft-window blackman2-window (* 2 ramp-len)))
         (ramp-up (make-array ramp-len :element-type 'double-float
                              :displaced-to window 
                              :displaced-index-offset 0))
         (ramp-down (make-array ramp-len :element-type 'double-float
                                :displaced-to window 
                                :displaced-index-offset ramp-len)))
    ;; The window created does not start and end with 0 so make it so.
    (setf (aref window 0) 0.0d0 ;;(make-short-float 0.0d0)
          (aref window (1- (car (array-dimensions window)))) 0.0d0
          ;;(make-short-float 0.0)
          )
    (when debug
      (format t "~&real-dur = ~f input-inc = ~f input-start-samples=~d ~
                  (~f secs) input-end-samples=~d (~f secs) ~%~%" 
              real-dur input-inc input-start-samples 
              (/ input-start-samples *srate*)
              input-end-samples (/ input-end-samples *srate*))
      (if do-src 
          (print "Using SRC")
          (print "Using INA")))
    (run
     (loop for voice below voices do
          #|
          (when do-src
          (declare (type (array sr) src-gens)
          (type (array io) files)))
          |#
           (declare (type :integer output-chans out1-chan out2-chan))
           (when (> voice 0)
             (restart-env ampf)
             (restart-env gr-env)
             (restart-env dev-env)
             (restart-env srtenv)
             (when radius-env (restart-env radius-env))
             (when freq-env (restart-env freq-env))
             (when grain-focus-env (restart-env gfe))
             (when silence-env (restart-env s-env))
             (when srt-random-env (restart-env srt-renv))
             (when srt-expt-env (restart-env sexp-env)))
           (setq current-input-sample input-start-samples
                 before-current 0
                 after-current num-input-samples
                 grain-index 0
                 gr-len-samples 
                 (if start-together 
                     0
                   (progn 
                     (setq do-grain nil)
                     (floor 
                      (if (<= grain-length-beg 
                              +SPLINTER-MIN-GRAIN-LENGTH+)
                          (+ +SPLINTER-MIN-GRAIN-LENGTH+
                             (random +SPLINTER-MIN-GRAIN-LENGTH+))
                        ;; 13/9/07: avoid randomness: make each voice start
                        ;; equally spaced across the opening grain length 
                        (* voice (/ grain-length-beg voices)))
                           ;; (+ +SPLINTER-MIN-GRAIN-LENGTH+
                           ;; (random (- grain-length-beg 
                           ;; +SPLINTER-MIN-GRAIN-LENGTH+)))
                           ))))
           (clm-print "~%~d" gr-len-samples)
           (loop for i from st to nd do
                 (when printing 
                   (if (= count *srate*)
                       (progn
                         (clm-print "~%Voice ~d/~d: ~d/~f secs"
                                    (+ 1 voice) voices 
                                    (round (/ i *srate*)) real-dur)
                         (setf count 1))
                     (incf count)))
                 ;; Get our envelope values.
                 (setq ampval (env ampf)
                       s-val (if silence-env (env s-env) 0.0)
                       sexp-val (if srt-expt-env (env sexp-env) 1.0)
                       gr-val (env gr-env)
                       srt-renv-val (when srt-random-env (env srt-renv))
                       deviation (env dev-env))
                 (incf counter input-inc)
                 ;; Time to increment our input sample?
                 (when (>= counter 1.0)
                   (incf current-input-sample)
                   (incf before-current)
                   (decf after-current)
                   (setq counter 0.0))
                 ;;
                 ;; START NEW GRAIN DATA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                 ;;
                 ;; Have we written out all the current grain's samples?  If so
                 ;; make a new grain:
                 (when (>= grain-index gr-len-samples)
                   ;; Silent grain?
                   (setq do-grain (if silence-env 
                                      (> (random 1.0) s-val)
                                    t)
                         ;; randomise the grain length based on the envelope
                         ;; value.  randomly choose whether to start the grain
                         ;; before or after our current input sample.
                         ;; clm's random function is not like lisp's as it 
                         ;; returns always a float, not an int, therefore this
                         ;; is a bit more complicated than a simple 
                         ;; (zerop (random 2))
                         up? (>= .5 (random 1.0))
                         ;; Get the deviation amount from our deviation
                         ;; envelope value.    
                         random-deviation (if (= deviation 0.0)
                                              0.0
                                            (random deviation))
                         pos (+ .05 (random .9))
                         1-minus-pos (- 1.0 pos)
                         out1-chan (random output-chans)
                         out2-chan (if (= out1-chan (1- output-chans))
                                       0
                                     (1+ out1-chan))
                         ;; Set the start sample based on whether we're going
                         ;; to start before or after the current sample and the
                         ;; random deviation.
                         actual-grain-length 
                         (* gr-val (+ min-grain-scaler 
                                      (random grain-scaler-diff)))
                         gr-len-samples (floor 
                                         (* *srate* actual-grain-length))
                         ;; the srt given for this voice
                         current-srt (when do-src (aref srcs voice))
                         ;; the srt we want, as given by the srt-expt-env
                         actual-srt (* (if srt-random-env
                                           (1+ (if up?
                                                   (random srt-renv-val)
                                                 (- (random srt-renv-val))))
                                         1.0)
                                       (if srt-expt-env
                                           (expt current-srt sexp-val)
                                         current-srt))
                         ;; what we'll have to add to the src gen to get our
                         ;; desired srt
                         srt-offset (if (or srt-expt-env srt-random-env)
                                           (- actual-srt current-srt)
                                         0.0)
                         samps-needed (if do-src
                                          (* gr-len-samples actual-srt)
                                        gr-len-samples)
                         start-sample 
                         (floor (if up? 
                                    (+ current-input-sample 
                                       (* after-current random-deviation))
                                  (- current-input-sample
                                     (* before-current random-deviation)))))
                   ;; (warn "~&out1-chan: ~a" out1-chan)
                   ;; (print out1-chan)
                   ;; Check to see if there's enough output samples left to 
                   ;; write our grain
                   (when (> (+ i gr-len-samples) nd)
                     ;; If there's not even enough for our min grain length
                     ;; then simply don't write the grain.
                     (if (> (+ i +SPLINTER-MIN-GRAIN-LENGTH+) nd)
                         (setq do-grain nil)
                       (setq gr-len-samples (- nd i))))
                   ;; Don't go past the end of the input samples.
                   (when (> (+ start-sample samps-needed)
                            input-end-samples) 
                     (setq start-sample (- input-end-samples samps-needed)))
                   ;; Don't try to start too soon!
                   (when (< start-sample input-start-samples)
                     (setq start-sample input-start-samples
                           gr-len-samples (floor (/ num-input-samples 
                                                    actual-srt)))
                     (when (< srt-warnings 30)
                       (clm-print "~%Not enough samps for grain len of ~fs."
                                  actual-grain-length)
                       (clm-print "~%   with an actual srt of ~f" actual-srt)
                       (clm-print "~%   num-input-samples = ~d" 
                                  num-input-samples)
                       (clm-print "~%   Grain length will be of ~d (~f secs)"
                                  gr-len-samples 
                                  (float (/ gr-len-samples *srate*)))
                       (incf srt-warnings)))
                   ;; Don't let the grain be smaller than our defined minimum. 
                   (when (< gr-len-samples +SPLINTER-MIN-GRAIN-LENGTH+)
                     (when (< gr-len-warnings 30)
                       (clm-print "~%Grain len too short. Changing ~d to ~d"
                                  gr-len-samples +SPLINTER-MIN-GRAIN-LENGTH+)
                       (incf gr-len-warnings))
                     (setq gr-len-samples +SPLINTER-MIN-GRAIN-LENGTH+))
                   ;; Get our ramp-down point.
                   (setq ramp-down-begins (- gr-len-samples ramp-len)
                         ramp-inc 1
                         current-ramp-len ramp-len
                         steady-begins current-ramp-len
                         ;; Reset the grain-index.
                         grain-index 0)
                   ;; If our grain length is too short for the ramp, adjust.
                   (when (< ramp-down-begins current-ramp-len)
                     (setq ramp-down-begins (floor gr-len-samples 2)
                           steady-begins ramp-down-begins
                           current-ramp-len ramp-down-begins
                           ;; Skip some of our ramp values so that we arrive
                           ;; at the end of the ramp in time.
                           ramp-inc (round ramp-len ramp-down-begins))
                     (when debug
                       (clm-print "~%ramp-down-begins ~d ramp-inc ~d"
                                  ramp-down-begins ramp-inc)))
                   (when do-src (setf (mus-location (aref src-gens voice)) 
                                  start-sample))
                   (when debug 
                     (clm-print 
                      "~%i = ~d (~f secs) current-input-sample = ~d (~f secs)"
                      i (/ i *srate*) 
                      current-input-sample 
                      (/ current-input-sample *srate*)))
                   (when print-grain-info
                     (clm-print "~%Grain start = ~d samps = ~f secs"
                                start-sample (/ start-sample *srate*))
                     (clm-print "~%   Grain length = ~d samps = ~f secs"
                                gr-len-samples 
                                (/ gr-len-samples *srate*))
                     (clm-print "~%   srt-offset=~f actual-srt=~f"
                                srt-offset actual-srt)
                     (clm-print "~%   ramp-inc = ~d grain index = ~d" 
                                ramp-inc grain-index)
                     (clm-print "~%   steady-begins ~d ramp-down-begins ~d"
                                steady-begins ramp-down-begins)))
                 ;;                 
                 ;; END NEW GRAIN DATA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                 ;;
                (unless debug
                  ;; MDE Mon Sep  7 14:11:22 2015 -- 
                  (when have-freq-env
                    (setf (mus-frequency formant-fil) (env freq-env)))
                  (when have-radius-env
                    (setf (mus-scaler formant-fil) (env radius-env)))
                  (if do-grain
                      (setq scl (cond ((< grain-index steady-begins) 
                                       (aref ramp-up 
                                             (floor (min 1-minus-ramp-len 
                                                         (* ramp-inc 
                                                            grain-index)))))
                                      ((< grain-index ramp-down-begins) 1.0)
                                      (t (aref ramp-down 
                                               (floor 
                                                (min 1-minus-ramp-len 
                                                     (- (* ramp-inc
                                                           grain-index)
                                                        ramp-down-begins))))))
                            gfe-val (if grain-focus-env
                                        (get-grain-amp (env gfe) voice voices
                                                       :min 
                                                       grain-focus-env-min
                                                       :expt 
                                                       grain-focus-env-expt)
                                        1.0)
                            sample (* scl gfe-val
                                      (if do-src
                                          (src (aref src-gens voice) 
                                               (+ (env srtenv) srt-offset))
                                          (in-any (+ grain-index start-sample) 
                                                  channel fil)))
                            sample (if radius
                                       (firmant formant-fil sample)
                                       sample)
                            out1 (* ampval 1-minus-pos sample)
                            out2 (* ampval pos sample))
                     (setq out1 0.0
                           out2 0.0))
                   ;; Write out the samples and reverb them.
                   (out-any i out1 out1-chan)
                   (out-any i out2 out2-chan)
                   (when *reverb* 
                     (outa i (* (if rev-env (env renv) rev-amt)
                                (/ (+ out1 out2) 2.0))
                           *reverb*)))
                 (incf grain-index))))
    (if do-src 
        (loop for v below voices do (close-input (aref files v)))
        (close-input fil))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#|

(with-sound (:statistics t :scaled-to .9 :reverb nrev :decay-time 3)
  (splinter "/snd/samples/slippery/clarinet/bass/bass-multi4.wav" 0
            :duration 5
            :rev-amt .005
            :voices 15  
            ;; :freq (sc::note-to-freq 'b4)
            ;; :radius .99
            ;; :center-deviation-env '(0 0 100 0) ;
            :ramp 1000
            :silence-env '(0 0 100 .79)
            :grain-env '(0 .3 60 0.2 100 .05 120 .005)
            :srt 1))

|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; EOF splinter.ins

