You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

grani.scm 23KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643
  1. ;;; *************************
  2. ;;; ENVELOPES (env.scm)
  3. ;;; *************************
  4. ;;;=============================================================================
  5. ;;; Exponential envelopes
  6. ;;;=============================================================================
  7. ;;; Approximate an exponential envelope with a given base and error bound
  8. ;;; by Fernando Lopez-Lezcano (nando@ccrma.stanford.edu)
  9. ;;;
  10. ;;; base:
  11. ;;; step size of the exponential envelope
  12. ;;; error:
  13. ;;; error band of the approximation
  14. ;;; scaler:
  15. ;;; scaling factor for the y coordinates
  16. ;;; offset:
  17. ;;; offset for the y coordinates
  18. ;;; cutoff:
  19. ;;; lowest value of the exponentially rendered envelope, values lower than
  20. ;;; this cutoff value will be approximated as cero.
  21. ;;; out-scaler
  22. ;;; scaler for the converted values
  23. (provide 'snd-grani.scm)
  24. (if (provided? 'snd)
  25. (require snd-ws.scm)
  26. (require sndlib-ws.scm))
  27. (require snd-env.scm)
  28. (define grani-default-base (expt 2 1/12))
  29. (define* (exp-envelope env1
  30. (base grani-default-base)
  31. (error 0.01)
  32. (scaler 1)
  33. (offset 0)
  34. cutoff
  35. (out-scaler 1))
  36. (let ((base (* 1.0 base))
  37. (error (* 1.0 error))
  38. (scaler (* 1.0 scaler))
  39. (offset (* 1.0 offset))
  40. (out-scaler (* 1.0 out-scaler)))
  41. (let ((ycutoff (and cutoff (expt base (+ offset (* cutoff scaler)))))
  42. (result ()))
  43. ;; recursively render one segment
  44. ;; xl,xh = x coordinates of segment ends
  45. ;; yl,yh = y coordinates of segment ends
  46. ;; yle,yhe = exponential values of y coords of segment ends
  47. ;; error = linear domain error bound for rendering
  48. (define (exp-seg xl yle xh yhe yl yh error)
  49. ;; linear interpolation
  50. (define (interpolate xl yl xh yh xi)
  51. (+ yl (* (- xi xl) (/ (- yh yl) (- xh xl)))))
  52. (let* ((xint (/ (+ xl xh) 2.0))
  53. (yint (interpolate xl yl xh yh xint))
  54. (yexp (expt base yint)))
  55. (let ((yinte (interpolate xl yle xh yhe xint))
  56. (yerr (- (expt base (+ yint error)) yexp)))
  57. ;; is the linear approximation accurate enough?
  58. ;; are we still over the cutoff limit?
  59. (if (not (and (> (abs (- yexp yinte)) yerr)
  60. (or (not (real? ycutoff))
  61. (> yinte ycutoff))))
  62. ;; yes --> don't need to add nu'ting to the envelope
  63. (values () ())
  64. ;; no --> add a breakpoint and recurse right and left
  65. ((lambda (xi yi xj yj)
  66. (values (append xi (cons xint xj))
  67. (append yi (cons yexp yj))))
  68. (exp-seg xl yle xint yexp yl yint error)
  69. (exp-seg xint yexp xh yhe yint yh error))))))
  70. ;; loop for each segment in the envelope
  71. (let segs ((en env1))
  72. (let ((x (car en))
  73. (yscl (+ offset (* (cadr en) scaler))))
  74. (let ((nx (caddr en))
  75. (nyscl (+ offset (* (cadddr en) scaler)))
  76. (xy (list x (if (or (not (real? ycutoff))
  77. (>= (expt base yscl) ycutoff))
  78. (* out-scaler (expt base yscl))
  79. 0.0))))
  80. (set! result (append result xy))
  81. ((lambda (xs ys)
  82. (if (pair? ys)
  83. (let vals ((xx xs)
  84. (yy (map (lambda (y) (* y out-scaler)) ys)))
  85. (let ((x (car xx))
  86. (y (car yy)))
  87. (set! result (append result (list x y)))
  88. (if (pair? (cdr xx))
  89. (vals (cdr xx) (cdr yy)))))))
  90. (exp-seg x (expt base yscl) nx (expt base nyscl) yscl nyscl error))
  91. (if (<= (length en) 4)
  92. (append result (list nx (if (or (not (real? ycutoff))
  93. (>= (expt base nyscl) ycutoff))
  94. (* out-scaler (expt base nyscl))
  95. 0.0)))
  96. (segs (cddr en)))))))))
  97. ;;; Amplitude envelope in dBs
  98. ;;;
  99. ;;; The db scale is defined as:
  100. ;;; value(db)=(* 20 (log10 (/ vin vref)))
  101. ;;; where:
  102. ;;; vref=1.0 reference value = digital clipping
  103. (define* (db-envelope envelope (cutoff -70) (error 0.01))
  104. (exp-envelope envelope
  105. :base 10
  106. :scaler 1/20
  107. :offset 0
  108. :cutoff cutoff
  109. :error error))
  110. (define* (make-db-env envelope
  111. (scaler 1)
  112. (offset 0)
  113. (base 1)
  114. (duration 0)
  115. (end 0)
  116. (cutoff -70)
  117. (error 0.01))
  118. (make-env (db-envelope envelope cutoff error)
  119. :scaler scaler :offset offset
  120. :base base :duration duration :length (+ 1 end)))
  121. ;;; Pitch envelopes (y units are semitone and octave intervals)
  122. (define* (semitones-envelope envelope (around 1.0) (error 0.01))
  123. (exp-envelope envelope
  124. :error error
  125. :base (expt 2 1/12)
  126. :cutoff #f
  127. :scaler 1
  128. :offset 0
  129. :out-scaler around))
  130. (define* (make-semitones-env envelope
  131. (around 1.0)
  132. (scaler 1.0)
  133. (offset 0.0)
  134. (base 1)
  135. (duration 0)
  136. (end 0)
  137. (error 0.01))
  138. (make-env (semitones-envelope envelope around error)
  139. :scaler scaler :offset offset
  140. :base base :duration duration :length (+ 1 end)))
  141. (define* (octaves-envelope envelope (around 1.0) (error 0.01))
  142. (exp-envelope envelope
  143. :error error
  144. :base 2
  145. :cutoff #f
  146. :scaler 1
  147. :offset 0
  148. :out-scaler around))
  149. (define* (make-octaves-env envelope
  150. (around 1.0)
  151. (scaler 1.0)
  152. (offset 0.0)
  153. (base 1)
  154. (duration 0)
  155. (end 0)
  156. (error 0.01))
  157. (make-env (octaves-envelope envelope around error)
  158. :scaler scaler :offset offset
  159. :base base :duration duration :length (+ 1 end)))
  160. ;;; *************************
  161. ;;; GRANI (clm-ins.scm)
  162. ;;; *************************
  163. ;;; grani: a granular synthesis instrument
  164. ;;; by Fernando Lopez-Lezcano
  165. ;;; http://ccrma.stanford.edu/~nando/clm/grani/
  166. ;;;
  167. ;;; Original grani.ins instrument written for the 220a Course by
  168. ;;; Fernando Lopez-Lezcano & Juan Pampin, November 6 1996
  169. ;;;
  170. ;;; Mar 21 1997: working with hop and grain-dur envelopes
  171. ;;; Mar 22 1997: working with src envelope (grain wise) & src spread
  172. ;;; Jan 26 1998: started work on new version
  173. ;;; Nov 7 1998: input soundfile duration calculation wrong
  174. ;;; Nov 10 1998: bug in in-samples (thanks to Kristopher D. Giesing for this one)
  175. ;;; Dec 20 1998: added standard locsig code
  176. ;;; Feb 19 1999: added "nil" as default value of where to avoid warning (by bill)
  177. ;;; Jan 10 2000: added input-channel to select which channel of the input file
  178. ;;; to process.
  179. ;;; added grain-start-in-seconds to be able to specify input file
  180. ;;; locations in seconds for the grain-start envelope
  181. ;;; May 06 2002: fixed array passing of where-bins in clisp (reported by Charles
  182. ;;; Nichols and jennifer l doering
  183. ;;; Mar 27 2003: added option for sending grains to all channels (requested by
  184. ;;; Oded Ben-Tal)
  185. ;;; Jun 17 2006: made some changes for the run macro (Bill)
  186. ;;; Jul 14 2007: removed :start args (Bill)
  187. ;;;-----------------------------------------------------------------------------
  188. ;;; Auxiliary functions
  189. ;;; calculate a random spread around a center of 0
  190. (define-macro (random-spread spread)
  191. `(if (not (zero? ,spread))
  192. (- (random ,spread)
  193. (/ ,spread 2.0))
  194. 0.0))
  195. ;;; convert a time in seconds to a number of samples
  196. (define-macro (to-samples time srate)
  197. `(floor (* ,time ,srate)))
  198. ;;; create a constant envelope if argument is a number
  199. (define (envelope-or-number in)
  200. (if (number? in)
  201. (list 0 in 1 in)
  202. in))
  203. ;;; create a float-vector from an envelope
  204. (define* (make-gr-env env1 (len 512))
  205. (let ((env-float-vector (make-float-vector len))
  206. (length-1 (* 1.0 (- len 1))))
  207. (do ((i 0 (+ 1 i)))
  208. ((= i len) env-float-vector)
  209. (set! (env-float-vector i) (envelope-interp (/ i length-1) env1)))))
  210. ;;;-----------------------------------------------------------------------------
  211. ;;; Grain envelopes
  212. (define* (raised-cosine (duty-cycle 100)
  213. (len 128))
  214. (let ((active (* len duty-cycle 0.01)))
  215. (let ((v (make-float-vector len))
  216. (incr (/ pi (- active 1)))
  217. (start (max 0 (/ (- len active) 2)))
  218. (end (min len (/ (+ len active) 2))))
  219. (do ((i start (+ i 1))
  220. (s 0.0 (+ s incr)))
  221. ((= i end) v)
  222. (let ((sine (sin s)))
  223. (set! (v i) (* sine sine)))))))
  224. ;;;=============================================================================
  225. ;;; Granular synthesis instrument
  226. ;;;=============================================================================
  227. ;;; input-channel:
  228. ;;; from which channel in the input file are samples read
  229. ;;; amp-envelope:
  230. ;;; amplitude envelope for the note
  231. ;;; grain-envelope:
  232. ;;; grain-envelope-end:
  233. ;;; envelopes for each individual grain. The envelope applied in the result
  234. ;;; of interpolating both envelopes. The interpolation is controlled by
  235. ;;; grain-envelope-trasition. If "grain-envelope-end" is nil interpolation
  236. ;;; is turned off and only grain-envelope is applied to the grains.
  237. ;;; grain-envelope-trasition:
  238. ;;; an enveloper that controls the interpolation between the two grain envelopes
  239. ;;; 0 -> selects "grain-envelope"
  240. ;;; 1 -> selects "grain-envelope-end"
  241. ;;; grain-envelope-array-size
  242. ;;; size of the array passed to make-table-lookup
  243. ;;; grain-duration:
  244. ;;; envelope that controls grain duration in seconds
  245. ;;; srate-linear:
  246. ;;; #t -> sample rate envelope is linear
  247. ;;; #f -> sample rate envelope is exponential
  248. ;;; srate:
  249. ;;; envelope that controls sample rate conversion. The envelope is an
  250. ;;; exponential envelope, the base and error bound of the conversion
  251. ;;; are controlled by "srate-base" and "srate-error".
  252. ;;; srate-spread:
  253. ;;; random spread of sample rate conversion around "srate"
  254. ;;; srate-base:
  255. ;;; base for the exponential conversion
  256. ;;; for example: base = (expt 2 (/ 12)) creates a semitone envelope
  257. ;;; srate-error:
  258. ;;; error bound for the exponential conversion.
  259. ;;; grain-start:
  260. ;;; envelope that determines the starting point of the current grain in
  261. ;;; the input file. "y"->0 starts the grain at the beginning of the input
  262. ;;; file. "y"->1 starts the grain at the end of the input file.
  263. ;;; grain-start-spread:
  264. ;;; random spread around the value of "grain-start"
  265. ;;; grain-start-in-seconds:
  266. ;;; #f -> grain-start y envelope expressed in percent of the duration of the input file
  267. ;;; #t -> grain-start y envelope expressed in seconds
  268. ;;; grain-density:
  269. ;;; envelope that controls the number of grains per second generated in the output file
  270. ;;; grain-density-spread:
  271. ;;; envelope that controls a random variation of density
  272. (define grani-to-locsig 0.0)
  273. (define grani-to-grain-duration 1)
  274. (define grani-to-grain-start 2)
  275. (define grani-to-grain-sample-rate 3)
  276. (define grani-to-grain-random 4)
  277. (define grani-to-grain-allchans 5)
  278. (definstrument (grani start-time duration amplitude file
  279. (input-channel 0)
  280. (grains 0)
  281. (amp-envelope '(0 0 0.3 1 0.7 1 1 0))
  282. (grain-envelope '(0 0 0.3 1 0.7 1 1 0))
  283. grain-envelope-end
  284. (grain-envelope-transition '(0 0 1 1))
  285. (grain-envelope-array-size 512)
  286. (grain-duration 0.1)
  287. (grain-duration-spread 0.0)
  288. (grain-duration-limit 0.002)
  289. (srate 0.0)
  290. (srate-spread 0.0)
  291. srate-linear
  292. (srate-base grani-default-base)
  293. (srate-error 0.01)
  294. (grain-start '(0 0 1 1))
  295. (grain-start-spread 0.0)
  296. grain-start-in-seconds
  297. (grain-density 10.0)
  298. (grain-density-spread 0.0)
  299. (reverb-amount 0.01)
  300. reversed ; change this from "reverse" 18-Nov-13
  301. (where-to 0)
  302. where-bins ; a float-vector, not a list
  303. (grain-distance 1.0)
  304. (grain-distance-spread 0.0)
  305. (grain-degree 45.0)
  306. (grain-degree-spread 0.0)
  307. (verbose #t))
  308. (let ((ts (times->samples start-time duration))
  309. (in-file-channels (channels file))
  310. (in-file-sr (* 1.0 (mus-sound-srate file))))
  311. (let ((beg (car ts))
  312. (end (cadr ts))
  313. (in-file-dur (/ (framples file) in-file-sr))
  314. (out-chans (channels *output*))
  315. (gr-samples 0)
  316. ;; ratio between input and output sampling rates
  317. (srate-ratio (/ in-file-sr *clm-srate*))
  318. ;; sample rate converter for input samples
  319. (rd (make-readin :file file :channel (min input-channel (- in-file-channels 1)))))
  320. (let ((last-in-sample (floor (* in-file-dur in-file-sr)))
  321. (in-file-reader (make-src :input rd :srate 1.0))
  322. ;; sample rate conversion envelope
  323. (sr-env (make-env (if srate-linear
  324. (envelope-or-number srate)
  325. (exp-envelope (envelope-or-number srate)
  326. :base srate-base
  327. :error srate-error))
  328. :scaler srate-ratio
  329. :duration duration))
  330. ;; sample rate conversion random spread
  331. (sr-spread-env (make-env (envelope-or-number srate-spread)
  332. :duration duration))
  333. ;; amplitude envelope for the note
  334. (amp-env (make-env amp-envelope
  335. :scaler amplitude
  336. :duration duration))
  337. ;; grain duration envelope
  338. (gr-dur (make-env (envelope-or-number grain-duration)
  339. :duration duration))
  340. (gr-dur-spread (make-env (envelope-or-number grain-duration-spread)
  341. :duration duration))
  342. ;; position in the input file where the grain starts
  343. (gr-start-scaler (if (not grain-start-in-seconds) in-file-dur 1.0))
  344. (gr-start (make-env (envelope-or-number grain-start)
  345. :duration duration))
  346. ;; random variation in the position in the input file
  347. (gr-start-spread (make-env (envelope-or-number grain-start-spread)
  348. :duration duration))
  349. ;; density envelope in grains per second
  350. (gr-dens-env (make-env (envelope-or-number grain-density)
  351. :duration duration))
  352. ;; density spread envelope in grains per second
  353. (gr-dens-spread-env (make-env (envelope-or-number grain-density-spread)
  354. :duration duration))
  355. ;; grain envelope
  356. (gr-env (make-table-lookup :frequency 1.0
  357. :initial-phase 0.0
  358. :wave (if (float-vector? grain-envelope)
  359. grain-envelope
  360. (make-gr-env grain-envelope
  361. grain-envelope-array-size))))
  362. ;; grain envelope
  363. (gr-env-end (make-table-lookup :frequency 1.0
  364. :initial-phase 0.0
  365. :wave (if grain-envelope-end
  366. (if (float-vector? grain-envelope-end)
  367. grain-envelope-end
  368. (make-gr-env grain-envelope-end
  369. grain-envelope-array-size))
  370. (make-float-vector 512))))
  371. ;; envelope for transition between grain envelopes
  372. (gr-int-env (make-env (envelope-or-number grain-envelope-transition) :duration duration))
  373. (gr-int-env-1 (make-env (envelope-or-number grain-envelope-transition) :duration duration :offset 1.0 :scaler -1.0))
  374. (interp-gr-envs grain-envelope-end)
  375. ;; envelope for distance of grains (for using in locsig)
  376. (gr-dist (make-env (envelope-or-number grain-distance)
  377. :duration duration))
  378. (gr-dist-spread (make-env (envelope-or-number grain-distance-spread)
  379. :duration duration))
  380. ;; envelopes for angular location and spread of grain in the stereo field
  381. (gr-degree (make-env (envelope-or-number grain-degree)
  382. :duration duration))
  383. (gr-degree-spread (make-env (envelope-or-number grain-degree-spread)
  384. :duration duration))
  385. ;; signal locator in the stereo image
  386. (loc (make-locsig :degree 45.0
  387. :distance 1.0
  388. :channels out-chans))
  389. (in-samples 0)
  390. (gr-start-sample beg)
  391. (gr-from-beg 0)
  392. (in-start 0)
  393. (in-start-value 0.0)
  394. (gr-duration 0.0)
  395. (gr-dens 0.0)
  396. (gr-dens-spread 0.0)
  397. (gr-srate 0.0)
  398. (grain-counter 0)
  399. (first-grain #t)
  400. (where 0.0)
  401. (happy #t)
  402. (where-bins-len (if (float-vector? where-bins) (length where-bins) 0)))
  403. (if (<= where-bins-len 1)
  404. (set! where-bins #f))
  405. (if reversed (set! (mus-increment in-file-reader) -1.0))
  406. (do ()
  407. ((not happy))
  408. ;;
  409. ;; start of a new grain
  410. ;;
  411. (if first-grain
  412. ;; first grain always starts at 0
  413. (begin
  414. (set! first-grain #f)
  415. (set! gr-start-sample beg))
  416. (begin
  417. ;; start grain in output file using
  418. ;; increments from previous grain
  419. (set! gr-start-sample (+ gr-start-sample
  420. (floor
  421. (* (/ (+ gr-dens gr-dens-spread)) *clm-srate*))))
  422. ;; finish if start of grain falls outside of note
  423. ;; bounds or number of grains exceeded
  424. (if (or (> gr-start-sample end)
  425. (and (not (zero? grains))
  426. (>= grain-counter grains)))
  427. (set! happy #f))))
  428. (when happy
  429. ;; back to the beginning of the grain
  430. ;(set! gr-offset 0)
  431. ;; start of grain in samples from beginning of note
  432. (set! gr-from-beg (floor (- gr-start-sample beg)))
  433. ;; reset out-time dependent envelopes to current time
  434. (set! (mus-location amp-env) gr-from-beg)
  435. (set! (mus-location gr-dur) gr-from-beg)
  436. (set! (mus-location gr-dur-spread) gr-from-beg)
  437. (set! (mus-location sr-env) gr-from-beg)
  438. (set! (mus-location sr-spread-env) gr-from-beg)
  439. (set! (mus-location gr-start) gr-from-beg)
  440. (set! (mus-location gr-start-spread) gr-from-beg)
  441. (set! (mus-location gr-dens-env) gr-from-beg)
  442. (set! (mus-location gr-dens-spread-env) gr-from-beg)
  443. ;; start of grain in input file
  444. (set! in-start-value (+ (* (env gr-start) gr-start-scaler)
  445. (mus-random (* 0.5 (env gr-start-spread)
  446. gr-start-scaler))))
  447. (set! in-start (floor (* in-start-value in-file-sr)))
  448. ;; duration in seconds of the grain
  449. (set! gr-duration (max grain-duration-limit
  450. (+ (env gr-dur)
  451. (mus-random (* 0.5 (env gr-dur-spread))))))
  452. ;; number of samples in the grain
  453. (set! gr-samples (floor (* gr-duration *clm-srate*)))
  454. ;; new sample rate for grain
  455. (set! gr-srate (if srate-linear
  456. (+ (env sr-env)
  457. (mus-random (* 0.5 (env sr-spread-env))))
  458. (* (env sr-env)
  459. (expt srate-base
  460. (mus-random (* 0.5 (env sr-spread-env)))))))
  461. ;; set new sampling rate conversion factor
  462. (set! (mus-increment in-file-reader) gr-srate)
  463. ;; number of samples in input
  464. (set! in-samples (floor (* gr-samples srate-ratio)))
  465. ;; check for out of bounds condition in in-file pointers
  466. (set! in-start (if (> (+ in-start in-samples) last-in-sample)
  467. (- last-in-sample in-samples)
  468. (max in-start 0)))
  469. ;; reset position of input file reader
  470. (set! (mus-location rd) in-start)
  471. ;; restart grain envelopes
  472. (set! (mus-phase gr-env) 0.0)
  473. (set! (mus-phase gr-env-end) 0.0)
  474. ;; reset grain envelope durations
  475. (set! (mus-frequency gr-env) (/ gr-duration))
  476. (set! (mus-frequency gr-env-end) (/ gr-duration))
  477. ;;
  478. ;; move position in output file for next grain
  479. ;;
  480. (set! gr-dens (env gr-dens-env))
  481. ;; increment spread in output file for next grain
  482. (set! gr-dens-spread (mus-random (* 0.5 (env gr-dens-spread-env))))
  483. (set! grain-counter (+ grain-counter 1))
  484. (set! where (cond (;; use duration of grains as delimiter
  485. (= where-to grani-to-grain-duration)
  486. gr-duration)
  487. (;; use start in input file as delimiter
  488. (= where-to grani-to-grain-start)
  489. in-start-value)
  490. (;; use sampling rate as delimiter
  491. (= where-to grani-to-grain-sample-rate)
  492. gr-srate)
  493. (;; use a random number as delimiter
  494. (= where-to grani-to-grain-random)
  495. (random 1.0))
  496. (else grani-to-locsig)))
  497. (if (and where-bins
  498. (not (zero? where)))
  499. ;; set output scalers according to criteria
  500. (do ((chn 0 (+ chn 1)))
  501. ((or (= chn out-chans)
  502. (= chn where-bins-len)))
  503. (locsig-set! loc chn (if (< (where-bins chn)
  504. where
  505. (where-bins (+ chn 1)))
  506. 1.0
  507. 0.0)))
  508. ;; if not "where" see if the user wants to send to all channels
  509. (if (= where-to grani-to-grain-allchans)
  510. ;; send the grain to all channels
  511. (do ((chn 0 (+ chn 1)))
  512. ((= chn out-chans))
  513. (locsig-set! loc chn 1.0))
  514. ;; "where" is zero or unknown: use normal n-channel locsig,
  515. ;; only understands mono reverb and 1, 2 or 4 channel output
  516. (begin
  517. (set! (mus-location gr-dist) gr-from-beg)
  518. (set! (mus-location gr-dist-spread) gr-from-beg)
  519. (set! (mus-location gr-degree) gr-from-beg)
  520. (set! (mus-location gr-degree-spread) gr-from-beg)
  521. ;; set locsig parameters, for now only understands stereo
  522. (move-locsig loc
  523. (+ (env gr-degree)
  524. (mus-random (* 0.5 (env gr-degree-spread))))
  525. (+ (env gr-dist)
  526. (mus-random (* 0.5 (env gr-dist-spread))))))))
  527. (let ((grend (+ gr-start-sample gr-samples)))
  528. (if interp-gr-envs
  529. (do ((gr-offset gr-start-sample (+ gr-offset 1)))
  530. ((= gr-offset grend))
  531. (locsig loc gr-offset (* (env amp-env)
  532. (src in-file-reader)
  533. (+ (* (env gr-int-env) (table-lookup gr-env-end))
  534. (* (env gr-int-env-1) (table-lookup gr-env))))))
  535. (do ((gr-offset gr-start-sample (+ gr-offset 1)))
  536. ((= gr-offset grend))
  537. (locsig loc gr-offset (* (env amp-env)
  538. (table-lookup gr-env)
  539. (src in-file-reader))))))))))))
  540. ;; (with-sound (:channels 2 :reverb jc-reverb :reverb-channels 1) (let ((file "oboe.snd")) (grani 0 2 5 file :grain-envelope (raised-cosine))))
  541. ;; (with-sound (:channels 2) (let ((file "oboe.snd")) (grani 0 2 5 file :grain-envelope (raised-cosine))))
  542. (define (test-grani)
  543. (with-sound (:channels 2 :reverb jc-reverb :reverb-channels 1 :statistics #t)
  544. (grani 0 1 .5 "oboe.snd" :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0))
  545. (grani 0 4 1 "oboe.snd")
  546. (grani 0 4 1 "oboe.snd" :grains 10)
  547. (grani 0 4 1 "oboe.snd"
  548. :grain-start 0.11
  549. :amp-envelope '(0 1 1 1) :grain-density 8
  550. :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0)
  551. :grain-envelope-end '(0 0 0.01 1 0.99 1 1 0)
  552. :grain-envelope-transition '(0 0 0.4 1 0.8 0 1 0))
  553. (grani 0 3 1 "oboe.snd"
  554. :grain-start 0.1
  555. :amp-envelope '(0 1 1 1) :grain-density 20
  556. :grain-duration '(0 0.003 0.2 0.01 1 0.3))
  557. (grani 0 3 1 "oboe.snd"
  558. :grain-start 0.1
  559. :amp-envelope '(0 1 1 1) :grain-density 20
  560. :grain-duration '(0 0.003 0.2 0.01 1 0.3)
  561. :grain-duration-limit 0.02)
  562. (grani 0 2 1 "oboe.snd"
  563. :amp-envelope '(0 1 1 1) :grain-density 40
  564. :grain-start '(0 0.1 0.3 0.1 1 0.6))
  565. (grani 0 2 1 "oboe.snd"
  566. :amp-envelope '(0 1 1 1) :grain-density 40
  567. :grain-start '(0 0.1 0.3 0.1 1 0.6)
  568. :grain-start-spread 0.01)
  569. (grani 0 2.6 1 "oboe.snd"
  570. :grain-start 0.1 :grain-start-spread 0.01
  571. :amp-envelope '(0 1 1 1) :grain-density 40
  572. :srate '(0 0 0.2 0 0.6 5 1 5))
  573. (grani 0 2.6 1 "oboe.snd"
  574. :grain-start 0.1 :grain-start-spread 0.01
  575. :amp-envelope '(0 1 1 1) :grain-density 40
  576. :srate-base 2
  577. :srate '(0 0 0.2 0 0.6 -1 1 -1))
  578. (grani 0 2.6 1 "oboe.snd"
  579. :grain-start 0.1 :grain-start-spread 0.01
  580. :amp-envelope '(0 1 1 1) :grain-density 40
  581. :srate-linear #t
  582. :srate (list 0 1 0.2 1 0.6 (expt 2 5/12) 1 (expt 2 5/12)))
  583. (grani 0 2 1 "oboe.snd"
  584. :grain-start 0.1 :grain-start-spread 0.01
  585. :amp-envelope '(0 1 1 1) :grain-density 40
  586. :grain-duration '(0 0.02 1 0.1)
  587. :grain-duration-spread '(0 0 0.5 0.1 1 0)
  588. :where-to grani-to-grain-duration ; from grani.scm
  589. :where-bins (float-vector 0 0.05 1))
  590. (grani 0 2 1 "oboe.snd"
  591. :grain-start 0.1 :grain-start-spread 0.01
  592. :amp-envelope '(0 1 1 1) :grain-density 40
  593. :grain-degree '(0 0 1 90)
  594. :grain-degree-spread 10)))