Created
November 24, 2012 16:33
-
-
Save jbclements/4140406 to your computer and use it in GitHub Desktop.
An implementation of reverb for rsound.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#lang typed/racket | |
(require racket/flonum) | |
(require/typed (planet clements/rsound:4/network) | |
[#:struct network/s ([ins : Index] | |
[outs : Index] | |
[maker : Procedure])]) | |
;; this file provides the "reverb" network | |
(provide reverb) | |
;; this function produces a function from floats to floats. | |
(: starter (-> (Float -> Float))) | |
(define starter | |
(lambda () | |
;; constants here from Moorer 1979: | |
(define base-delay (* 100/1000 44100.0)) | |
(define d1 (inexact->exact (round base-delay))) | |
(define d2 (inexact->exact (round (* 1.1 d1)))) | |
(define d3 (inexact->exact (round (* 1.2 d1)))) | |
(define d4 (inexact->exact (round (* 1.3 d1)))) | |
(define d5 (inexact->exact (round (* 1.4 d1)))) | |
(define d6 (inexact->exact (round (* 1.5 d1)))) | |
(define g11 0.46) | |
(define g12 0.48) | |
(define g13 0.50) | |
(define g14 0.52) | |
(define g15 0.53) | |
(define g16 0.55) | |
(define g-konst 0.7) ;; how to choose? ? | |
(define g21 (* (- 1.0 g11) g-konst)) | |
(define g22 (* (- 1.0 g12) g-konst)) | |
(define g23 (* (- 1.0 g13) g-konst)) | |
(define g24 (* (- 1.0 g14) g-konst)) | |
(define g25 (* (- 1.0 g15) g-konst)) | |
(define g26 (* (- 1.0 g16) g-konst)) | |
(define v1 (make-flvector (inexact->exact (round d1)) 0.0)) | |
(define v2 (make-flvector (inexact->exact (round d2)) 0.0)) | |
(define v3 (make-flvector (inexact->exact (round d3)) 0.0)) | |
(define v4 (make-flvector (inexact->exact (round d4)) 0.0)) | |
(define v5 (make-flvector (inexact->exact (round d5)) 0.0)) | |
(define v6 (make-flvector (inexact->exact (round d6)) 0.0)) | |
;; the lpf midpoints | |
(define mvec (make-flvector 6 0.0)) | |
(define m1 0.0) | |
;(define m2 0.0) | |
;(define m3 0.0) | |
;(define m4 0.0) | |
;(define m5 0.0) | |
;(define m6 0.0) | |
;; the tap counters | |
(define c1 0) | |
(define c2 0) | |
(define c3 0) | |
(define c4 0) | |
(define c5 0) | |
(define c6 0) | |
;; the main feedback buffers | |
(lambda (in) | |
;; the first comb filter | |
(define delayed1 (flvector-ref v1 c1)) | |
(define midnode1 (fl+ delayed1 (fl* g11 m1))) | |
(define out1 (fl+ (fl* g21 midnode1) in)) | |
(flvector-set! v1 c1 out1) | |
(define next-c1 (add1 c1)) | |
(set! c1 (cond [(<= d1 next-c1) 0] | |
[else next-c1])) | |
(set! m1 midnode1) | |
;; the second comb filter | |
(define delayed2 (flvector-ref v2 c2)) | |
(define midnode2 (fl+ delayed2 (fl* g12 (flvector-ref mvec 1)))) | |
(define out2 (fl+ (fl* g22 midnode2) in)) | |
(flvector-set! v2 c2 out2) | |
(define next-c2 (add1 c2)) | |
(set! c2 (cond [(<= d2 next-c2) 0] | |
[else next-c2])) | |
(flvector-set! mvec 1 midnode2) | |
;; the third comb filter (and so on) | |
(define delayed3 (flvector-ref v3 c3)) | |
(define midnode3 (fl+ delayed3 (fl* g13 (flvector-ref mvec 2)))) | |
(define out3 (fl+ (fl* g23 midnode3) in)) | |
(flvector-set! v3 c3 out3) | |
(define next-c3 (add1 c3)) | |
(set! c3 (cond [(<= d3 next-c3) 0] | |
[else next-c3])) | |
(flvector-set! mvec 2 midnode3) | |
(define delayed4 (flvector-ref v4 c4)) | |
(define midnode4 (fl+ delayed4 (fl* g14 (flvector-ref mvec 3)))) | |
(define out4 (fl+ (fl* g24 midnode4) in)) | |
(flvector-set! v4 c4 out4) | |
(define next-c4 (add1 c4)) | |
(set! c4 (cond [(<= d4 next-c4) 0] | |
[else next-c4])) | |
(flvector-set! mvec 3 midnode4) | |
(define delayed5 (flvector-ref v5 c5)) | |
(define midnode5 (fl+ delayed5 (fl* g15 (flvector-ref mvec 4)))) | |
(define out5 (fl+ (fl* g25 midnode5) in)) | |
(flvector-set! v5 c5 out5) | |
(define next-c5 (add1 c5)) | |
(set! c5 (cond [(<= d5 next-c5) 0] | |
[else next-c5])) | |
(flvector-set! mvec 4 midnode5) | |
(define delayed6 (flvector-ref v6 c6)) | |
(define midnode6 (fl+ delayed6 (fl* g16 (flvector-ref mvec 5)))) | |
(define out6 (fl+ (fl* g26 midnode6) in)) | |
(flvector-set! v6 c6 out6) | |
(define next-c6 (add1 c6)) | |
(set! c6 (cond [(<= d6 next-c6) 0] | |
[else next-c6])) | |
(flvector-set! mvec 5 midnode6) | |
(* 0.1667 (+ out1 out2 out3 out4 out5 out6))))) | |
(: reverb network/s) | |
(define reverb | |
(network/s 1 1 starter)) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment