summaryrefslogtreecommitdiff
path: root/noise.scm
blob: 79587ff6943e9909c0cdf3da4af5a604970b6a6d (plain)
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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
;;; 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:
;; (attack-point duration attack decay (total-x 100.0))
;; (fm-noise ...)
;; (make-fm-noise len freq ...)

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

(provide 'snd-noise.scm)
(require snd-ws.scm snd-env.scm)

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

(define* (attack-point duration attack decay (total-x 100.0))
  (* total-x (/ (if (= 0.0 attack)
		    (/ (if (= 0.0 decay) duration (- duration decay)) 4)
		    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
		   (degree 0.0)
		   (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.
  
  (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*))
	
	;; 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)
			   :duration dur 
			   :offset (hz->radians dev0) 
			   :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))))))))))

;;; (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))


;; (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]

(define* (make-fm-noise len freq
			(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)
;			(degree (random 90.0))
;			(distance 1.0)
;			(reverb-amount 0.005)
			)
  (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)))))))))))

;; (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))
;;        (data (make-float-vector len)))
;;   (do ((i 0 (+ i 1)))
;;       ((= i len))
;;     (set! (data i) (make-fm-noise len 500)))
;;   (if snd
;;       (close-sound snd))
;;   (set! snd (new-sound outfile chns *clm-srate* mus-bshort mus-next))
;;   (do ((i 0 (+ i 1)))
;;       ((= i chns))
;;     (mix-float-vector (float-vector-scale! (copy data) (locsig-ref loc i)) beg snd i #f))
;;   (let* ((beg (floor (* 10 (srate))))
;; 	 (len (+ beg (floor (* dur (srate)))))
;; 	 (loc (make-locsig :degree (random 3535.0) :channels chns))
;; 	 (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)))
;; 	((= i chns))
;;       (mix-float-vector (float-vector-scale! (copy data) (locsig-ref loc i)) beg snd i #f))
;;     (play snd 0)))

;; noise.scm ends here