;;; -*- syntax: common-lisp; base: 10; mode: lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; File: formants.ins ;;; ;;; Purpose: Apply an arbitrary number of formant filters to an ;;; optionally transposed sound file. The parameters of the ;;; filters can be changed dynamically via envelopes. ;;; ;;; Author: Michael Edwards - m@michael-edwards.org ;;; ;;; $$ Last modified: 11:55:05 Tue Jul 5 2011 BST ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (in-package :clm) (defmacro get-formant-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)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun compute-radius (bw) ;; bw in Hz (exp (/ (* (- pi) bw) *srate*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun bw-env->radius-env (bw-env) (loop for x in bw-env by #'cddr and y in (cdr bw-env) by #'cddr collect x collect (compute-radius y))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun formant-chord-morph (chord1 chord2 &optional (envelope '(0 0 100 1))) (unless (= (length chord1) (length chord2)) (error "There must be the same number of notes in each chord: ~%~a ~%~a" chord1 chord2)) (loop for f1 in chord1 and f2 in chord2 collect (loop for x in envelope by #'cddr and y in (cdr envelope) by #'cddr collect x collect (+ f1 (* y (- f2 f1)))))) ;;; (formant-chord-morph '(100 200 300) '(200 400 600) '(0 .5 50 0 100 1)) ;;; => ((0 150.0 50 100 100 200) (0 300.0 50 200 100 400) ;;; (0 450.0 50 300 100 600)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (definstrument formants ;; (formants :c-file "~/ins/.cins/formants.c") (file time &key (duration 0) (start 0) (srt 1.0) (srt-scaler 1.0) (src-width 5) (mix '(0 1 100 1)) ; 0 is all original, 1 is all filtered (mix-scaler 1.0) (amp 1.0) ;; a list of either freqs in herz or envelopes; the length of this ;; list determines the number of formant filters. (freqs '()) ;; Hz, can be an envelope too whereupon this is the default envelope ;; for every formant. (default-bandwidth 100) ;; Each formant can have its own bandwidth too, by specifying the ;; formant number (1-based) and the bandwidth or envelope. ;; e.g. (1 300 2 10 4 (0 200 100 5)), the rest of the formants will ;; have the default. (bandwidths '()) (focus-env '()) (focus-env-min 0.1) (focus-env-expt 1.0) (amp-env '(0 1 100 1)) (rev-amt 0)) (unless (= (sound-chans file) (mus-channels *output*)) (warn "Input channels ~a, output channels ~a?" (sound-chans file) (mus-channels *output*))) (let* ((st (floor (* time *srate*))) (input-chans (sound-chans file)) (files (loop for i below input-chans collect (open-input* file :channel i :start (floor (* start *srate*))))) ;; (stereo (= 2 (sound-chans file))) ;; use in-any if we don't need to src (do-src (/= srt 1.0)) (src-gens (when do-src (make-array input-chans :initial-contents (loop for i below input-chans collect (make-src :input (nth i files) :srate srt :width src-width))))) (readins (unless do-src (make-array input-chans :initial-contents (loop for i below input-chans collect (make-readin :file (nth i files)))))) (dur (if (zerop duration) (sound-duration file) duration)) (ampf (make-env :envelope amp-env :scaler amp :duration dur)) (mix-env (make-env :envelope mix :scaler mix-scaler :duration dur)) (num-formants (length freqs)) (fe (when focus-env (make-env :envelope focus-env :duration dur))) (frqs (make-array num-formants :initial-contents (loop for fr in freqs collect (if (numberp fr) fr (make-env :envelope fr :duration dur))))) (default-radius (if (numberp default-bandwidth) (compute-radius default-bandwidth) .99)) (radii (make-array num-formants :initial-contents (loop repeat num-formants collect (if (numberp default-bandwidth) default-radius (make-env :envelope (bw-env->radius-env default-bandwidth) :duration dur))))) ;; any old radius and frequency is fine for now as it will be changed ;; in the run loop. (formant-filters (make-array (list input-chans num-formants) :initial-contents (loop for i below input-chans collect (loop for i below num-formants collect (make-formant default-radius 100))))) (count 0.0) (mix-val 0.0) (fe-val 0.0) (formant-amp-scaler 0.0) (pure-sigs (make-array input-chans)) ;; (pure-sig2 0.0) (filtered-sigs (make-array input-chans)) ;; (filtered-sig2 0.0) (freq 0.0) (temp nil) (amp-val 0.0) (radius 0.0) (nd (+ st (floor (* *srate* dur))))) (when bandwidths (loop for fmt in bandwidths by #'cddr and bw in (cdr bandwidths) by #'cddr do (when (or (< fmt 1) (> fmt num-formants)) (error "Illegal formant reference: ~a" fmt)) (setf (aref radii (1- fmt)) (if (numberp bw) (compute-radius bw) (make-env :envelope (bw-env->radius-env bw) :duration dur))))) (format t "~&Start time = ~f~%" time) (run (loop for i from st to nd do (when (= count *srate*) (setf count 0) (print (round (/ i *srate*)))) (incf count) (setf mix-val (env mix-env) amp-val (env ampf) fe-val (when focus-env (env fe))) (loop for j below input-chans do (setf (aref pure-sigs j) (if do-src (src (aref src-gens j)) (readin (aref readins j))) (aref filtered-sigs j) 0.0)) (dotimes (j num-formants) (setf temp (aref frqs j) freq (if (numberp temp) temp (env (aref frqs j))) temp (aref radii j) radius (if (numberp temp) temp (env (aref radii j))) formant-amp-scaler (if focus-env (get-formant-amp fe-val j num-formants :min focus-env-min :expt focus-env-expt) 1.0)) (loop for chan below input-chans do (setf (mus-frequency (aref formant-filters chan j)) freq (mus-formant-radius (aref formant-filters chan j)) radius) (incf (aref filtered-sigs chan) (* formant-amp-scaler (formant (aref formant-filters chan j) (aref pure-sigs chan)))))) (loop for c below input-chans for fs = (aref filtered-sigs c) for pure-sig = (aref pure-sigs c) do (out-any i (* amp-val (+ (* mix-val fs) (* (- 1.0 mix-val) pure-sig))) c)))) (loop for file in files do (close-input file)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; #| (with-sound (:statistics t :scaled-to .99 :channels 4 :play nil :srate 88200 :output "/temp/test.wav") (formants ;; "/music/24-7/splinter/88/24-7-spl-trash-00m52.553-to-00m53.101.wav" "c:\\music\\24-7\\splinter\\88\\24-7-spl-trash-00m52.553-to-00m53.101.wav" ;; "/snd/samples/slippery/clarinet/bass/bass-keys-breath1.wav" 0 :duration 5 ;;;:freqs '(100 1000 (0 100 100 5000)) :freqs '(100 1000 3000) ;;:mix '(0 .99 .99) ;;:focus-env '(0 1 100 0) :focus-env-min 0 :default-bandwidth '(0 10 100 1000) :bandwidths '(3 (0 10 100 1000)) )) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; EOF formants.ins