49 lines
1.2 KiB
Scheme
49 lines
1.2 KiB
Scheme
|
;; shepard tones (alberto de campo)
|
||
|
|
|
||
|
|
(import (rnrs) (sosc) (rsc3) (rhs))
|
||
|
|
|
||
|
|
(define iota
|
||
|
|
(lambda (n l j)
|
||
|
|
(if (= n 0)
|
||
|
|
nil
|
||
|
|
(cons l (iota (- n 1) (+ l j) j)))))
|
||
|
|
|
||
|
|
(define indxs
|
||
|
|
(lambda (n l r)
|
||
|
|
(iota n l (/ (- r l) n))))
|
||
|
|
|
||
|
|
(define hanning-window
|
||
|
|
(lambda (n)
|
||
|
|
(let* ((lp (* pi -0.5))
|
||
|
|
(rp (+ lp (* 2 pi)))
|
||
|
|
(hf (lambda (i) (+ (* (sin i) 0.5) 0.5))))
|
||
|
|
(map hf (indxs n lp rp)))))
|
||
|
|
|
||
|
|
(define square (lambda (x) (* x x)))
|
||
|
|
|
||
|
|
(define amp-table (map square (hanning-window 1024)))
|
||
|
|
|
||
|
|
(define amp-f (lambda (i) (* (expt 0.5 i) 20000)))
|
||
|
|
|
||
|
|
(define freq-table (map amp-f (indxs 1024 0 10)))
|
||
|
|
|
||
|
|
(define shepard-tones
|
||
|
|
(let* ((rate-scale (/ (/ 1024 44100) 10))
|
||
|
|
(rate 0.1)
|
||
|
|
(ph (phasor ar 0 (* rate rate-scale) 0 1024 0))
|
||
|
|
(phases (make-mce
|
||
|
|
(map
|
||
|
|
(lambda (n) (add (mul3 n 0.1 1024) ph))
|
||
|
|
(enum-from-to 0 9))))
|
||
|
|
(freqs (buf-rd-c 1 ar 1 phases 1))
|
||
|
|
(amps (buf-rd-c 1 ar 2 phases 1)))
|
||
|
|
(mul (mix (mul (sin-osc ar freqs 0) amps)) 0.1)))
|
||
|
|
|
||
|
|
(with-sc3
|
||
|
|
(lambda (fd)
|
||
|
|
(async fd (b-alloc 1 1024 1))
|
||
|
|
(async fd (b-alloc 2 1024 1))
|
||
|
|
(send fd (b-setn1 1 0 freq-table))
|
||
|
|
(send fd (b-setn1 2 0 amp-table))
|
||
|
|
(audition (out 0 shepard-tones))))
|