freeverb.scm 7.84 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
;;; freeverb.scm -- CLM -> Snd/Scheme translation of freeverb.ins

;; Translator/Author: Michael Scholz <scholz-micha@gmx.de>
;; Last: Thu Apr 24 01:32:15 CEST 2003
;; Version: $Revision: 1.2 $

;;; Original notes of Fernando Lopez-Lezcano

;; Freeverb - Free, studio-quality reverb SOURCE CODE in the public domain
;;
;; Written by Jezar at Dreampoint, June 2000
;; http://www.dreampoint.co.uk
;;
;; Translated into clm-2 by Fernando Lopez-Lezcano <nando@ccrma.stanford.edu>
;; Version 1.0 for clm-2 released in January 2001
;; http://ccrma.stanford.edu/~nando/clm/freeverb/
;;
;; Changes to the original code by Jezar (by Fernando Lopez-Lezcano):
;; - the clm version can now work with a mono input or an n-channel input
;;   stream (in the latter case the number of channels of the input and output
;;   streams must match.
;; - the "wet" parameter has been eliminated as it does not apply to the model
;;   that clm uses to generate reverberation
;; - the "width" parameter name has been changed to :global. It now controls the
;;   coefficients of an NxN matrix that specifies how the output of the reverbs
;;   is mixed into the output stream.
;; - predelays for the input channels have been added.
;; - damping can be controlled individually for each channel.

;; For more information see clm-2/freeverb/index.html [MS]

;;; changed to accommodate run and mono output, bill 11-Jun-06
;;;            use the filtered-comb gen, bill 29-Jun-06
34 35
;;; optimized slightly, bill 17-Sep-12
;;; changed to use float-vectors, not frames and mixers 11-Oct-13
36 37 38 39

;;; Code:

(provide 'snd-freeverb.scm)
40 41 42
(if (provided? 'snd)
    (require snd-ws.scm)
    (require sndlib-ws.scm))
43 44

(definstrument (freeverb
45 46 47 48 49 50 51 52 53 54 55 56 57 58
		(room-decay 0.5)
		(damping 0.5)
		(global 0.3)
		(predelay 0.03)
		(output-gain 1.0)
		output-mixer
		(scale-room-decay 0.28)
		(offset-room-decay 0.7)
		(combtuning '(1116 1188 1277 1356 1422 1491 1557 1617))
		(allpasstuning '(556 441 341 225))
		(scale-damping 0.4)
		(stereo-spread 23)
		(decay-time 1.0)
		verbose)
59
  (let ((dur (+ decay-time (mus-sound-duration (mus-file-name *reverb*))))
60 61 62 63 64 65
	(out-chans (channels *output*))
	(in-chans (channels *reverb*))
	(srate-scale (/ *clm-srate* 44100.0))
	(room-decay-val (+ (* room-decay scale-room-decay) offset-room-decay))
	(numcombs (length combtuning))
	(numallpasses (length allpasstuning)))
66
    (let ((end (seconds->samples dur))
67 68 69
	  (out-buf (make-float-vector out-chans))
	  (f-out (make-float-vector out-chans))
	  (f-in (make-float-vector in-chans))
70 71 72 73 74 75 76 77 78 79 80 81 82 83
	  (predelays (make-vector in-chans))
	  (fcombs (make-vector (* out-chans numcombs)))
	  (allpasses (make-vector (* out-chans numallpasses)))
	  (local-gain (if (= out-chans 1)
			  global
			  (+ (/ (- 1.0 global) (- 1 (/ 1.0 out-chans)))
			     (/ 1.0 out-chans))))
	  (global-gain 0.0))

      (set! global-gain (if (= out-chans 1)
			    local-gain
			    (/ (- out-chans (* local-gain out-chans))
			       (- (* out-chans out-chans) out-chans))))
      (if verbose
84
	  (format () ";;; freeverb: ~d input channels, ~d output channels~%" in-chans out-chans))
85 86
      (if (and (> in-chans 1)
	       (not (= in-chans out-chans)))
87
	  (error 'wrong-type-arg "input must be mono or input channels must equal output channels"))
88 89

      (let ((out-mix (or output-mixer
90
		       (let ((v (make-float-vector (list out-chans out-chans))))
91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
			 (do ((i 0 (+ i 1)))
			     ((= i out-chans))
			   (do ((j 0 (+ j 1)))
			       ((= j out-chans))
			     (set! (v i j) (/ (* output-gain (if (= i j) local-gain global-gain)) out-chans))))
			 v))))

	(do ((c 0 (+ 1 c)))
	    ((= c in-chans))
	  (set! (predelays c) (make-delay :size (round (* *clm-srate* (if (number? predelay) predelay (predelay c)))))))

	(do ((c 0 (+ 1 c)))
	    ((= c out-chans))
	  (do ((i 0 (+ i 1)))
	      ((= i numcombs))
106 107
	    (let ((len (floor (* srate-scale (combtuning i))))
		  (dmp (* scale-damping (if (number? damping) damping (damping i)))))
108 109 110 111 112 113 114 115 116 117
	      (if (odd? c)
		  (set! len (+ len (floor (* srate-scale stereo-spread)))))
	      (set! (fcombs (+ (* c numcombs) i))
		    (make-filtered-comb :size len 
					:scaler room-decay-val 
					:filter (make-one-zero :a0 (- 1.0 dmp) :a1 dmp))))))
	(do ((c 0 (+ 1 c)))
	    ((= c out-chans))
	  (do ((i 0 (+ i 1)))
	      ((= i numallpasses))
118
	    (let ((len (floor (* srate-scale (allpasstuning i)))))
119 120 121 122 123 124 125 126 127 128 129 130
	      (if (odd? c)
		  (set! len (+ len (floor (* srate-scale stereo-spread)))))
	      (set! (allpasses (+ (* c numallpasses) i))
		    (make-all-pass :size len :feedforward -1 :feedback 0.5)))))
	
	(if (= out-chans in-chans 1)
	    
	    (let ((amp (out-mix 0 0))
		  (pdelay (predelays 0)))
	      (set! allpasses (make-all-pass-bank allpasses))
	      (set! fcombs (make-filtered-comb-bank fcombs))
	      
131
	      (do ((i 0 (+ i 1)))
132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
		  ((= i end))
		(outa i (* amp (all-pass-bank allpasses
					      (filtered-comb-bank fcombs
								  (delay pdelay (ina i *reverb*))))))))

	    (let ((allp-c (make-vector out-chans))
		  (fcmb-c (make-vector out-chans)))
	      (do ((c 0 (+ c 1)))
		  ((= c out-chans))
		(set! (allp-c c) (make-vector numallpasses))
		(set! (fcmb-c c) (make-vector numcombs)))
	      (do ((c 0 (+ c 1)))
		  ((= c out-chans))
		(do ((j 0 (+ j 1)))
		    ((= j numcombs))
		  (set! ((fcmb-c c) j) (fcombs (+ j (* c numcombs)))))
		(do ((j 0 (+ j 1)))
		    ((= j numallpasses))
		  (set! ((allp-c c) j) (allpasses (+ j (* c numallpasses)))))
		(set! (allp-c c) (make-all-pass-bank (allp-c c)))
		(set! (fcmb-c c) (make-filtered-comb-bank (fcmb-c c))))
	      

	      (if (= in-chans out-chans 5)
		  (let ((allp0 (vector-ref allp-c 0))
			(allp1 (vector-ref allp-c 1))
			(allp2 (vector-ref allp-c 2))
			(allp3 (vector-ref allp-c 3))
			(allp4 (vector-ref allp-c 4))
			(fcmb0 (vector-ref fcmb-c 0))
			(fcmb1 (vector-ref fcmb-c 1))
			(fcmb2 (vector-ref fcmb-c 2))
			(fcmb3 (vector-ref fcmb-c 3))
			(fcmb4 (vector-ref fcmb-c 4))
			(dly0 (vector-ref predelays 0))
			(dly1 (vector-ref predelays 1))
			(dly2 (vector-ref predelays 2))
			(dly3 (vector-ref predelays 3))
			(dly4 (vector-ref predelays 4)))
171
		    (do ((i 0 (+ i 1)))
172 173 174 175 176 177 178 179 180 181
			((= i end))
		      (file->frample *reverb* i f-in)
		      (float-vector-set! f-out 0 (all-pass-bank allp0 (filtered-comb-bank fcmb0 (delay dly0 (float-vector-ref f-in 0)))))
		      (float-vector-set! f-out 1 (all-pass-bank allp1 (filtered-comb-bank fcmb1 (delay dly1 (float-vector-ref f-in 1)))))
		      (float-vector-set! f-out 2 (all-pass-bank allp2 (filtered-comb-bank fcmb2 (delay dly2 (float-vector-ref f-in 2)))))
		      (float-vector-set! f-out 3 (all-pass-bank allp3 (filtered-comb-bank fcmb3 (delay dly3 (float-vector-ref f-in 3)))))
		      (float-vector-set! f-out 4 (all-pass-bank allp4 (filtered-comb-bank fcmb4 (delay dly4 (float-vector-ref f-in 4)))))
		      (frample->file *output* i (frample->frample out-mix f-out out-chans out-buf out-chans))))
		  
		  (if (> in-chans 1)
182
		      (do ((i 0 (+ i 1)))
183 184 185 186 187 188 189 190 191 192 193
			  ((= i end))
			(file->frample *reverb* i f-in)
			(do ((c 0 (+ c 1)))
			    ((= c out-chans))
			  (float-vector-set! f-out c (all-pass-bank (vector-ref allp-c c) 
								    (filtered-comb-bank (vector-ref fcmb-c c) 
											(delay (vector-ref predelays c) 
											       (float-vector-ref f-in c))))))
			(frample->file *output* i (frample->frample out-mix f-out out-chans out-buf out-chans)))
		      
		      (let ((pdelay (predelays 0)))
194
			(do ((i 0 (+ i 1)))
195 196 197 198 199 200 201 202 203 204 205
			    ((= i end))
			  (let ((val (delay pdelay (ina i *reverb*))))
			    (do ((c 0 (+ c 1)))
				((= c out-chans))
			      (float-vector-set! f-out c (all-pass-bank (vector-ref allp-c c) 
									(filtered-comb-bank (vector-ref fcmb-c c) 
											    val))))
			    (frample->file *output* i (frample->frample out-mix f-out out-chans out-buf out-chans)))))))))))))
  
;;; (with-sound (:statistics #t :reverb freeverb :reverb-data '(:output-gain 3.0)) (outa 0 .5 *reverb*))
;;; (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*))
206