diff options
Diffstat (limited to 'leslie.cms')
| -rw-r--r-- | leslie.cms | 173 |
1 files changed, 79 insertions, 94 deletions
@@ -19,92 +19,49 @@ ;; ;; juanig@ccrma ;; -;; First version March 20, 2004 -;; Last update September 12, 2014 ;; ;; NOTES: ;; Get Leslie effect on a pulse-train waveshape. Try acceleration with the vel-envelope. ;; It can also be used to apply a Leslie effect to a soundfile. Just switch to the ;; 'make-readin', readin ug. ;; +;; First version: Sat 20 Mar 2004 11:22:47 AM PST +;; Last update: Wed 13 Nov 2019 04:13:30 PM PST +;; +;; HISTORY: ;; 06/20/2014 fixed delays and delay lines length ;; 09/10/2014 added reflection delay lines -;; 09/12/2014 added lowport baffle section using a lowpass butterworth +;; 09/12/2014 added lowport baffle section ;; 09/18/2014 S7 .cms version +;; 11/13/2019 Fixed delay line lengths and added a two-pole for the baffle part. +;; Removed butterworth in exchange for a two-pole frequency shifting. +;; ;; -;; +;; (define sspeed 345.12) ;; Velocity of sound (define twopi (* 2 pi)) (define oneturn (* pi 2)) - - -;; We need a Lowpass filter for the lower part, low frequency (baffle) -;; of the Leslie cabinet - - -;; A butterworth Lowpass filter (as in dsp.scm). - -(define (make-butter-low-pass fq) - (let* ((r (/ 1.0 (tan (/ (* pi fq) *clm-srate*)))) - (r2 (* r r)) - (c1 (/ 1.0 (+ 1.0 (* r (sqrt 2.0)) r2))) - (c2 (* 2.0 c1)) - (c3 c1) - (c4 (* 2.0 (- 1.0 r2) c1)) - (c5 (* (+ (- 1.0 (* r (sqrt 2.0))) r2) c1)) - (arra (make-float-vector 3 )) - (arrb (make-float-vector 3 ))) - (set! (arra 0) c1) - (set! (arra 1) c2) - (set! (arra 2) c3) - (set! (arrb 0) 0.0) - (set! (arrb 1) c4) - (set! (arrb 2) c5) - (make-filter 3 arra arrb) )) - - -;;; Macros to handle Lowpass filter ;; - -(define (butter f sample0) - (filter f sample0)) - - -;; macro to sweep frequencies +;;; ;; - -(define (sweep-butterfq b freq) - `(let* ((fq ,freq) - (r (/ 1.0 (tan (/ (* pi fq) *srate*)))) - (r2 (* r r)) - (c1 (/ 1.0 (+ 1.0 (* r (sqrt 2.0)) r2)))) - (set! (mus-xcoeff ,b 0) c1) - (set! (mus-xcoeff ,b 1) (* 2.0 c1)) - (set! (mus-xcoeff ,b 2) c1) - (set! (mus-ycoeff ,b 1) (* 2.0 (- 1.0 r2) c1)) - (set! (mus-ycoeff ,b 2) (* (+ (- 1.0 (* r (sqrt 2.0))) r2) c1)) - )) - - - -(definstrument (rotates start dur freq +(definstrument (rotates start dur freq (speedsl 3.33) ;; Speed source listener mts/sec (velenv '(0 1 100 1)) ;; Velocity envelope - (gain 0.125) ;; scales output - ;; (onset 0.0) ;; onset values in case of reading a soundfile + (gain 0.35) ;; scales output + ;; (onset 0.0) ;; onset duration (secs) in case of reading a soundfile (rev-amount 0.025)) ;; very short reverb (let* ((beg (seconds->samples start)) (sig (make-pulse-train :frequency freq)) - ;;; (rdA (make-readin :file file ;; just in case you want to read - ;;; :start (seconds->samples onset)) ;; a soundfile instead + ;; (rdA (make-readin :file infile ;; just in case you want to read + ;; :start (seconds->samples onset))) ;; a soundfile instead ;;; - (maxddelayl (if (= *clm-srate* 44100) (values 96) - (values 104))) - (startddelay (if (= *clm-srate* 44100) (values 48) - (values 52))) + (maxddelayl (if (= *clm-srate* 44100) (values 160) + (values 192))) + (startddelay (if (= *clm-srate* 44100) (values 48) + (values 52))) (m2samp (/ *clm-srate* sspeed)) (vel-env (make-env velenv :duration (* dur 0.5))) ;;; @@ -125,10 +82,9 @@ (fshift (make-vector 4)) (baffleout (make-vector 4)) ;; - (bfila (make-butter-low-pass 200)) - (bfilb (make-butter-low-pass 200)) - (bfilc (make-butter-low-pass 200)) - (bfild (make-butter-low-pass 200)) + ;; + (lpf (make-vector 4)) + ;; ;; (growf0 0.0) (growf1 0.0) @@ -156,8 +112,18 @@ ((= i 4 )) (set! (dpdelays i) (make-delay :size startddelay :max-size maxddelayl - :type mus-interp-linear)) - (set! (refldelays i) (make-delay ))) + :type mus-interp-linear + )) + (set! (refldelays i) (make-delay :size startddelay + :max-size (ceiling (* cabinetlen 2 m2samp)) + )) ) + ;; + ;; Make filters + ;; + (do ((i 0 (1+ i))) + ((= i 4 )) + (set! (lpf i) (make-two-pole :a0 0.304 :b1 0.62986 :b2 0.825)) + ) ;; ;; ;;; @@ -167,23 +133,27 @@ ((= i end )) ;; (let ((sample (pulse-train sig)) - ;;; (sample (readin rdA)) switch in case of reading a soundfile + ;; (sample (readin rdA)) ;; switch in case of reading a soundfile (deltavel (env vel-env)) - (sigouta 0.0) (sigoutb 0.0) ;; horn - (sigoutc 0.0) (sigoutd 0.0) ;; reflections + (sigouta 0.0) (sigoutb 0.0) ;; horn + (sigoutc 0.0) (sigoutd 0.0) ;; reflections (woofera 0.0) (wooferb 0.0)) ;; low baffle output ;; - ;; set acceleration of horn + ;;; set acceleration of horn + ;; (set! hornangvel (* speedsl deltavel)) (set! hornangle (+ hornangle (* twopi (/ hornangvel *clm-srate*)))) - ;; baffle lower port - (set! baffleangvel (* 0.98 speedsl )) + ;; + ;;; set motion parameter for baffle lower port + ;; + (set! baffleangvel (* 0.895 speedsl )) ;; 0.98 (set! baffleangle (+ baffleangle (* twopi (/ baffleangvel *clm-srate*)))) ;; (if (> hornangle twopi) (set! hornangle (- hornangle twopi))) (if (> baffleangle twopi) (set! baffleangle (- baffleangle twopi))) ;; - ;; calculate grow functions for delay line size (horn Doppler shifts) + ;;; calculate grow functions for delay line size (horn Doppler shifts) + ;; (set! growf0 (/ (*(* (- twopi) hornradius) (* hornangvel (cos hornangle))) sspeed)) (set! growf1 (/ (*(* (- twopi) hornradius) (* hornangvel (sin hornangle))) sspeed)) ;; @@ -197,7 +167,7 @@ (set! (hornout j ) (delay (dpdelays j) sample (dshift j))) ) ;; - ;; Reflections + ;;; Reflections ;; (set! xdev (* hornradius (cos hornangle))) (set! ydev (* hornradius (sin hornangle))) @@ -207,6 +177,7 @@ (set! (reflectlen 3) (* (+ cabinetlen xdev) m2samp)) ;; ;; Need to add these reflections to *reverb* + ;; (do ((j 0 (1+ j))) ((= j 4)) (set! (reflections j) (delay (refldelays j) @@ -218,45 +189,59 @@ (set! sigoutc (+ (reflections 0) (reflections 2))) (set! sigoutd (+ (reflections 1) (reflections 3))) ;; + ;; ;; Grow functions baffle low port section (set! growfa (* (- twopi) baffleradius baffleangvel (cos baffleangle))) (set! growfb (* (- twopi) baffleradius baffleangvel (sin baffleangle))) ;; - (set! (fshift 0) (+ 250 (* growfa 50))) - (set! (fshift 1) (+ 250 (* growfb 50))) - (set! (fshift 2) (+ 250 (* (- growfa) 50))) - (set! (fshift 3) (+ 250 (* (- growfb) 50))) + (set! (fshift 0) (+ 200 (* growfa 250))) + (set! (fshift 1) (+ 200 (* growfb 250))) + (set! (fshift 2) (+ 225 (* (- growfa) 250))) + (set! (fshift 3) (+ 225 (* (- growfb) 250))) + ;; + ;;; Filter for baffle low port section + ;; + (do ((k 0 (1+ k))) + ((= k 4)) + (set! (mus-frequency (lpf k)) (fshift k)) + (set! (mus-scaler (lpf k)) 0.938987) + ) + ;; + ;; + (do ((k 0 (1+ k))) + ((= k 4)) + (set! (baffleout k) (two-pole (lpf k) sample)) + ) ;; - (sweep-butterfq bfila (fshift 0)) - (sweep-butterfq bfilb (fshift 1)) - (sweep-butterfq bfilc (fshift 2)) - (sweep-butterfq bfild (fshift 3)) ;; - (set! (baffleout 0) (butter bfila sample)) - (set! (baffleout 1) (butter bfilb sample)) - (set! (baffleout 2) (butter bfilc sample)) - (set! (baffleout 3) (butter bfild sample)) + (set! woofera (* 0.175 (+ (baffleout 0) (baffleout 2)))) + (set! wooferb (* 0.175 (+ (baffleout 1) (baffleout 3)))) ;; - (set! woofera (+ (baffleout 0) (baffleout 2))) - (set! wooferb (+ (baffleout 1) (baffleout 3))) ;; (outa i (* gain (+ sigouta sigoutc woofera))) (outb i (* gain (+ sigoutb sigoutd wooferb))) - ;;; + ;; + ;;; in case of reverb + ;; (if *reverb* (progn - (outa i (* (* 0.5 gain) (+ sigoutc woofera) rev-amount) *reverb*) - (outb i (* (* 0.5 gain) (+ sigoutd wooferb) rev-amount) *reverb*) )) + (outa i (* (* 0.5 gain) (+ sigouta woofera) rev-amount) *reverb*) + (outb i (* (* 0.5 gain) (+ sigoutb wooferb) rev-amount) *reverb*) )) )) )) + ;;; (with-sound (:channels 2) (rotates 0 1 800)) ;;; (with-sound (:channels 2) (rotates 0 3 200)) ;;; (with-sound (:channels 2) (rotates 0 8 300 :speedsl 1.0)) ;;; (with-sound (:channels 2) (rotates 0 3 500 :speedsl 1.0)) -;;; (with-sound (:channels 2) (rotates 0 3 500 :velenv '(0 0 100 1))) +;;; (with-sound (:channels 2) (rotates 0 3 800 :velenv '(0 0.05 100 1))) ;;; (with-sound (:channels 2) (rotates 0 3 500 :velenv '(0 1 100 0.25))) +;;; (with-sound (:channels 2) (rotates 0 5 1000 :velenv '(0 0.25 50 1 100 0.3))) + + ;;; (load "nrev.ins") ;;; (with-sound (:channels 2 :reverb nrev :reverb-channels 2) (rotates 0 5 500 :velenv '(0 1 100 0.25))) + |