Initial Commit
This commit is contained in:
parent
d1f5a8444c
commit
1578be63df
307
cicadas.xtm
Normal file
307
cicadas.xtm
Normal file
@ -0,0 +1,307 @@
|
||||
;;;;;; Preliminary stuff ;;;;;;
|
||||
(bind-val MAX_DELAY i64 44100)
|
||||
|
||||
;; Ring Buffer
|
||||
(bind-type RingBuffer <float*,i64,i64> (constructor? . #f))
|
||||
(bind-func RingBuffer:[RingBuffer*,i64]*
|
||||
(lambda (N)
|
||||
(let* ((p:float* (alloc N))
|
||||
(o:RingBuffer* (alloc))
|
||||
(i:i64 0))
|
||||
(tset! o 0 p)
|
||||
(tset! o 1 N)
|
||||
(tset! o 2 0)
|
||||
(dotimes (i N)
|
||||
(pset! p i (convert 0)))
|
||||
o)))
|
||||
|
||||
(bind-func data:[float*,RingBuffer*]* (lambda (rb) (tref rb 0)))
|
||||
(bind-func data:[void,RingBuffer*,float*]* (lambda (rb p) (tset! rb 0 p) void))
|
||||
(bind-func length:[i64,RingBuffer*]* (lambda (rb) (tref rb 1)))
|
||||
(bind-func length:[void,RingBuffer*,i64]* (lambda (rb c) (tset! rb 1 c) void))
|
||||
(bind-func offset:[i64,RingBuffer*]* (lambda (rb) (tref rb 2)))
|
||||
(bind-func offset:[void,RingBuffer*,i64]* (lambda (rb c) (tset! rb 2 c) void))
|
||||
|
||||
(bind-func first:[float,RingBuffer*]*
|
||||
(lambda (rb)
|
||||
(pref (data rb) (offset rb))))
|
||||
|
||||
(bind-func last:[float,RingBuffer*]*
|
||||
(lambda (rb)
|
||||
(pref (data rb) (% (+ (offset rb) (length rb)) (length rb)))))
|
||||
|
||||
(bind-func at:[float,RingBuffer*,i64]*
|
||||
(lambda (rb n)
|
||||
(pref (data rb) (% (+ (offset rb) n) (length rb)))))
|
||||
|
||||
(bind-func at:[void,RingBuffer*,i64,float]*
|
||||
(lambda (rb n x)
|
||||
(pset! (data rb) (% (+ (offset rb) n) (length rb)) x)
|
||||
void))
|
||||
|
||||
(bind-func shift:[float,RingBuffer*,float]*
|
||||
(lambda (rb x)
|
||||
(let ((y:float (at rb 0)))
|
||||
(at rb 0 x)
|
||||
(offset rb (% (+ 1 (offset rb)) (length rb)))
|
||||
y)))
|
||||
|
||||
(bind-func bing:[i1,RingBuffer*]*
|
||||
(lambda (rb)
|
||||
(= (offset rb) 0)))
|
||||
|
||||
|
||||
;; delay line based on ring buffer
|
||||
(bind-func delay_line_c:[[float,float,i64]*,i64]*
|
||||
(lambda (max_delay:i64)
|
||||
(let ((rb:RingBuffer* (RingBuffer max_delay)))
|
||||
(lambda (input tap)
|
||||
(shift rb input)
|
||||
(at rb tap)))))
|
||||
|
||||
|
||||
|
||||
;;;;;;;; Stochastic Parameters ;;;;;;;
|
||||
|
||||
;; simple bell curve
|
||||
(bind-func bell
|
||||
(lambda (width:float)
|
||||
(* (- (+ (dtof (random))
|
||||
(dtof (random))
|
||||
(dtof (random)))
|
||||
1.5) 0.75 width)))
|
||||
|
||||
(bind-type Param <float,float>)
|
||||
(bind-func val:[float,Param*]*
|
||||
(lambda (p) (tref p 0)))
|
||||
(bind-func sd:[float,Param*]*
|
||||
(lambda (p) (tref p 1)))
|
||||
(bind-func val:[float,Param*,float]*
|
||||
(lambda (p x) (tset! p 0 x) x))
|
||||
(bind-func sd:[float,Param*,float]*
|
||||
(lambda (p x) (tset! p 1 x) x))
|
||||
|
||||
(bind-func get:[float,Param*]*
|
||||
(lambda (p)
|
||||
(* (tref p 0)
|
||||
(+ 1.0 (bell (tref p 1))))))
|
||||
|
||||
(bind-alias warbler_t [float,Param*,Param*]*)
|
||||
|
||||
;; Oscillator with slightly randomly shifting frequency
|
||||
(bind-func warbler_c:[warbler_t,float]*
|
||||
(lambda (phase)
|
||||
(lambda (amp:Param* freq:Param*)
|
||||
(let ((inc (* STWOPI (/ (get freq) SRf))))
|
||||
(set! phase (+ phase inc))
|
||||
(if (> phase SPI) (set! phase (- phase STWOPI)))
|
||||
(* (get amp) (sin phase))))))
|
||||
|
||||
|
||||
;; pulse train
|
||||
(bind-alias pulser_t [float,Param*,Param*]*)
|
||||
|
||||
(bind-func pulser_c:[pulser_t,float]*
|
||||
(lambda (phi)
|
||||
(let ((t:i64 0)
|
||||
(phase:float phi))
|
||||
(lambda (w:Param* p:Param*)
|
||||
(let ((inc (/ 1.0 (get w))))
|
||||
(if (>= t (ftoi64 (get p)))
|
||||
(begin
|
||||
(set! phase 0.0)
|
||||
(set! t 0)))
|
||||
(set! t (+ t 1))
|
||||
(set! phase (+ phase inc))
|
||||
(if (> phase 1.0) (set! phase 1.0))
|
||||
(if (< phase 0.0) (set! phase 0.0))
|
||||
(+ 1.0 (cos (* SPI (- (* 2.0 phase) 1.0))))
|
||||
)))))
|
||||
|
||||
|
||||
|
||||
;;;; Onto the Cicadas
|
||||
|
||||
;; x_position y_position carrier-amp carrier-freq w1 w2 w3 p1 p2 p3 oscillator pulser1 pulser2 pulser3)
|
||||
(bind-type Cicada <float,float,Param*,Param*,Param*,Param*,Param*,Param*,Param*,Param*,warbler_t,pulser_t,pulser_t,pulser_t>)
|
||||
(bind-func x:[float,Cicada*]* (lambda (cicada) (tref cicada 0)))
|
||||
(bind-func y:[float,Cicada*]* (lambda (cicada) (tref cicada 1)))
|
||||
(bind-func amp:[Param*,Cicada*]* (lambda (cicada) (tref cicada 2)))
|
||||
(bind-func freq:[Param*,Cicada*]* (lambda (cicada) (tref cicada 3)))
|
||||
(bind-func w1:[Param*,Cicada*]* (lambda (cicada) (tref cicada 4)))
|
||||
(bind-func w2:[Param*,Cicada*]* (lambda (cicada) (tref cicada 5)))
|
||||
(bind-func w3:[Param*,Cicada*]* (lambda (cicada) (tref cicada 6)))
|
||||
(bind-func p1:[Param*,Cicada*]* (lambda (cicada) (tref cicada 7)))
|
||||
(bind-func p2:[Param*,Cicada*]* (lambda (cicada) (tref cicada 8)))
|
||||
(bind-func p3:[Param*,Cicada*]* (lambda (cicada) (tref cicada 9)))
|
||||
(bind-func warbler:[warbler_t,Cicada*]* (lambda (cicada) (tref cicada 10)))
|
||||
(bind-func pulser1:[pulser_t,Cicada*]* (lambda (cicada) (tref cicada 11)))
|
||||
(bind-func pulser2:[pulser_t,Cicada*]* (lambda (cicada) (tref cicada 12)))
|
||||
(bind-func pulser3:[pulser_t,Cicada*]* (lambda (cicada) (tref cicada 13)))
|
||||
|
||||
(bind-func x:[float,Cicada*,float]* (lambda (cicada val) (tset! cicada 0 val) val))
|
||||
(bind-func y:[float,Cicada*,float]* (lambda (cicada val) (tset! cicada 1 val) val))
|
||||
(bind-func amp:[Param*,Cicada*,Param*]* (lambda (cicada val) (tset! cicada 2 val) val))
|
||||
(bind-func freq:[Param*,Cicada*,Param*]* (lambda (cicada val) (tset! cicada 3 val) val))
|
||||
(bind-func w1:[Param*,Cicada*,Param*]* (lambda (cicada val) (tset! cicada 4 val) val))
|
||||
(bind-func w2:[Param*,Cicada*,Param*]* (lambda (cicada val) (tset! cicada 5 val) val))
|
||||
(bind-func w3:[Param*,Cicada*,Param*]* (lambda (cicada val) (tset! cicada 6 val) val))
|
||||
(bind-func p1:[Param*,Cicada*,Param*]* (lambda (cicada val) (tset! cicada 7 val) val))
|
||||
(bind-func p2:[Param*,Cicada*,Param*]* (lambda (cicada val) (tset! cicada 8 val) val))
|
||||
(bind-func p3:[Param*,Cicada*,Param*]* (lambda (cicada val) (tset! cicada 9 val) val))
|
||||
(bind-func warbler:[warbler_t,Cicada*,warbler_t]* (lambda (cicada val) (tset! cicada 10 val) val))
|
||||
(bind-func pulser1:[pulser_t,Cicada*,pulser_t]* (lambda (cicada val) (tset! cicada 11 val) val))
|
||||
(bind-func pulser2:[pulser_t,Cicada*,pulser_t]* (lambda (cicada val) (tset! cicada 12 val) val))
|
||||
(bind-func pulser3:[pulser_t,Cicada*,pulser_t]* (lambda (cicada val) (tset! cicada 13 val) val))
|
||||
|
||||
(bind-func Cicada:[Cicada*,float,float,Param*,Param*,Param*,Param*,Param*,Param*,Param*,Param*,float,float,float,float]*
|
||||
(lambda (x y amp freq w1 w2 w3 p1 p2 p3 carrier_phase pulse1_phase pulse2_phase pulse3_phase)
|
||||
(let ((carrier (warbler_c carrier_phase))
|
||||
(stridulator (pulser_c pulse1_phase))
|
||||
(blurter (pulser_c pulse2_phase))
|
||||
(phraser (pulser_c pulse3_phase))
|
||||
(output:Cicada* (alloc)))
|
||||
(tfill! output x y amp freq w1 w2 w3 p1 p2 p3 carrier stridulator blurter phraser)
|
||||
output)))
|
||||
|
||||
|
||||
;; distance from listener of cicada
|
||||
(bind-func r:[float,Cicada*]*
|
||||
(lambda (cicada)
|
||||
(let ((a (x cicada))
|
||||
(b (y cicada)))
|
||||
(sqrt (+ (* a a) (* b b))))))
|
||||
|
||||
;; angle from forwards of listener (assuming y is forwards/backwards, x is left right).
|
||||
;; positive azimuth is to the right, negative to the left
|
||||
(bind-func azi:[float,Cicada*]*
|
||||
(lambda (cicada)
|
||||
(atan2 (x cicada) (y cicada))))
|
||||
|
||||
(bind-type StereoFrame <float,float>)
|
||||
(bind-func left:[float,StereoFrame*]* (lambda (frame) (tref frame 0)))
|
||||
(bind-func right:[float,StereoFrame*]* (lambda (frame) (tref frame 1)))
|
||||
(bind-func left:[float,StereoFrame*,float]* (lambda (frame val) (tset! frame 0 val) val))
|
||||
(bind-func right:[float,StereoFrame*,float]* (lambda (frame val) (tset! frame 1 val) val))
|
||||
|
||||
(bind-func l2:[float,float,float]*
|
||||
(lambda (a b)
|
||||
(sqrt (+ (* a a) (* b b)))))
|
||||
|
||||
|
||||
(bind-alias stereo_chirper_t [StereoFrame*,Cicada*]*)
|
||||
|
||||
(bind-func stereo_chirper_c:[stereo_chirper_t]*
|
||||
(lambda ()
|
||||
(let ((left_pipe (delay_line_c MAX_DELAY))
|
||||
(right_pipe (delay_line_c MAX_DELAY))
|
||||
(output:StereoFrame* (StereoFrame 0.0 0.0)))
|
||||
(lambda (cicada)
|
||||
(let ((d (r cicada))
|
||||
(a (azi cicada))
|
||||
(d1 (l2 (- (x cicada) 0.17) (y cicada)))
|
||||
(d2 (l2 (+ (x cicada) 0.17) (y cicada)))
|
||||
(left_gain (sin (+ (/ a 2.) (/ SPI 4.0))))
|
||||
(right_gain (cos (+ (/ a 2.) (/ SPI 4.0))))
|
||||
(distance_gain (/ 1.0 (* d d)))
|
||||
(s:float (*
|
||||
((warbler cicada) (amp cicada) (freq cicada))
|
||||
((pulser1 cicada) (w1 cicada) (p1 cicada))
|
||||
((pulser2 cicada) (w2 cicada) (p2 cicada))
|
||||
((pulser3 cicada) (w3 cicada) (p3 cicada)))))
|
||||
(if (< d1 d2)
|
||||
(let ((left_sample:float (left_pipe s (min (ftoi64 (* SRf (/ (- d2 d1) 340.0))) MAX_DELAY)))
|
||||
(right_sample:float (right_pipe s 0)))
|
||||
(left output (* distance_gain left_gain left_sample))
|
||||
(right output (* distance_gain right_gain right_sample)))
|
||||
(let ((left_sample:float (left_pipe s 0))
|
||||
(right_sample:float (right_pipe s (min (ftoi64 (* SRf (/ (- d1 d2) 340.0))) MAX_DELAY))))
|
||||
(left output (* distance_gain left_gain left_sample))
|
||||
(right output (* distance_gain right_gain right_sample))))
|
||||
output)))))
|
||||
|
||||
|
||||
;; convenience function for scaled random number
|
||||
(bind-func rand:[float,float,float]*
|
||||
(lambda (a b)
|
||||
(let ((c (- b a))
|
||||
(r:float (dtof (random))))
|
||||
(+ a (* c r)))))
|
||||
|
||||
|
||||
;; A number of cicadas
|
||||
(bind-func dsp
|
||||
(let ((cicadas:|6,Cicada*|* (zalloc))
|
||||
(chirpers:|6,stereo_chirper_t|* (zalloc))
|
||||
(i 0))
|
||||
(dotimes (i 6)
|
||||
(aset! cicadas i (Cicada
|
||||
(rand -2.0 2.0) ;; x
|
||||
(rand 2.0 5.0) ;; y
|
||||
(Param 1.0 0.0) ;; amp
|
||||
(Param (rand 1500.0 3000.0) (rand 0.05 0.5)) ;; freq
|
||||
(Param (rand 200.0 400.0) (rand 0.05 0.5)) ;; w1
|
||||
(Param (rand 18000.0 27000.0) (rand 0.05 0.5));; w2
|
||||
(Param (rand 180000.0 230000.0) (rand 0.05 0.5)) ;; w3
|
||||
(Param (rand 900.0 1500.0) (rand 0.05 0.5)) ;; p1
|
||||
(Param (rand 20000.0 40000.0) (rand 0.05 0.5)) ;; p2
|
||||
(Param (rand 230000.0 300000.0) (rand 0.05 0.5)) ;; p3
|
||||
(rand 0.0 1.0) ;; carrier phase
|
||||
(rand 0.0 1.0) ;; pulse1 phase
|
||||
(rand 0.0 1.0) ;; pulse2 phase
|
||||
(rand 0.0 1.0) ;; pulse3 phase
|
||||
))
|
||||
(aset! chirpers i (stereo_chirper_c)))
|
||||
(lambda (a:float b:i64 c:i64 d:float*)
|
||||
(let ((vals:StereoFrame* (StereoFrame 0.0 0.0)) (i:i64 0))
|
||||
(dotimes (i 6)
|
||||
(let ((tmp:StereoFrame* ((aref chirpers i) (aref cicadas i))))
|
||||
(left vals (+ (left vals) (left tmp)))
|
||||
(right vals (+ (right vals) (right tmp)))))
|
||||
(cond ((= c 0) ;; left channel
|
||||
(* 0.25 (left vals)))
|
||||
((= c 1) ;; right channel
|
||||
(* 0.25 (right vals)))
|
||||
(else 0.0)))))) ;; any remaining channels
|
||||
|
||||
(dsp:set! dsp)
|
||||
|
||||
|
||||
;; Breath control
|
||||
(bind-func clampabs:[float,float,float,float]*
|
||||
(lambda (x:float a:float b:float)
|
||||
(let ((signx (/ x (fabs x)))
|
||||
(magx (fabs x)))
|
||||
(cond ((< magx a) (* signx a))
|
||||
((> magx b) (* signx b))
|
||||
(else x)))))
|
||||
|
||||
|
||||
(bind-func move:[void,|6,Cicada*|*,float]*
|
||||
(lambda (cicadas r)
|
||||
(let ((i:i64 0))
|
||||
(dotimes (i 6)
|
||||
(let ((cicada:Cicada* (aref cicadas i)))
|
||||
(x cicada (clampabs (* r (x cicada)) 0.1 100.0)))
|
||||
void))))
|
||||
|
||||
(define breathing-in #t)
|
||||
|
||||
(define loop
|
||||
(lambda (time)
|
||||
(move (dsp.cicadas)
|
||||
(if breathing-in 0.95 1.05))
|
||||
(callback time 'loop (+ time 2000))))
|
||||
|
||||
|
||||
;; start loop
|
||||
(loop (now))
|
||||
|
||||
|
||||
;; receive osc
|
||||
(define (osc-receive timestamp address . args)
|
||||
(cond ((string=? address "/in") (set! breathing-in #t) #t)
|
||||
((string=? address "/out") (set! breathing-in #f) #t)
|
||||
(else #f)))
|
||||
|
||||
(io:osc:start-server 8000 "osc-receive")
|
||||
Loading…
x
Reference in New Issue
Block a user