noise.scm 7.11 KB
Newer Older
1 2 3 4 5 6 7 8 9
;;; noise.scm -- CLM -> Snd/Scheme translation of noise.ins

;; Translator/Author: Michael Scholz <scholz-micha@gmx.de>
;; Last: Wed Apr 02 02:47:21 CEST 2003
;; Version: $Revision: 1.9 $

;;; Comments not otherwise noted are taken from noise.ins!

;; Included functions:
10
;; (attack-point duration attack decay (total-x 100.0))
11
;; (fm-noise ...)
12
;; (make-fm-noise len freq ...)
13 14 15 16

;;; The "noise" instrument (useful for Oceanic Music):

(provide 'snd-noise.scm)
17
(require snd-ws.scm snd-env.scm)
18 19 20

(define *locsig-type* mus-interp-sinusoidal)

21
(define* (attack-point duration attack decay (total-x 100.0))
22
  (* total-x (/ (if (= 0.0 attack)
23
		    (/ (if (= 0.0 decay) duration (- duration decay)) 4)
24 25 26 27 28 29
		    attack)
		duration)))

(definstrument (fm-noise startime dur freq0 amp ampfun ampat ampdc
		   freq1 glissfun freqat freqdc rfreq0 rfreq1 rfreqfun rfreqat rfreqdc
		   dev0 dev1 devfun devat devdc
30
		   (degree 0.0)
31 32 33 34 35 36 37 38 39 40 41 42 43
		   (distance 1.0)
		   (reverb-amount 0.005))
  
  ;; ampat = amp envelope attack time, and so on -- this instrument
  ;; assumes your envelopes go from 0 to 100 on the x-axis, and that
  ;; the "attack" portion ends at 25, the "decay" portion starts at
  ;; 75.  "rfreq" is the frequency of the random number generator --
  ;; if below about 25 hz you get automatic composition, above that
  ;; you start to get noise.  well, you get a different kind of noise.
  ;; "dev" is the bandwidth of the noise -- very narrow gives a
  ;; whistle, very broad more of a whoosh.  this is basically "simple
  ;; fm", but the modulating signal is white noise.
  
44 45 46 47 48 49 50 51
  (let ((beg (seconds->samples startime))
	(end (seconds->samples (+ startime dur)))
	(carrier (make-oscil freq0))
	(modulator (make-rand :frequency rfreq0 :amplitude 1.0))
	(loc (make-locsig :degree degree 
			  :distance distance
			  :reverb reverb-amount
			  :type *locsig-type*))
52
	
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
	;; now make the actual envelopes -- these all assume we are
	;; thinking in terms of the "value when the envelope is 1"
	;; (i.e. dev1 and friends), and the "value when the envelope
	;; is 0" (i.e. dev0 and friends) -- over the years this
	;; seemed to make beginners happier than various other ways
	;; of describing the y-axis behaviour of the envelope.  all
	;; this boiler-plate for envelopes might seem overly
	;; elaborate when our basic instrument is really simple, but
	;; in most cases, and this one in particular, nearly all the
	;; musical interest comes from the envelopes, not the
	;; somewhat dull spectrum generated by the basic patch.
	
	(dev-f (let ((dev-attack (attack-point dur devat devdc))
		     (dev-decay (- 100.0 (attack-point dur devdc devat))))
		 (make-env (stretch-envelope devfun 25 dev-attack 75 dev-decay)
68 69
			   :duration dur 
			   :offset (hz->radians dev0) 
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
			   :scaler (hz->radians (- dev1 dev0)))))
	(amp-f (let ((amp-attack (attack-point dur ampat ampdc))
		     (amp-decay (- 100.0 (attack-point dur ampdc ampat))))
		 (make-env (stretch-envelope ampfun 25 amp-attack 75 amp-decay)
			   :duration dur :scaler amp)))
	(freq-f (let ((freq-attack (attack-point dur freqat freqdc))
		      (freq-decay (- 100.0 (attack-point dur freqdc freqat))))
		  (make-env (stretch-envelope glissfun 25 freq-attack 75 freq-decay)
			    :duration dur :scaler (hz->radians (- freq1 freq0)))))
	(rfreq-f (let ((rfreq-attack (attack-point dur rfreqat rfreqdc))
		       (rfreq-decay (- 100.0 (attack-point dur rfreqdc rfreqat))))
		   (make-env (stretch-envelope rfreqfun 25 rfreq-attack 75 rfreq-decay)
			     :duration dur :scaler (hz->radians (- rfreq1 rfreq0))))))
    (do ((i beg (+ i 1)))
	((= i end))
      (locsig loc i (* (env amp-f)
		       (oscil carrier (+ (env freq-f)
					 (* (env dev-f) (rand modulator (env rfreq-f))))))))))
88 89 90

;;; (with-sound () (fm-noise 0 0.5 500 0.25 '(0 0 25 1 75 1 100 0) 0.1 0.1  1000 '(0 0 100 1) 0.1 0.1 10 1000 '(0 0 100 1) 0 0  100 500 '(0 0 100 1) 0 0))

91 92 93 94 95 96 97 98 99 100 101 102 103 104

;; (let* ((ofile "test.snd")
;;        (snd (find-sound ofile)))
;;   (if snd
;;       (close-sound snd))
;;   (with-sound (:output ofile :play 1 :statistics #t)
;; 	      (fm-noise 0 2.0 500 0.25 '(0 0 25 1 75 1 100 0) 0.1 0.1
;; 			1000 '(0 0 100 1) 0.1 0.1
;; 			10 1000 '(0 0 100 1) 0 0
;; 			100 500 '(0 0 100 1) 0 0)))

;;; And here is a generator-like instrument, see make-fm-violin in
;;; fmv.scm. [MS]

105
(define* (make-fm-noise len freq
106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
			(amp 0.25)
			(ampfun '(0 0 25 1 75 1 100 0))
			(ampat 0.1)
			(ampdc 0.1)
			(freq1 1000)
			(glissfun '(0 0 100 1))
			(freqat 0.1)
			(freqdc 0.1)
			(rfreq0 10)
			(rfreq1 1000)
			(rfreqfun '(0 0 100 1))
			(rfreqat 0)
			(rfreqdc 0)
			(dev0 100)
			(dev1 500)
			(devfun '(0 0 100 1))
			(devat 0)
			(devdc 0)
124 125 126 127
;			(degree (random 90.0))
;			(distance 1.0)
;			(reverb-amount 0.005)
			)
128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
  (let ((dur (/ len (floor (srate)))))
    (let ((dev-ff (let ((dev-attack (attack-point dur devat devdc))
			(dev-decay (- 100.0 (attack-point dur devdc devat))))
		    (make-env (stretch-envelope devfun 25 dev-attack 75 dev-decay)
			      :duration dur :scaler (hz->radians (- dev1 dev0)))))
	  (amp-ff (let ((amp-attack (attack-point dur ampat ampdc))
			(amp-decay (- 100.0 (attack-point dur ampdc ampat))))
		    (make-env (stretch-envelope ampfun 25 amp-attack 75 amp-decay)
			      :duration dur :scaler amp)))
	  (freq-ff (let ((freq-attack (attack-point dur freqat freqdc))
			 (freq-decay (- 100.0 (attack-point dur freqdc freqat))))
		     (make-env (stretch-envelope glissfun 25 freq-attack 75 freq-decay)
			       :duration dur :scaler (hz->radians (- freq1 freq)))))
	  (rfreq-ff (let ((rfreq-attack (attack-point dur rfreqat rfreqdc))
			  (rfreq-decay (- 100.0 (attack-point dur rfreqdc rfreqat))))
		      (make-env (stretch-envelope rfreqfun 25 rfreq-attack 75 rfreq-decay)
				:duration dur :scaler (hz->radians (- rfreq1 rfreq0)))))
	  (carrier (make-oscil freq))
	  (modulator (make-rand :frequency rfreq0 :amplitude 1.0))
	  (dev-0 (hz->radians dev0)))
      (let ((dev-f (lambda () (env dev-ff)))
	    (amp-f (lambda () (env amp-ff)))
	    (freq-f (lambda () (env freq-ff)))
	    (rfreq-f (lambda () (env rfreq-ff))))
	(lambda ()
	  (* (amp-f) (oscil carrier (+ (freq-f) (* (+ dev-0 (dev-f)) (rand modulator (rfreq-f)))))))))))
154 155 156 157 158 159 160 161

;; (let* ((beg 0)
;;        (dur 9.8)
;;        (len (+ beg (floor (* dur (srate)))))
;;        (chns 4)
;;        (outfile "test.snd")
;;        (snd (find-sound outfile))
;;        (loc (make-locsig :degree (random 3535.0) :channels chns))
162 163 164 165
;;        (data (make-float-vector len)))
;;   (do ((i 0 (+ i 1)))
;;       ((= i len))
;;     (set! (data i) (make-fm-noise len 500)))
166 167
;;   (if snd
;;       (close-sound snd))
168 169
;;   (set! snd (new-sound outfile chns *clm-srate* mus-bshort mus-next))
;;   (do ((i 0 (+ i 1)))
170
;;       ((= i chns))
171
;;     (mix-float-vector (float-vector-scale! (copy data) (locsig-ref loc i)) beg snd i #f))
172 173 174
;;   (let* ((beg (floor (* 10 (srate))))
;; 	 (len (+ beg (floor (* dur (srate)))))
;; 	 (loc (make-locsig :degree (random 3535.0) :channels chns))
175 176 177 178 179
;; 	 (data (make-float-vector len)))
;;     (do ((i 0 (+ i 1)))
;;         ((= i len))
;;       (set! (data i) (make-fm-noise len 200)))
;;     (do ((i 0 (+ i 1)))
180
;; 	((= i chns))
181
;;       (mix-float-vector (float-vector-scale! (copy data) (locsig-ref loc i)) beg snd i #f))
182
;;     (play snd 0)))
183 184

;; noise.scm ends here