summaryrefslogtreecommitdiff
path: root/test/fft.lsp
diff options
context:
space:
mode:
Diffstat (limited to 'test/fft.lsp')
-rw-r--r--test/fft.lsp211
1 files changed, 211 insertions, 0 deletions
diff --git a/test/fft.lsp b/test/fft.lsp
new file mode 100644
index 0000000..e1aea16
--- /dev/null
+++ b/test/fft.lsp
@@ -0,0 +1,211 @@
+;; this sample code is described in fft_tutorial.htm
+
+(setf fft1-class (send class :new '(sound length skip)))
+
+(send fft1-class :answer :next '() '(
+ (snd-fft sound length skip nil)))
+
+(send fft1-class :answer :isnew '(snd len skp) '(
+ (setf sound snd)
+ (setf length len)
+ (setf skip skp)))
+
+(defun make-fft1-iterator (sound length skip)
+ (send fft1-class :new (snd-copy sound) length skip))
+
+;; create a 1-second sinusoid with points samples at cycles hz:
+(defun short-sine (points cycles)
+ (control-srate-abs points (lfo cycles)))
+
+(defun fft-test ()
+ (let (fft-iter)
+ ;; signal will have 4 cycles in 32 points:
+ (setf fft-iter (make-fft1-iterator (short-sine 32 4) 32 32))
+ (display "fft-test" (send fft-iter :next))))
+
+(defun ifft-test ()
+ (let (fft-iter ifft-snd)
+ (setf fft-iter (make-fft1-iterator (short-sine 32 4) 32 32))
+ (setf ifft-snd (snd-ifft 0 32 fft-iter 32 NIL))
+ (display "fft-ifft" (snd-length ifft-snd 200))
+ (display "fft-ifft" (snd-samples ifft-snd 200)) ))
+
+
+; Test fft-test and ifft-test on a cosine using this redefinition:
+;
+; (defun short-sine (points cycles)
+; (control-srate-abs points (lfo cycles 1.0 *sine-table* 90.0)))
+
+
+(defun file-fft1 (filename frame-length skip)
+ (make-fft1-iterator (s-read filename) frame-length skip))
+
+
+(defun play-fft1 (iterator skip)
+ (play (snd-ifft 0 *sound-srate* iterator skip NIL)))
+
+;; a convenient sound file name (change this to one of your soundfiles):
+(setf sfn "D:\\brain\\outro\\soup.wav")
+
+(defun file-test () (play-fft1 (file-fft1 sfn 512 512) 512))
+
+
+(setf fft-hp-class (send class :new '(source bins)))
+
+
+(send fft-hp-class :answer :next '() '(
+ (let ((frame (send source :next)))
+ (cond (frame
+ (dotimes (i bins)
+ (setf (aref frame i) 0.0))))
+ frame)))
+
+
+(send fft-hp-class :answer :isnew '(s b) '(
+ (setf source s)
+ (setf bins b)))
+
+
+(defun make-fft-hp (source bins)
+ (send fft-hp-class :new source bins))
+
+
+(defun hp-test ()
+ (play-fft1 (make-fft-hp (file-fft sfn 512 512) 11) 512))
+
+
+(defun fm-tone (step mi1 mi2 mi3)
+ (let ((hz (step-to-hz step)))
+ (setf mi1 (* mi1 hz))
+ (setf mi2 (* mi2 hz))
+ (setf mi3 (* mi3 hz))
+ (fmosc c4 (partial step
+ (control-srate-abs *sound-srate*
+ (pwl 0 mi1 0.5 mi2 1 mi3 1))))))
+
+
+(defun mod-snd () (fm-tone c3 5 7 5)) ;; adjust FM parameters here
+
+
+(setf fft-modulator-class (send class :new '(src1 src2)))
+
+
+(send fft-modulator-class :answer :isnew '(s1 s2) '(
+ (setf src1 s1)
+ (setf src2 s2)))
+
+
+(send fft-modulator-class :answer :next '() '(
+ (let ((frame1 (send src1 :next))
+ (frame2 (send src2 :next))
+ n half_n)
+ (cond ((and frame1 frame2)
+ ; multiply frame2 by the amplitude coefficients of frame1
+ (setf (aref frame2 0) (* (aref frame2 0) (aref frame1 0))) ;; DC
+ (setf n (- (length frame1) 1))
+ ; Subtracted 1 because we already took care of DC component
+ (setf half_n (/ n 2)) ; integer divide
+ (dotimes (i half_n)
+ (let* ((i2 (+ i i 2))
+ (i2m1 (- i2 1))
+ (amp (sqrt (+ (* (aref frame1 i2m1) (aref frame1 i2m1))
+ (* (aref frame1 i2) (aref frame1 i2)))))) (setf (aref frame2 i2m1) (* (aref frame2 i2m1) amp))
+ (setf (aref frame2 i2) (* (aref frame2 i2) amp))))
+ (cond ((= n (+ half_n half_n 2)) ;; n is even -> nyquist component
+ (setf (aref frame2 n) (* (aref frame2 n) (aref frame1 n)))))
+ frame2)
+ (t nil)))))
+
+
+(defun make-fft-modulator (src1 src2)
+ (send fft-modulator-class :new src1 src2))
+
+
+(defun mod-test ()
+ (let ((fs 512)) ;; frame size
+ (play-fft1 (make-fft-modulator
+ (make-fft1-iterator (mod-snd) fs fs)
+ (file-fft1 sfn fs fs))
+ fs)))
+
+
+(defun raised-cosine ()
+ (scale 0.5
+ (sum (const 1)
+ (lfo (/ 1.0 (get-duration 1)) 1 *sine-table* 270))))
+
+
+(defun fft-window (frame-size)
+ (control-srate-abs frame-size (raised-cosine)))
+
+
+(defun play-fft (iterator frame-size skip)
+ (play (snd-ifft 0 *sound-srate* iterator
+ skip (fft-window frame-size))))
+
+
+(defun mod-test-w ()
+ (let ((fs 512)) ;; frame size
+ (play-fft (make-fft-modulator
+ (make-fft1-iterator (mod-snd) fs (/ fs 2))
+ (file-fft1 sfn fs (/ fs 2)))
+ fs (/ fs 2))))
+
+
+(setf fft-class (send class :new '(sound length skip window)))
+
+(send fft-class :answer :next '() '(
+ (snd-fft sound length skip window)))
+
+(send fft-class :answer :isnew '(snd len skp) '(
+ (setf sound snd)
+ (setf length len)
+ (setf skip skp)
+ (setf window (fft-window len)) ))
+
+(defun make-fft-iterator (sound length skip)
+ (send fft-class :new (snd-copy sound) length skip))
+
+(defun file-fft (filename frame-length skip)
+ (make-fft-iterator (s-read filename) frame-length skip))
+
+(defun mod-test-ww ()
+ (let ((fs 512)) ;; frame size
+ (play-fft (make-fft-modulator
+ (make-fft-iterator (mod-snd) fs (/ fs 2))
+ (file-fft sfn fs (/ fs 2)))
+ fs (/ fs 2))))
+
+(defun fft-test-w ()
+ (let (fft-iter)
+ ;; signal will have 4 cycles in 32 points:
+ (setf fft-iter (make-fft-iterator (short-sine 32 4) 32 32))
+ (display "fft-test-w" (send fft-iter :next))))
+
+(defun ifft-test-w ()
+ (let (fft-iter ifft-snd)
+ ;; this will generate two frames rather than one as before, and
+ ;; with a higher harmonic to help detect the window:
+ (setf fft-iter (make-fft1-iterator (short-sine 64 8) 32 32))
+ ;; window the result:
+ (setf ifft-snd (snd-ifft 0 32 fft-iter 24 (fft-window 32)))
+ (display "fft-ifft" (snd-length ifft-snd 200))
+ (display "fft-ifft" (snd-samples ifft-snd 200))
+ ifft-snd ))
+
+
+(defun mod-snd-2 () (fm-tone d3 15 27 15)) ;; adjust FM parameters here
+
+
+(defun mod-test-wwst ()
+ (let ((fs 1024)) ;; frame size
+ (play-fft (make-fft-modulator
+ (file-fft sfn fs (/ fs 8))
+ (make-fft1-iterator (transpose 2 (mod-snd-2)) fs (/ fs 8)))
+ fs (/ fs 2))))
+
+;; do analysis synthesis
+;;
+(defun fft-ifft (sound)
+ (play-fft (make-fft-iterator sound 1024 512) 1024 512))
+