;;; -*- syntax: common-lisp; base: 10; mode: lisp -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; File:             add-noise-filtered.ins
;;;
;;; Purpose:          Do two things to original signal: First randomize it to 
;;;                   make noise in the proportion given by the noise-env--0
;;;                   will be original signal, 1 will be all random (white
;;;                   noise).  Then add a formant filter to this but have the
;;;                   frequency of the formant controlled by an envelope, the
;;;                   limits of which are given in the list freq.  This moving
;;;                   formant is a bit complicated.  We need to set the freq
;;;                   component of the structure created by make-formnt but
;;;                   make-formnt calls make-frmnt which calls make-ppolar
;;;                   which calls make-two-pole which calls (finally) the
;;;                   default structure constructor make-smpflt.  It would be
;;;                   nice to be able to set the frmnt-tp field in formant-fil
;;;                   to (make-ppolar R new-freq) but a call to make-ppolar
;;;                   won't work in run.  So we have to trace the structures
;;;                   all the way down and set the field manually.  The b1
;;;                   field of smpflt is the one that uses the frequency info
;;;                   so we'll just steal the formula (in mus.lisp) for making
;;;                   b1 from make-ppolar and put it in the run loop.  Now we
;;;                   should have an instrument that can do all the usual src
;;;                   stuff alone, or by using the right envelopes gradually
;;;                   add or take away noise, add a bit or a lot of formant
;;;                   filtering or do both.  Hopefully.
;;;
;;; Author:           Michael Edwards - m@michael-edwards.org
;;;
;;; $$ Last modified: 11:37:59 Thu Apr 21 2016 WEST
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :clm)

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

