;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; jc-lissajous.cms ;; ;; juanig_at-ccrma ;; ;; DESCRIPTION: ;; Panning a noise source around four or eight channels by means ;; of intensity panning using J. Chowning's Turenas Lissajous' ;; functions. ;; ;; ;; ;; EQUATIONS: ;; yt = cos(3*pi*t) + cos(7*pi*t) ;; xt = sin(2*pi*t) + sin(6*pi*t) ;; ;; NOTES: Works with prolonged sounds ;; ;; ;; DATE: Wed 20 Sep 2006 10:44:12 AM PDT ;; MODIFIED: Thu Sep 22 10:03:53 AM PDT 2022 ;; ;; (define twopi (* 8. (atan 1.))) (define halfpi (* 2. (atan 1.))) (define samprate (seconds->samples 1)) (define sspeed 343) (define (distn->samples dist) (floor (* dist (/ samprate sspeed))) ) (define nchans 4) ;; ;; ;; ;; ;; Gain at position: quadrant in reference to speaker. ;; (define (gainfn rho spkpos distf nchs) (let* ((diff (- spkpos rho)) (in-between-angle (/ twopi nchs)) ) (if (>= (abs diff) in-between-angle) (values 0) (* (cos diff) distf)) )) ;; ;; ;; A moving sound source function definition. ;; ;; =========================================== ;; (define* (lissajous beg dur (frq 800) (cycles 1) (nch nchans) (rev-amt 0.025)) (let* ((start (seconds->samples beg)) (flt (make-two-pole :radius .998 :frequency frq)) (ran1 (make-rand 8000 0.00750)) ;; get some noise (zeta (* cycles halfpi)) ;; start angular position (theta zeta) ;; position in time (dsize (distn->samples 10)) ;; 2.0 Min distn (maxdllsz (distn->samples 1000)) ;; Max delay (distn) (dll (make-delay dsize :max-size maxdllsz)) ;; delay line (speaker (make-vector nch)) ;; speaker position array (gains (make-vector nch)) ;; gains array (outsig (make-vector nch)) ;; final signals (end (+ start (seconds->samples dur)))) ; ; Initialize speaker positions ; degrees: -45; 45; 135; -135; ; (do ((k 0 (1+ k))) ((= k nch )) (let ((rads (+ (/ pi nch) (* k (/ twopi nch)))) (idx (- (1- nch) (modulo (1+ k) nch)))) (set! (speaker idx) (- pi rads)) )) ;; ;; ; main " generate signal" loop ;; ; ---------------------------- ;; (do ((i start (1+ i))) ((= i end)) ;; (let* ((insig (rand ran1)) ;; noise unit generator ;; ; J. Chowning Lissajous equations ;; (yt (+ (cos (* 3 pi theta)) (cos (* 7 pi theta)))) (xt (+ (sin (* 2 pi theta)) (cos (* 6 pi theta)))) ;; ; New position angle (polar coordinates) ;; (rho (atan yt xt)) ;; ; distance of sound source from origin ;; (dfn0 (sqrt (+ (* xt xt) (* yt yt)))) ; ; distance cannot be zero ; becasue we get infinite ; gain (signal blows) ; (distn (+ dfn0 1.998)) ;; ; inverse squared distance (invsqd (/ (* distn distn))) ; change filter center freq (cfq (+ (- frq 50) (* 256 (/ (1+ dfn0))))) ; two-pole filter (noi (two-pole flt insig)) ) ;; ;; ; change filter center freq (set! (mus-frequency flt) cfq) ;; ;; ;; calculate gain for each speaker ;; (do ((j 0 (1+ j))) ((= j nch)) (let ((gf (gainfn rho (speaker j) invsqd nch))) (set! (gains j) (* gf 5.998)) )) ;; ;; ;; Generate Doppler motion plus output signal ;; ;; ------------------------------------------ ;; (do ((j 0 (1+ j))) ((= j nch)) (let ((gfn (gains j))) (set! (outsig j) (* gfn (+ (* .075 noi) (* .375 (delay dll noi (* 4747 (/ (1+ dfn0)))) ))) ))) ;; ;; ;; --> Here we start output ;; (do ((k 0 (1+ k))) ((= k nch)) (out-any i (* .625 (outsig k)) k) ;; ;; ;; add reverb! ;; (if *reverb* (let ((dist-scaler (* 2.725 invsqd)) ) (out-any i (* (outsig k) (* rev-amt dist-scaler)) k *reverb*) ) ) ) ;; ;; ;; Increment grow angle function ;; ;; ----------------------------- ;; (set! theta (- theta (/ (* .25 cycles pi) end))) (if (< theta (- zeta)) (set! theta zeta)) )) )) ;; ;; ;; - E N D - ;; ;; ----------------------------- ;; ;;; (with-sound ( :channels 4) (lissajous 0 80 :nch 4 :cycles 4)) ;;; (with-sound ( :channels 4) (lissajous 0 20 :nch 4)) ;;; (with-sound ( :channels 4) (lissajous 0 12 :nch 4 :cycles 2)) ;;; (with-sound ( :channels 4 :reverb nrev :reverb-channels 4) (lissajous 0 20 :nch 4)) ;;; (load "jcrev.scm") ;;; (with-sound (:channels 4 :reverb jc-reverb :reverb-channels 4) (lissajous 0 10 :nch 4)) ;;; (load "freeverb.scm") ;;; (with-sound (:channels 8 :reverb freeverb) (lissajous 0 20 :nch 8)) ;; eight channels ;;; (with-sound (:channels 4 :reverb freeverb :reverb-channels 4) (lissajous 0 10 :nch 4 )) ;;; (with-sound (:channels 4 :reverb freeverb :reverb-channels 4) (lissajous 0 20 :nch 4)) ;;; (with-sound (:channels 4 :reverb freeverb :reverb-channels 4) (lissajous 0 40 :nch 4 :cycles 4)) ;;; (with-sound (:channels 4 :reverb freeverb :reverb-channels 4) (lissajous 0 80 :nch 4 :cycles 4)) ;;;