;;; -*- syntax: common-lisp; base: 10; mode: lisp -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; File:             samp2.ins
;;;
;;; Purpose:          A 'sampling' instrument: performs high-quality
;;;                   sampling-rate conversion (transposition)  of a sound
;;;                   file.  
;;;
;;;                   When duration is nil the instrument automatically plays
;;;                   the whole input file either forwards (or backwards: if
;;;                   <reverse> is t).  
;;;
;;;                   If output duration > input duration then the whole input
;;;                   file will be played forwards then backwards until the
;;;                   duration is used up. 
;;;
;;;                   See the instrument parameters for more possibilities.
;;;
;;;                   This instrument was extended by Jules Rawlinson to
;;;                   include High and Low Pass filtering using the Butterworth
;;;                   filter (cload "mus:clm-3;butterworth.cl") and also
;;;                   supports various lfo modulations including amplitude,
;;;                   filter modulation, vibrato (pitch), and a hanning window
;;;                   for grain enveloping. Look for the hidden waveshaping!
;;;
;;;                   This was extended again in Feb 2013 by Michael Edwards to
;;;                   allow for multi-channel input file processesing.  If a
;;;                   mono input file is passed, we use locsig to locate in
;;;                   n-channel output space.  If the input has 2+ channels
;;;                   then the original spacing is retained and the same
;;;                   processing is applied to each channel successively.
;;;
;;; Authors:          Michael Edwards - m@michael-edwards.org
;;;                   Jules Rawlinson - j@pixelmechanics.com   
;;;
;;;
;;; $$ Last modified: 12:21:31 Mon Jun 24 2013 BST
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :clm)

;;; You must compile and load butterworth before doing the same with this ins;
;;; loading alone is not enough, e.g.
;;; (load (compile-file "/lisp/clm-4/butterworth.cl")) 

(definstrument samp2
    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;; Beginning of Instrument Parameters
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (file                   ;; Input file path
     time                   ;; Point of output in file in seconds
     &key                   ;; the following parameters are optional
     (duration nil)         ;; Output file duration; when nil then the whole
     ;; input file will be played. 
     ;; In Lisp, Yes/No or True/False (so-called
     ;; Booleans) are indicated by T and Nil.
     (reflect nil)          ;; When duration is nil, whether the input file
     ;; should play forwards then backwards.
     (reverse nil)          ;; Begin going backwards?
     (start 0)              ;; Input file start time (seconds).
     (end 0)                ;; Input-file end time (seconds).
     (srt 1.0)              ;; Sampling-rate Conversion: 1 = no 
     ;; transposition, 2 = oktave high, 0.5 = oktave
     ;; lower etc.
     (width 5)              ;; How many samples to convolve with the sinc table
     ;; (the higher the better but also the slower the
     ;; processing).
     (srt-env '(0 0 100 0)) ;; Sampling-rate Conversion Envelope (glissando);
     ;; when the y value is 0 there is no transposition
     ;; beyond that of srt.
     (srt-scaler 1.0)       ;; Scaler for srt-env.
     (amp 1.0)              ;; Amplitude, usually > 0.0 <= 1.0
     (amp-env '(0 1 100 1)) ;; Amplitude Envelope, y-values, like amplitude,
     ;; are usually > 0.0 <= 1.0.  amp is used as a
     ;; scaler for this envelope. 
     ;; MDE Fri Feb 15 19:46:28 2013 -- this will only be used given mono input
     (degree 45)            ;; Stereo Panning:  0 = left, 45 = middle, 90 =
     ;; right.
     (distance 0)           ;; A distance effect.  This is used to create a
     ;; combination of direct and reverberated signal.
     ;; Try values between 0 (no effect) and 100.
     (rev-env '(0 1 100 1)) ;; Reverberation Envelope
     (rev-amt 0)            ;; Reverberation.  0.1 quite a lot. This value is 
     ;; a scaler for rev-env
     (printing t) ;; Whether the number of seconds processed should
     ;; be printed to the lisp listener whilst running.

     ;; NEW FEATURES ADDED BY JULES RAWLINSON

     (wv-shp-amt nil) ;; waveshaping amount 
 
     (lp-two nil) ;; second pass lowpass
     (hp-two nil) ;; second pass hipass

     (amp-base 1.0) ;; Break-point curve base for amp-env
     (srt-base 1.0) ;; Break-point curve base for srt-env

     ;; amplitude options
     (amp-lfo-frq-env '(0 0 100 0)) ;; amp lfo frequency envelope
     (amp-lfo-amt-env '(0 0 100 0)) ;; amp lfo amount envelope

     ;; lp filter options
     (lpflt-frq nil)                      ;; base lowpass frequency
     (lpflt-frq-env '(0 22050 100 22050)) ;; frequency envelope, y = hz  
     (lpflt-lfo-frq-env '(0 0 100 0))     ;; filter lfo frequency envelope
     (lpflt-lfo-amt-env '(0 0 100 0))     ;; filter lfo amount envelope
     (lp-base 1.0)                        ;; lowpass breakpoint curve

     ;; hp filter options
     (hpflt-frq nil)                  ;; base hipass frequency
     (hpflt-frq-env '(0 1 100 1))     ;; frequency envelope, y = hz  
     (hpflt-lfo-frq-env '(0 0 100 0)) ;; filter lfo frequency envelope
     (hpflt-lfo-amt-env '(0 0 100 0)) ;; filter lfo amount envelope
     (hp-base 1.0)                    ;; hipass breakpoint curve

     ;; ringmod options
     (rm-frq nil)              ;; base ringmod frequency
     (rm-amp 1.0)              ;; ringmod amp
     (rm-amt-env '(0 0 100 0)) ;; ringmod amount
     (rm-frq-env '(0 1 100 1)) ;; frequency envelope, y = hz
     (rm-amt-base 1.0)         ;; ring mod amount brkpoint curve
     (rm-frq-base 1.0)         ;; ring mod frq env brkpoint curve

     ;; ampmod options
     (am-frq nil)              ;; base ringmod frequency
     (am-amp 1.0)              ;; ringmod amp
     (am-amt-env '(0 0 100 0)) ;; ringmod amount
     (am-frq-env '(0 1 100 1)) ;; frequency envelope, y = hz
     (am-amt-base 1.0)         ;; amp mod amount brkpoint curve
     (am-frq-base 1.0)         ;; amp frq env brkpoint curve

     ;; pitchmod options
     (pm-frq nil)              ;; base ringmod frequency
     (pm-amp 1.0)              ;; ringmod amp
     (pm-amt-env '(0 0 100 0)) ;; ringmod amount
     (pm-frq-env '(0 1 100 1)) ;; frequency envelope, y = hz

     (hanning nil) ;; implement a hanning window
     ;; rather than use an envelope
     )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; End of Instrument Parameters, beginning of Instrument Setup Code
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  ;; MDE Fri Feb 15 19:38:49 2013 -- added loop for each input file channel
  ;; here
  (let* ((input-chans (sound-chans file))
         (mono-in (= 1 input-chans))
         (st (floor (* time *srate*)))   ;; Output File Start Sample
         (start-sample (if (zerop start) ;; Input File Start Sample
                           0
                           (floor (* *srate* start))))
         ;; Input File End Sample
         (end-sample (if (zerop end)
                         (sound-frames file)
                         (floor (* *srate* end))))
         ;; The duration (seconds) of the input file, taking into consideration
         ;; whether we're reflecting or not. 
         (dur-full (/ (* (if reflect 2 1) 
                         (- end-sample start-sample))
                      srt
                      *srate*))
         ;; The actual output duration we'll use (seconds).
         (dur (if duration duration dur-full)))
    (loop for chan below input-chans do
         (let* ( ;; Input File Input/Output (I/O) Structure MDE Fri Feb 15
                ;; 19:38:23 2013 -- change to open-input* so we can have
                ;; directory search to find sndfiles
                (f (open-input* file :channel chan
                                :start (if (and reverse (zerop start))
                                           end-sample
                                           start-sample)))
                ;; The Sampling-Rate Conversion (SRC) Unit Generator
                (src-gen (make-src :input f :srate srt :width width))
                ;; The Sound Location Unit Generator
                ;; MDE Fri Feb 15 19:43:29 2013 -- use locsig only when mono
                ;; input, otherwise we map channel per channel, processing each
                ;; separately.
                (loc (when mono-in
                       (make-locsig :degree degree :distance distance :reverb
                                    rev-amt)))
                ;; The SRC envelope
                (senv (make-env :envelope srt-env :scaler srt-scaler
                                :offset 0.0 :duration dur :base srt-base))
                ;; The amplitude envelope
                (ampf (make-env :envelope amp-env :scaler amp 
                                :duration dur :base amp-base)) 
                ;; The reverb envelope
                (renv (make-env :envelope rev-env :scaler rev-amt   
                                :duration dur))
                (count 0) ;; used for printing only
                (ml 0)    ;; the current sample location of the SRC generator

                ;; NEW FIELDS ADDED BY JULES RAWLINSON

                (out-sig 0.0) ;; output sample object
                (lpflt-lfo 0.0) ;; lopass filter lfo object
                (hpflt-lfo 0.0) ;; hipass filter lfo object
                (amp-lfo 0.0)   ;; amplitude lfo object
                (am-sig 0.0)    ;; amp-mod object
                (rm-sig 0.0)    ;; ring-mod object
                (pm-sig 0.0)    ;; pitch-mod object
                (pm-max 0.594631) ;; 1 semitone

                ;; lowpass constructors
                ;; make the lowpass filter
                (lpflt (make-butterlp 22050))
                ;; make the filter frequency envelope
                (lpflt-frq-env (if lpflt-frq 
                                   ;; Y use the frequency as a scaler
                                   ;; for a basic envelope, so we
                                   ;; don't have to add switches in
                                   ;; code, more simple tho perhaps slower
                                   ;; as envelope is always calculated
                                   (make-env :envelope '(0 1 100 1)
                                             :duration dur :base lp-base
                                             :scaler lpflt-frq)
                                   ;; N use the default or variable envelope 
                                   (make-env :envelope lpflt-frq-env
                                             :duration dur :base lp-base)))
                ;; make the filter lfo (NB. a cosine)
                (lpflt-lfo-osc (make-oscil :frequency 440
                                           :initial-phase (/ pi 2.)))
                ;; make the oscillator frequency envelope
                (lpflt-lfo-frq-env (make-env :envelope lpflt-lfo-frq-env
                                             :duration dur ))
                ;; make the oscillator amount envelope
                (lpflt-lfo-amt-env (make-env :envelope lpflt-lfo-amt-env
                                             :duration dur ))
                ;; hipass constructors
                ;; make the hipass filter
                (hpflt (make-butterhp 1))
                ;; make the filter frequency envelope
                (hpflt-frq-env (if hpflt-frq 
                                   ;; Y use the frequency as a scaler
                                   ;; for a basic envelope, so we
                                   ;; don't have to add switches in
                                   ;; code, more simple tho perhaps slower
                                   ;; as envelope is always calculated
                                   (make-env :envelope '(0 1 100 1)
                                             :duration dur :base hp-base
                                             :scaler hpflt-frq)
                                   ;; N use the default or variable envelope 
                                   (make-env :envelope hpflt-frq-env
                                             :duration dur :base hp-base)))
                ;; make the filter lfo (NB. a cosine)
                (hpflt-lfo-osc (make-oscil :frequency 440
                                           :initial-phase (/ pi 2.)))
                ;; make the oscillator frequency envelope
                (hpflt-lfo-frq-env (make-env :envelope hpflt-lfo-frq-env
                                             :duration dur ))
                ;; make the oscillator amount envelope
                (hpflt-lfo-amt-env (make-env :envelope hpflt-lfo-amt-env
                                             :duration dur ))
                ;; amp constructors
                ;; make the amp lfo (NB. a cosine)
                (amp-lfo-osc (make-oscil :frequency 440
                                         :initial-phase (/ pi 2.)))
                ;; make the oscillator frequency envelope
                (amp-lfo-frq-env (make-env :envelope amp-lfo-frq-env
                                           :duration dur ))
                ;; make the oscillator amount envelope
                (amp-lfo-amt-env (make-env :envelope amp-lfo-amt-env
                                           :duration dur ))

                ;; ring-mod objects
                (rm-osc (make-oscil :frequency 440))
                (rm-amt-env (make-env :envelope rm-amt-env
                                      :scaler rm-amp
                                      :duration dur  :base rm-amt-base))
                (rm-frq-env (make-env :envelope rm-frq-env
                                      :duration dur :base rm-frq-base))

                ;; amp-mod objects
                (am-osc (make-oscil :frequency 440))
                (am-amt-env (make-env :envelope am-amt-env
                                      :scaler am-amp
                                      :duration dur :base am-amt-base))
                (am-frq-env (make-env :envelope am-frq-env
                                      :duration dur :base am-frq-base))

                ;; pitch-mod objects
                (pm-osc (make-oscil :frequency 440))
                (pm-amt-env (make-env :envelope pm-amt-env
                                      :scaler pm-amp
                                      :duration dur ))
                (pm-frq-env (make-env :envelope pm-frq-env
                                      :duration dur ))

                ;; THE END

                ;; The output file end sample
                (nd (+ st (floor (* *srate* dur)))))
           (when printing (format t "~&Start time ~a~%" time))
    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
           ;; End of the setup code, beginning of the run loop (sample
           ;; generation) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

           (run ;; This is the part that CLM translates into C, for speed
            (loop for i from st to nd do ;; from output file start sample to end
                 (when printing ;; print out each second we've computed
                   (if (= count *srate*)
                       (progn
                         (setq count 1)
                         (clm-print "~%~d secs" (round (/ i *srate*))))
                       (incf count)))
               ;; get the current sample
                 (setf ml (mus-location src-gen))
               ;; if we're past the last input sample start going backwards.
                 (when  (>= ml end-sample) 
                   (setf (mus-increment src-gen) (- srt)))
               ;; similarly, if we're before the first input sample, start going
               ;; forwards. 
                 (when (<= ml start-sample)
                   (setf (mus-increment src-gen) srt))
               ;; if we're reverbing, set the right reverb amount from the
               ;; rev-env 
                 (when *reverb* 
                   (setf (locsig-reverb-ref loc chan) (env renv)))

               ;; NEW FUNCTIONALITY ADDED BY JULES RAWLINSON - STILL 2 ADD
               ;; AMPLFO 

               ;; a detailed decription of lfo-ing
               ;; update the lowpass lfo osc freq
                 (setf (mus-frequency lpflt-lfo-osc) (env lpflt-lfo-frq-env))
               ;; update lfo amount
                 (setf lpflt-lfo (* (oscil lpflt-lfo-osc)
                                    (env lpflt-lfo-amt-env)))
               ;; get absolute value of lfo to ensure
               ;; that amount is always positive.
                 (setf lpflt-lfo (abs lpflt-lfo))
               ;; then the science bit...
               ;; -- in the case of lfo amount is zero...
               ;; as we don't want to multiply our input by zero we subtract 1 
               ;; from the output and again return only a positive value
               ;; to ensure that phase of attenuated signal is not inverted.
               ;; -- i.e. because our lfo is a cosine initial value is 1.
               ;; 1 (the lfo) * 0 (the lfo amount) = 0 
               ;; > 0 - 1 = -1 > abs 1 * our input = unchanged input
               ;; -- in the case of 100% lfo amount...
               ;; 1 * 1 = 1 > 1 - 1 = 0 > abs 0 * input = 0 output (if amp lfo)
                 (setf lpflt-lfo (abs (- lpflt-lfo 1.)))
               ;; finally update freq from freq-env * lfo output
                 (set-butterlp lpflt (* (env lpflt-frq-env) lpflt-lfo))

               ;; do it all again for the hipass filter
                 (setf (mus-frequency hpflt-lfo-osc) (env hpflt-lfo-frq-env)
                       hpflt-lfo (* (oscil hpflt-lfo-osc)
                                    (env hpflt-lfo-amt-env))
                       hpflt-lfo (abs hpflt-lfo)
                       hpflt-lfo (abs (- hpflt-lfo 1.)))
                 (set-butterhp hpflt (* (env hpflt-frq-env) hpflt-lfo))

               ;; now do it all again for the amplitude lfo
                 (setf (mus-frequency amp-lfo-osc)(env amp-lfo-frq-env)
                       amp-lfo (* (oscil amp-lfo-osc) (env amp-lfo-amt-env))
                       amp-lfo (abs amp-lfo)
                       amp-lfo (abs (- amp-lfo 1.)))

               ;; pitch-mod stage
                 (setf (mus-frequency pm-osc)(env pm-frq-env)
                       pm-sig (* (* (oscil pm-osc) pm-max) (env pm-amt-env)))

               ;; calculate our output sample
                 (setf out-sig (src src-gen (+ (env senv) pm-sig)))

               ;; amp-mod stage
                 (setf (mus-frequency am-osc)(env am-frq-env)
                       am-sig (* (oscil am-osc) (env am-amt-env))
                       am-sig (+ am-sig (- 1 (env am-amt-env)))
                       out-sig (* out-sig am-sig))

               ;; ring-mod stage
                 (setf (mus-frequency rm-osc)(env rm-frq-env)
                       rm-sig (* (oscil rm-osc) (env rm-amt-env))
                       rm-sig (- 1 rm-sig)
                       out-sig (* out-sig rm-sig))

               ;; scaling stage

               ;; waveshaping
                 (if wv-shp-amt
                     (setf out-sig (/ (* out-sig (+ (abs out-sig) wv-shp-amt)) 
                                      (+ (expt out-sig 2) 
                                         (* 
                                          (- wv-shp-amt 1) (abs out-sig)) 1))))
           
               ;; are we graining by hanning
                 (if hanning
                     ;; Y - scale via hanning function
                     (setf out-sig 
                           (* out-sig
                              (* 0.5 (- 1.0 (cos (/ (* (* pi 2) i) 
                                                    (- (floor (* *srate* dur))
                                                       1)))))))
                     ;; N - scale it by the amp-env
                     (setf out-sig (* out-sig (env ampf)))
                     )

               ;; scale the output sample by the amp lfo
                 (setf out-sig (* out-sig amp-lfo))
               ;; filter stage
               ;; lowpass filter the output
                 (setf out-sig (butterlp lpflt out-sig))
               ;; lopass second stage
                 (if lp-two 
                     (setf out-sig (butterlp lpflt out-sig)))
               ;; hipass filter the output
                 (setf out-sig (butterhp hpflt out-sig))
               ;; hipass second stage
                 (if hp-two 
                     (setf out-sig (butterhp hpflt out-sig)))
               ;; output in stereo space
                 (if mono-in
                     (locsig loc i out-sig)
                     (out-any i out-sig chan))
               ;; END NEW FUNCTIONS
                 ))
           ;; close our input file
           (close-input f)))))

    ;;;;;;;;;;;;;;;;;;;;;;;;
    ;; End of definistrument
    ;;;;;;;;;;;;;;;;;;;;;;;;

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

#|

(with-sound (:channels 4 :statistics t :srate 48000)
  (samp2 "/music/rei/max/snd/rei-bar13.aiff" 0
         :start 0.1 :duration 5))

(with-sound (:channels 4 :statistics t :srate 44100)
  (samp2 "feelin-beg.wav" 0 :degree 10))

(with-sound (:channels 1 :statistics t :srate 44100)
  (samp2 "feelin-beg.wav" 0 
         :duration 1.5 :amp-env '(0 0 30 .05 50 .01 95 1 100 0) :amp-base 100))
                

(with-sound (:scaled-to .99
              :channels 4
              :statistics t
              :reverb nrev
              :reverb-channels 2
              :srate 44100 
              :decay-time 3)
  (let* ((limit 40) (time 0.0))
    (loop for i below limit do
         (setf time (* i 0.3))
         (samp2 "/music/rei/max/snd/rei-bar13.aiff" time
                :start 0.1
                :end 0.2 
                :hpflt-frq (* 100 (+ i 0.001))
                :lpflt-frq (* 100 (+ i 0.001))
                :printing nil
                :srt (envelope-interp time '(0 20 40 1)) 
                :amp (envelope-interp time '(0 .99 40 0))
                :amp-env '(0 1 100 0)
                :duration 0.2
                :distance 10 
                :rev-amt 0.001))))

(with-sound (:scaled-to .99
         :channels 2 
         :statistics t
         :reverb nrev
         :srate 44100 
         :decay-time 3)
            (samp2 "bresson_edits/G3_flutes01.aif" 0
                   :start 0.1
                   :end 0.2 
                   :printing nil
                   :srt 1
                   :amp 1
                   :amp-env '(0 1 100 0)
                   :duration 0.2
                   :distance 10 
                   :rev-amt 0.001))

(with-sound (:scaled-to .99
         :channels 2 
         :statistics t
         :reverb nrev
         :srate 44100 
         :decay-time 3)
            (samp2 "bresson_edits/G3_flutes01.aif" 0
                   :start 0.1
                   :end 1
                   :printing nil
                   :srt 0.5
                   :amp 0.5 :wv-sig nil  :hpflt-frq 1500
                   :amp-env '(0 1 100 0)
                   :duration 5 :am-frq-env '(0 0 100 440)
                   :distance 10 :am-amt-env '(0 1 100 1)
                   :rev-amt 0.0001))

(with-sound (:scaled-to .99
         :channels 2 
         :statistics t
         :srate 44100 
         :decay-time 3)
            (samp2 "bresson_edits/A#3_pianopulse18.aif" 0
                   :start 0.02
                   :end 0.31
                   :printing nil
                   :srt 0.2 :width 50
                   :amp 4 :wv-sig nil
                   :amp-env '(0 1 100 1)
                   :duration 10
                   :distance 0
                   :rev-amt 0.0001))

|#
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; EOF
