103 lines
2.6 KiB
Racket
103 lines
2.6 KiB
Racket
|
#lang racket
|
||
|
|
;; status - working as of 20220820
|
||
|
|
|
||
|
|
(require rsc3)
|
||
|
|
|
||
|
|
;; lin-sosc (rd)
|
||
|
|
|
||
|
|
(define two-pi (* 2.0 pi))
|
||
|
|
|
||
|
|
(define mk-line
|
||
|
|
(lambda (n l r)
|
||
|
|
(enum-from-then-to l (+ l (/ (- r l) n)) r)))
|
||
|
|
|
||
|
|
(define geom
|
||
|
|
(lambda (n i s)
|
||
|
|
(if (= n 0)
|
||
|
|
null
|
||
|
|
(cons i (geom (- n 1) (* i s) s)))))
|
||
|
|
|
||
|
|
(define mk-xline
|
||
|
|
(lambda (n l r)
|
||
|
|
(geom n l (expt (/ r l) (/ 1 n)))))
|
||
|
|
|
||
|
|
(define rng
|
||
|
|
(lambda (l r)
|
||
|
|
(let ((m (- l r)))
|
||
|
|
(lambda (e)
|
||
|
|
(+ l (* e m))))))
|
||
|
|
|
||
|
|
(define s-rng
|
||
|
|
(lambda (l r)
|
||
|
|
(let* ((m (/ (- l r) 2))
|
||
|
|
(n (+ m l)))
|
||
|
|
(lambda (e)
|
||
|
|
(+ n (* e m))))))
|
||
|
|
|
||
|
|
(define cmp
|
||
|
|
(lambda (f g)
|
||
|
|
(lambda (n)
|
||
|
|
(f (g n)))))
|
||
|
|
|
||
|
|
(define tbl-m
|
||
|
|
(lambda (b)
|
||
|
|
(play-buf 1 b (mul (mouse-x kr 0.001 1.0 0 0.1)
|
||
|
|
(buf-rate-scale kr b)) 0 0 1)))
|
||
|
|
|
||
|
|
(define tbl-c
|
||
|
|
(lambda (b c)
|
||
|
|
(play-buf 1 b (mul (in 1 kr c) (buf-rate-scale kr b)) 0 0 1)))
|
||
|
|
|
||
|
|
(define settr
|
||
|
|
(lambda (fd n)
|
||
|
|
(let* ((freq
|
||
|
|
(list
|
||
|
|
(mk-line n 440.0 444.0)
|
||
|
|
(mk-line n 40.0 16000.0)
|
||
|
|
(mk-xline n 40.0 16000.0)
|
||
|
|
(map (cmp (s-rng 20 21000) sin) (mk-line n 0 two-pi))
|
||
|
|
(map (cmp (s-rng 20 12000) cos) (mk-line n 0 two-pi))
|
||
|
|
(map (cmp (s-rng 20 22000) tan) (mk-line n -0.76 0.76))
|
||
|
|
(map (cmp (s-rng 20 90) tan) (mk-line n -0.76 0.76))))
|
||
|
|
(ampl
|
||
|
|
(list
|
||
|
|
(mk-line n 0.1 1.0)
|
||
|
|
(mk-line n 1.0 0.1)
|
||
|
|
(mk-line n 0.5 0.01)
|
||
|
|
(mk-line n 0.01 0.5)
|
||
|
|
(mk-xline n 1.0 0.1)
|
||
|
|
(mk-xline n 0.1 1.0)
|
||
|
|
(map sin (mk-line n 0.0 two-pi))
|
||
|
|
(map cos (mk-line n 0.0 two-pi))
|
||
|
|
(map (lambda (n) (* n 0.001))
|
||
|
|
(map tan (mk-line n 0.0 two-pi)))))
|
||
|
|
(f (choose freq))
|
||
|
|
(a (choose ampl)))
|
||
|
|
(send fd (b-setn1 0 0 f))
|
||
|
|
(send fd (b-setn1 1 0 a))
|
||
|
|
(send fd (c-set1 0 (choose (list 0.005 0.0075 0.01 0.025 0.05 0.075
|
||
|
|
0.1 0.25 0.5 0.75
|
||
|
|
0.8 0.85 1.0 1.005))))
|
||
|
|
(choose (list 0.01 0.05 0.1 0.15 0.25 0.5 0.75)))))
|
||
|
|
|
||
|
|
(define lsi
|
||
|
|
(clip2 (pan2 (mul (sin-osc ar (tbl-m 0) 0)
|
||
|
|
(tbl-m 1))
|
||
|
|
(tbl-c 1 0)
|
||
|
|
0.025)
|
||
|
|
0.25))
|
||
|
|
|
||
|
|
(define lin-sosc
|
||
|
|
(lambda (n)
|
||
|
|
(lambda (fd)
|
||
|
|
(async fd (b-alloc 0 n 1))
|
||
|
|
(async fd (b-alloc 1 n 1))
|
||
|
|
(play fd (out 0 lsi))
|
||
|
|
(letrec ((pattern
|
||
|
|
(lambda (fd)
|
||
|
|
(thread-sleep (settr fd n))
|
||
|
|
(pattern fd))))
|
||
|
|
(pattern fd)))))
|
||
|
|
|
||
|
|
(with-sc3 (lin-sosc 1024))
|