summaryrefslogtreecommitdiff
path: root/demos/shepard.lsp
diff options
context:
space:
mode:
Diffstat (limited to 'demos/shepard.lsp')
-rw-r--r--demos/shepard.lsp195
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)))