diff options
Diffstat (limited to 'demos/shepard.lsp')
-rw-r--r-- | demos/shepard.lsp | 195 |
1 files changed, 195 insertions, 0 deletions
diff --git a/demos/shepard.lsp b/demos/shepard.lsp new file mode 100644 index 0000000..8c528c5 --- /dev/null +++ b/demos/shepard.lsp @@ -0,0 +1,195 @@ +; Shepard tones and paradoxes + +; to use try +; (playscale (majorscale 60)) +; (playscale (minorscale 60)) +; (playscale (chromascale 60)) +; (playparadoxscale (chromascale 60)) + +; for shepard sweeps, try +; (play (sheptone-sweep 60 60 2 72 60 12 4)) + +; the signature of sheptone-sweep should tell what the parameters do +; (defun sheptone-sweep (pitch-1 centerpitch-1 duration pitch-2 centerpitch-2 +; overtonesemi overtones +; &optional (wavetable *sine-table*)) + +; Some notes about how this works: +; Shepard tones consist of harmonics that are an octave apart, thus +; the ratios are 1, 2, 4, 8, 16, etc. Note that the pitch is ambiguous +; in the sense that there could be a missing fundamental at 0.5, 0.25, etc. +; The other trick is that the spectral shape is constant. The amplitude +; of each harmonic is a function of its absolute frequency. Here, the +; shape is triangular so that as the frequency sweeps upward, harmonics +; (which are ramping up in frequency) fade in, reach a maximum, and fade out. +; +; In this implementation, each harmonic is generated using an FM oscillator +; controlled by a frequency ramp. The harmonic is multiplied by an envelope +; to implement the spectral shape function. The envelope is computed by +; running the frequency control (with some scaling) into a SHAPE function +; that uses a triangular table to implement the spectral shape. +; +; Warning: Although I have not analyzed this code too carefully, I (RBD) +; believe that the oscillators keep sweeping up to higher and higher +; frequencies even after the amplitude drops to zero. This is not only +; wasteful, but when oscillators start to alias, they run slower. If you +; generate a very long Shepard tone with harmonics spanning many octaves, +; the run time could get to be very large. A better implementation would +; start the harmonics when they enter the non-zero part of the spectral +; envelope and end them when they leave it. + + +(setf *onepi* 3.141592654) +(setf *twopi* (* 2 pi)) +(setf *halfpi* (/ pi 2)) + + +; envshaper is a raised cosine curve used to control +; the spectral shape. Its domain is 0 to 2 +; it transforms (0 2) into 0 1 +; it has to be used like +; (shape s (envshaper) 1) + +(defun envshaper () + (mult (sum 1 (hzosc (const (/ 1.0 2.0) 2) *table* 270)) 0.5)) + + +; some utility functions + +;; ISEQ-HELPER -- generates an integer sequence +(defun iseq-helper (a b) + (let ((mylist '())) + (dotimes (i (1+ (- b a)) (reverse mylist)) + (setf mylist (cons (+ a i) mylist))))) + +;; ISEQ -- sequence of integers from a to b +(defun iseq (a b) + (if (> a b) (reverse (iseq-helper b a)) + (iseq-helper a b))) + + +(defun floor (x) + (if (< x 0) + (1- (truncate x)) + (truncate x))) + + + +; the main part + +(defun sheptone-sweep-helper (pitch-1 centerpitch-1 + duration + pitch-2 centerpitch-2 + overtonesemi overtones + &optional (wavetable *sine-table*)) + (let ((mytone (const 0 duration)) + (maxovertones (+ (floor (/ (float (max (abs (- pitch-1 centerpitch-2)) + (abs (- pitch-1 centerpitch-2)))) + overtonesemi)) + overtones 2)) + (ampshaper (envshaper))) + ;; synthesize and sum maxovertones partials + (dolist (i (iseq (- maxovertones) maxovertones) mytone) + (progn + ;; partials start at pitch-1, spaced by overtonesemi (normally 12) + (setf startpitch (+ pitch-1 (* i overtonesemi))) + ;; partials end at pitch-2 + offset + (setf endpitch (+ pitch-2 (* i overtonesemi))) + ;; f is the frequency modulation (in hz) + (setf f (pwe 0 (step-to-hz startpitch) + duration (step-to-hz endpitch))) + ;; p is the pitch in steps + (setf p (pwl 0 startpitch duration endpitch)) + ;; c is the centerpitch curve + ;; (probably we could compute this outside the loop) + (setf c (pwl 0 centerpitch-1 duration centerpitch-2)) + ;; normwidthfactor is used to map pitch curves into the spectral shape + ;; function (range 0 to 2) + (setf normwidthfactor (/ 1.0 (* overtones overtonesemi))) + ;; a is the amplitude envelope: f(p - c) + (setf a (shape (mult (diff p c) normwidthfactor) + ampshaper 1)) + ;; voice is one partial + (setf voice (mult a (hzosc f wavetable))) + ;; sum the partials into mytone + (setf mytone (sum mytone voice)) + ) + ))) + + +(defun sheptone-sweep (pitch-1 centerpitch-1 duration pitch-2 centerpitch-2 + overtonesemi overtones + &optional (wavetable *sine-table*)) + (normalize ;; note: you might not want to normalize as is done here + ;; use an envelope to get a smooth start and stop + (mult (sheptone-sweep-helper pitch-1 centerpitch-1 + duration + pitch-2 centerpitch-2 + overtonesemi overtones wavetable) + (env 0.05 0 0.05 1 1 1 duration)))) + + +;; SHEPTONE is a special case of sheptone-sweep. +;; The spectral centroid and pitch is constant. +(defun sheptone (pitch centerpitch duration + overtonesemi overtones + &optional (wavetable *sine-table*)) + (sheptone-sweep pitch centerpitch duration pitch centerpitch + overtonesemi overtones + wavetable)) + +(defun majorscale (basepitch) + (mapcar (lambda (x) (+ basepitch x)) '(0 2 4 5 7 9 11 12))) + +(defun minorscale (basepitch) + (mapcar (lambda (x) (+ basepitch x)) '(0 2 3 5 7 8 10 12))) + +(defun chromascale (basepitch) + (mapcar (lambda (x) (+ basepitch x)) (iseq 0 12))) + + +;; MAKE-TABLE turns a function of 0-1 into a lookup table +(defun make-table (func-exp points) + (let ((table (make-array points))) + (dotimes (i points) + (setf (aref table i) + (funcall func-exp (/ (float i) (float points))))) + (list (snd-from-array 0.0 points table) (hz-to-step 1) T) + )) + + +(defun erich-wave (skew) + (make-table + (lambda (x) (if (< (abs skew) 0.000001) (sin (* *twopi* x)) + (* + (/ (sin (* *twopi* x)) (- (/ 1.0 skew) + (cos (* *twopi* x)))) + (/ (sqrt (- 1.0 (* skew skew))) skew)))) + 2048)) + + +;; NORMALIZE -- normalize a sound +;; +(defun normalize (s &optional (maxvol 0.8) (maxlen 44100)) + (let* ((mysound s) + (vol (peak mysound maxlen))) + (scale (/ (float maxvol) vol) mysound))) + +(defun playsafe (s) + (play (normalize s))) + +;; PLAYSCALE uses SHEPTONE to synthesize a scale that goes up on every +;; step, but never actually ends up an octave higher +;; +(defun playscale (scaleseq &optional (duration 1) (wavetable *sine-table*)) + (mapcar (lambda (x) (play (sheptone x 60 duration 12 4 wavetable))) + scaleseq)) + + +;; PLAYPARADOXSCALE uses sheptone to go up by half steps, yet end up +;; an octave lower than it starts +;; +(defun playparadoxscale (scaleseq + &optional (duration 1) (wavetable *sine-table*)) + (mapcar (lambda (x y) (play (sheptone x y duration 12 4 wavetable))) + scaleseq (reverse scaleseq))) |