;;; -*- 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