No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.

freeverb.scm 7.9KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208
  1. ;;; freeverb.scm -- CLM -> Snd/Scheme translation of freeverb.ins
  2. ;; Translator/Author: Michael Scholz <scholz-micha@gmx.de>
  3. ;; Last: Thu Apr 24 01:32:15 CEST 2003
  4. ;; Version: $Revision: 1.2 $
  5. ;;; Original notes of Fernando Lopez-Lezcano
  6. ;; Freeverb - Free, studio-quality reverb SOURCE CODE in the public domain
  7. ;;
  8. ;; Written by Jezar at Dreampoint, June 2000
  9. ;; http://www.dreampoint.co.uk
  10. ;;
  11. ;; Translated into clm-2 by Fernando Lopez-Lezcano <nando@ccrma.stanford.edu>
  12. ;; Version 1.0 for clm-2 released in January 2001
  13. ;; http://ccrma.stanford.edu/~nando/clm/freeverb/
  14. ;;
  15. ;; Changes to the original code by Jezar (by Fernando Lopez-Lezcano):
  16. ;; - the clm version can now work with a mono input or an n-channel input
  17. ;; stream (in the latter case the number of channels of the input and output
  18. ;; streams must match.
  19. ;; - the "wet" parameter has been eliminated as it does not apply to the model
  20. ;; that clm uses to generate reverberation
  21. ;; - the "width" parameter name has been changed to :global. It now controls the
  22. ;; coefficients of an NxN matrix that specifies how the output of the reverbs
  23. ;; is mixed into the output stream.
  24. ;; - predelays for the input channels have been added.
  25. ;; - damping can be controlled individually for each channel.
  26. ;; For more information see clm-2/freeverb/index.html [MS]
  27. ;;; changed to accommodate run and mono output, bill 11-Jun-06
  28. ;;; use the filtered-comb gen, bill 29-Jun-06
  29. ;;; optimized slightly, bill 17-Sep-12
  30. ;;; changed to use float-vectors, not frames and mixers 11-Oct-13
  31. ;;; Code:
  32. (provide 'snd-freeverb.scm)
  33. (if (provided? 'snd)
  34. (require snd-ws.scm)
  35. (require sndlib-ws.scm))
  36. (definstrument (freeverb
  37. (room-decay 0.5)
  38. (damping 0.5)
  39. (global 0.3)
  40. (predelay 0.03)
  41. (output-gain 1.0)
  42. output-mixer
  43. (scale-room-decay 0.28)
  44. (offset-room-decay 0.7)
  45. (combtuning '(1116 1188 1277 1356 1422 1491 1557 1617))
  46. (allpasstuning '(556 441 341 225))
  47. (scale-damping 0.4)
  48. (stereo-spread 23)
  49. (decay-time 1.0)
  50. verbose)
  51. (let ((startime 0.0)
  52. (dur (+ decay-time (mus-sound-duration (mus-file-name *reverb*))))
  53. (out-chans (channels *output*))
  54. (in-chans (channels *reverb*))
  55. (srate-scale (/ *clm-srate* 44100.0))
  56. (room-decay-val (+ (* room-decay scale-room-decay) offset-room-decay))
  57. (numcombs (length combtuning))
  58. (numallpasses (length allpasstuning)))
  59. (let ((beg (seconds->samples startime))
  60. (end (seconds->samples (+ startime dur)))
  61. (out-buf (make-float-vector out-chans))
  62. (f-out (make-float-vector out-chans))
  63. (f-in (make-float-vector in-chans))
  64. (predelays (make-vector in-chans))
  65. (fcombs (make-vector (* out-chans numcombs)))
  66. (allpasses (make-vector (* out-chans numallpasses)))
  67. (local-gain (if (= out-chans 1)
  68. global
  69. (+ (/ (- 1.0 global) (- 1 (/ 1.0 out-chans)))
  70. (/ 1.0 out-chans))))
  71. (global-gain 0.0))
  72. (set! global-gain (if (= out-chans 1)
  73. local-gain
  74. (/ (- out-chans (* local-gain out-chans))
  75. (- (* out-chans out-chans) out-chans))))
  76. (if verbose
  77. (format () ";;; freeverb: ~d input channels, ~d output channels~%" in-chans out-chans))
  78. (if (and (> in-chans 1)
  79. (not (= in-chans out-chans)))
  80. (error "input must be mono or input channels must equal output channels"))
  81. (let ((out-mix (or output-mixer
  82. (let ((v (make-float-vector (list out-chans out-chans))))
  83. (do ((i 0 (+ i 1)))
  84. ((= i out-chans))
  85. (do ((j 0 (+ j 1)))
  86. ((= j out-chans))
  87. (set! (v i j) (/ (* output-gain (if (= i j) local-gain global-gain)) out-chans))))
  88. v))))
  89. (do ((c 0 (+ 1 c)))
  90. ((= c in-chans))
  91. (set! (predelays c) (make-delay :size (round (* *clm-srate* (if (number? predelay) predelay (predelay c)))))))
  92. (do ((c 0 (+ 1 c)))
  93. ((= c out-chans))
  94. (do ((i 0 (+ i 1)))
  95. ((= i numcombs))
  96. (let ((len (floor (* srate-scale (combtuning i))))
  97. (dmp (* scale-damping (if (number? damping) damping (damping i)))))
  98. (if (odd? c)
  99. (set! len (+ len (floor (* srate-scale stereo-spread)))))
  100. (set! (fcombs (+ (* c numcombs) i))
  101. (make-filtered-comb :size len
  102. :scaler room-decay-val
  103. :filter (make-one-zero :a0 (- 1.0 dmp) :a1 dmp))))))
  104. (do ((c 0 (+ 1 c)))
  105. ((= c out-chans))
  106. (do ((i 0 (+ i 1)))
  107. ((= i numallpasses))
  108. (let ((len (floor (* srate-scale (allpasstuning i)))))
  109. (if (odd? c)
  110. (set! len (+ len (floor (* srate-scale stereo-spread)))))
  111. (set! (allpasses (+ (* c numallpasses) i))
  112. (make-all-pass :size len :feedforward -1 :feedback 0.5)))))
  113. (if (= out-chans in-chans 1)
  114. (let ((amp (out-mix 0 0))
  115. (pdelay (predelays 0)))
  116. (set! allpasses (make-all-pass-bank allpasses))
  117. (set! fcombs (make-filtered-comb-bank fcombs))
  118. (do ((i beg (+ i 1)))
  119. ((= i end))
  120. (outa i (* amp (all-pass-bank allpasses
  121. (filtered-comb-bank fcombs
  122. (delay pdelay (ina i *reverb*))))))))
  123. (let ((allp-c (make-vector out-chans))
  124. (fcmb-c (make-vector out-chans)))
  125. (do ((c 0 (+ c 1)))
  126. ((= c out-chans))
  127. (set! (allp-c c) (make-vector numallpasses))
  128. (set! (fcmb-c c) (make-vector numcombs)))
  129. (do ((c 0 (+ c 1)))
  130. ((= c out-chans))
  131. (do ((j 0 (+ j 1)))
  132. ((= j numcombs))
  133. (set! ((fcmb-c c) j) (fcombs (+ j (* c numcombs)))))
  134. (do ((j 0 (+ j 1)))
  135. ((= j numallpasses))
  136. (set! ((allp-c c) j) (allpasses (+ j (* c numallpasses)))))
  137. (set! (allp-c c) (make-all-pass-bank (allp-c c)))
  138. (set! (fcmb-c c) (make-filtered-comb-bank (fcmb-c c))))
  139. (if (= in-chans out-chans 5)
  140. (let ((allp0 (vector-ref allp-c 0))
  141. (allp1 (vector-ref allp-c 1))
  142. (allp2 (vector-ref allp-c 2))
  143. (allp3 (vector-ref allp-c 3))
  144. (allp4 (vector-ref allp-c 4))
  145. (fcmb0 (vector-ref fcmb-c 0))
  146. (fcmb1 (vector-ref fcmb-c 1))
  147. (fcmb2 (vector-ref fcmb-c 2))
  148. (fcmb3 (vector-ref fcmb-c 3))
  149. (fcmb4 (vector-ref fcmb-c 4))
  150. (dly0 (vector-ref predelays 0))
  151. (dly1 (vector-ref predelays 1))
  152. (dly2 (vector-ref predelays 2))
  153. (dly3 (vector-ref predelays 3))
  154. (dly4 (vector-ref predelays 4)))
  155. (do ((i beg (+ i 1)))
  156. ((= i end))
  157. (file->frample *reverb* i f-in)
  158. (float-vector-set! f-out 0 (all-pass-bank allp0 (filtered-comb-bank fcmb0 (delay dly0 (float-vector-ref f-in 0)))))
  159. (float-vector-set! f-out 1 (all-pass-bank allp1 (filtered-comb-bank fcmb1 (delay dly1 (float-vector-ref f-in 1)))))
  160. (float-vector-set! f-out 2 (all-pass-bank allp2 (filtered-comb-bank fcmb2 (delay dly2 (float-vector-ref f-in 2)))))
  161. (float-vector-set! f-out 3 (all-pass-bank allp3 (filtered-comb-bank fcmb3 (delay dly3 (float-vector-ref f-in 3)))))
  162. (float-vector-set! f-out 4 (all-pass-bank allp4 (filtered-comb-bank fcmb4 (delay dly4 (float-vector-ref f-in 4)))))
  163. (frample->file *output* i (frample->frample out-mix f-out out-chans out-buf out-chans))))
  164. (if (> in-chans 1)
  165. (do ((i beg (+ i 1)))
  166. ((= i end))
  167. (file->frample *reverb* i f-in)
  168. (do ((c 0 (+ c 1)))
  169. ((= c out-chans))
  170. (float-vector-set! f-out c (all-pass-bank (vector-ref allp-c c)
  171. (filtered-comb-bank (vector-ref fcmb-c c)
  172. (delay (vector-ref predelays c)
  173. (float-vector-ref f-in c))))))
  174. (frample->file *output* i (frample->frample out-mix f-out out-chans out-buf out-chans)))
  175. (let ((pdelay (predelays 0)))
  176. (do ((i beg (+ i 1)))
  177. ((= i end))
  178. (let ((val (delay pdelay (ina i *reverb*))))
  179. (do ((c 0 (+ c 1)))
  180. ((= c out-chans))
  181. (float-vector-set! f-out c (all-pass-bank (vector-ref allp-c c)
  182. (filtered-comb-bank (vector-ref fcmb-c c)
  183. val))))
  184. (frample->file *output* i (frample->frample out-mix f-out out-chans out-buf out-chans)))))))))))))
  185. ;;; (with-sound (:statistics #t :reverb freeverb :reverb-data '(:output-gain 3.0)) (outa 0 .5 *reverb*))
  186. ;;; (with-sound (:channels 2 :reverb-channels 2 :statistics #t :reverb freeverb :reverb-data '(:output-gain 3.0)) (outa 0 .5 *reverb*) (outb 0 .1 *reverb*))