(defmacro randomise (in-sig random-amount)
  `(let* ((temp (1+ ,in-sig))           ;convenient to have signal
                                        ;between 0 and 2 
          ;; choose randomly to go up or down except when in-sig is 1 or -1, 
          ;; whereupon we have to go down or up respectively.
          ;; "case" would have been nice here and it's supposed to be
          ;; OK in the run loop but I got lots of nasty compiler
          ;; warnings when I tried it. 
          (up-or-down (cond ((= temp 0.0) 1) ; go up
                            ((= temp 2.0) 0) ; go down
                            (t (random 2)))) 
          ;; pick a random number that, when added to temp will not
          ;; take us beyond the limits of 0 and 2.  Multiply this by
          ;; random-amount. 
          (random-num (* ,random-amount 
                         (if (zerop up-or-down) ; we're going down
                             (- (random temp))
                             (random (- 2.0 temp)))))) ; going up
     (1- (+ temp random-num))))

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

(definstrument add-noise-filtered
    ;; (add-noise-filtered :c-file "~/ins/.cins/add-noise-filtered.c")
    (file time &key
          (R 0.95)                      ; Radius of filter (0--1)
          (duration 0)
          (start 0) 
          (srt 1.0) 
          (srt-env '(0 0 100 0))
          (srt-scaler 1.0)
          (filter-mix '(0 1 100 1))     ; 0 is all original, 1 is all filtered
          (noise-env '(0 0 100 0))      ; no noisifying
          (base 3)                      ; Exponent noise envelope is raised to
          (amp 1.0) 
          (amp-env '(0 1 100 1)) 
          (degree 45)
          (freq '(16 16))               ; lower/upper frequency limits of
                                        ; formant filter envelope (freq-env)
          (freq-env '(0 0 100 1))
          (distance 0)
          (reflect nil)
          (rev-env '(0 1 100 1)) 
          (rev-amt 0) )
  (let* ((st (floor (* time *srate*)))
         (stereo-in (= 2 (sound-chans file)))
         (stereo-out (= 2 (mus-channels *output*)))
         (input-start-sample (* start *srate*))
         (f (open-input* file :start input-start-sample))
         (f2 (when stereo-in
               (open-input* file :channel 1 :start input-start-sample)))
         (src-genA (make-src :input f :srate srt ))
         (src-genB (when stereo-in 
                     (make-src :input f2 :srate srt)))
         (dur (if (zerop duration) (sound-duration f) duration))
         (senv (make-env :envelope srt-env :scaler srt-scaler :offset 0.0 
                         :duration dur))
         (ampf (make-env :envelope amp-env :scaler amp :duration dur)) 
         (limits (if (listp freq) freq (list freq freq))) 
         (lower (car limits))
         (upper (cadr limits))
         (mix-env (make-env :envelope filter-mix :duration dur)) 
         (freq-envelope (make-env :envelope freq-env :scaler (- upper lower) 
                                  :offset lower :duration dur)) 
         (noisef (make-env :envelope noise-env :duration dur :base base))
         ;; noise is added too fast when we have a '(0 0 100 1)
         ;; envelope so scale the noise by the following extremely
         ;; exponential envelope which is proven empirically to make a
         ;; nice transition from pure signal to noise. 
         (hidden-env (make-env :envelope noise-env :base 1300 :duration dur))
         (renv (make-env :envelope rev-env :scaler rev-amt :duration dur))
         (formant-filA (make-formant lower R))
         (formant-filB (make-formant lower R))
         (count 0) 
         (nd (+ st (floor (* *srate* dur)))))
    (format t "~%Start time = ~f~%" time)
    (run
     (loop for i from st to nd do
          (setf count (if (= count *srate*)
                          1
                          (1+ count)))
          (when (= count *srate*)
            (print (round (/ i *srate*))))
          (let* ((rev-env-val (env renv))
                 (freq-val (env freq-envelope))
                 (mix-val (env mix-env))
                 (noise-val (* (env hidden-env) (env noisef)))
                 (senv-val (env senv))
                 (pure-sigA (src src-genA senv-val))
                 (pure-sigB (when stereo-in (src src-genB senv-val)))
                 (noised-sigA (if (zerop noise-val)
                                  pure-sigA
                                  (randomise pure-sigA noise-val)))
                 (noised-sigB (when stereo-in
                                (if (zerop noise-val)
                                    pure-sigB
                                    (randomise pure-sigB noise-val))))
                 (filtered-sigA (progn
                                  (setf (mus-frequency formant-filA) freq-val)
                                  (formant formant-filA noised-sigA)))
                 (filtered-sigB (when stereo-in
                                  (progn
                                    (setf (mus-frequency formant-filB)
                                          freq-val)
                 (formant formant-filB noised-sigB))))
                 ;;(filtered-sigA noised-sigA)
                 ;; (filtered-sigB noised-sigB)
                 (env-val (env ampf))
                 (one-minus-mix-val (- 1.0 mix-val))
                 (outa-val (* env-val
                              (+ (* mix-val filtered-sigA)
                                 (* one-minus-mix-val noised-sigA))))
                 (outb-val (when stereo-in
                             (* env-val
                                (+ (* mix-val filtered-sigB)
                                   (* one-minus-mix-val noised-sigB)))))
                 (rev-val (/ (+ outa-val outb-val) 2.0)))
            (when *reverb*
              (outa i (* rev-env-val rev-val) *reverb*))
            (if stereo-out 
                (progn
                  (outa i outa-val)
                  (if stereo-in
                      (outb i outb-val)
                      (outb i outa-val)))
                (outa i rev-val)))))
    (close-input f)))


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

#|
(with-sound (:statistics t :channels 2 :scaled-to .5)
            (add-noise-filtered "/snd/samples/misc/nile.wav" 0
                                :duration 5
                                :r .999
                                :noise-env '(0 0.0 100 .6)
                                ;; :noise-env '(0 0.0 100 0.0)
                                :base 100
                                ;; :freq '(1100 110)
                                :freq '(80 5000)
                                ;; :filter-mix '(0 0 100 1)
                                :filter-mix '(0 1 100 1)
                                ;;:amp-env '(0 .1 50 .1  99 1 100 0)
                                ))

|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; EOF add-noise-filtered.ins

