/usr/share/audacity/nyquist/seq.lsp is in audacity-data 2.2.1-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 | ;; seq.lsp -- sequence control constructs for Nyquist
;; get-srates -- this either returns the sample rate of a sound or a
;; vector of sample rates of a vector of sounds
;;
(defun get-srates (sounds)
(cond ((arrayp sounds)
(let ((result (make-array (length sounds))))
(dotimes (i (length sounds))
(setf (aref result i) (snd-srate (aref sounds i))))
result))
(t
(snd-srate sounds))))
; These are complex macros that implement sequences of various types.
; The complexity is due to the fact that a behavior within a sequence
; can reference the environment, e.g. (let ((p 60)) (seq (osc p) (osc p)))
; is an example where p must be in the environment of each member of
; the sequence. Since the execution of the sequence elements are delayed,
; the environment must be captured and then used later. In XLISP, the
; EVAL function does not execute in the current environment, so a special
; EVAL, EVALHOOK must be used to evaluate with an environment. Another
; feature of XLISP (see evalenv.lsp) is used to capture the environment
; when the seq is first evaluated, so that the environment can be used
; later. Finally, it is also necessary to save the current transformation
; environment until later.
(defmacro seq (&rest list)
(cond ((null list)
(snd-zero (warp-time *WARP*) *sound-srate*))
((null (cdr list))
(car list))
((null (cddr list))
; (format t "SEQ with 2 behaviors: ~A~%" list)
`(let* ((first%sound ,(car list))
(s%rate (get-srates first%sound)))
(cond ((arrayp first%sound)
(snd-multiseq (prog1 first%sound (setf first%sound nil))
#'(lambda (t0)
(format t "MULTISEQ's 2nd behavior: ~A~%" ',(cadr list))
(with%environment ',(nyq:the-environment)
; (display "MULTISEQ 1" t0)
(at-abs t0
(force-srates s%rate ,(cadr list)))))))
(t
; allow gc of first%sound:
(snd-seq (prog1 first%sound (setf first%sound nil))
#'(lambda (t0)
; (format t "SEQ's 2nd behavior: ~A~%" ',(cadr list))
(with%environment ',(nyq:the-environment)
(at-abs t0
(force-srate s%rate ,(cadr list))))))))))
(t
`(let* ((nyq%environment (nyq:the-environment))
(first%sound ,(car list))
(s%rate (get-srates first%sound))
(seq%environment (getenv)))
(cond ((arrayp first%sound)
; (print "calling snd-multiseq")
(snd-multiseq (prog1 first%sound (setf first%sound nil))
#'(lambda (t0)
(multiseq-iterate ,(cdr list)))))
(t
; (print "calling snd-seq")
; allow gc of first%sound:
(snd-seq (prog1 first%sound (setf first%sound nil))
#'(lambda (t0)
(seq-iterate ,(cdr list))))))))))
(defun envdepth (e) (length (car e)))
(defmacro myosd (pitch)
`(let () (format t "myosc env depth is ~A~%"
(envdepth (getenv))) (osc ,pitch)))
(defmacro seq-iterate (behavior-list)
(cond ((null (cdr behavior-list))
`(eval-seq-behavior ,(car behavior-list)))
(t
`(snd-seq (eval-seq-behavior ,(car behavior-list))
(evalhook '#'(lambda (t0)
; (format t "lambda depth ~A~%" (envdepth (getenv)))
(seq-iterate ,(cdr behavior-list)))
nil nil seq%environment)))))
(defmacro multiseq-iterate (behavior-list)
(cond ((null (cdr behavior-list))
`(eval-multiseq-behavior ,(car behavior-list)))
(t
`(snd-multiseq (eval-multiseq-behavior ,(car behavior-list))
(evalhook '#'(lambda (t0)
; (format t "lambda depth ~A~%" (envdepth (getenv)))
(multiseq-iterate ,(cdr behavior-list)))
nil nil seq%environment)))))
(defmacro eval-seq-behavior (beh)
`(with%environment nyq%environment
(at-abs t0
(force-srate s%rate ,beh))))
(defmacro eval-multiseq-behavior (beh)
`(with%environment nyq%environment
; (display "MULTISEQ 2" t0)
(at-abs t0
(force-srates s%rate ,beh))))
(defmacro with%environment (env &rest expr)
`(progv ',*environment-variables* ,env ,@expr))
(defmacro seqrep (pair sound)
`(let ((,(car pair) 0)
(loop%count ,(cadr pair))
(nyq%environment (nyq:the-environment))
seqrep%closure first%sound s%rate)
; note: s%rate will tell whether we want a single or multichannel
; sound, and what the sample rates should be.
(cond ((not (integerp loop%count))
(error "bad argument type" loop%count))
(t
(setf seqrep%closure #'(lambda (t0)
; (display "SEQREP" loop%count ,(car pair))
(cond ((< ,(car pair) loop%count)
(setf first%sound
(with%environment nyq%environment
(at-abs t0 ,sound)))
; (display "seqrep" s%rate nyq%environment ,(car pair)
; loop%count)
(if s%rate
(setf first%sound (force-srates s%rate first%sound))
(setf s%rate (get-srates first%sound)))
(setf ,(car pair) (1+ ,(car pair)))
; note the following test is AFTER the counter increment
(cond ((= ,(car pair) loop%count)
; (display "seqrep: computed the last sound at"
; ,(car pair) loop%count
; (local-to-global 0))
first%sound) ;last sound
((arrayp s%rate)
; (display "seqrep: calling snd-multiseq at"
; ,(car pair) loop%count (local-to-global 0)
; (snd-t0 (aref first%sound 0)))
(snd-multiseq (prog1 first%sound
(setf first%sound nil))
seqrep%closure))
(t
; (display "seqrep: calling snd-seq at"
; ,(car pair) loop%count (local-to-global 0)
; (snd-t0 first%sound))
(snd-seq (prog1 first%sound
(setf first%sound nil))
seqrep%closure))))
(t (snd-zero (warp-time *WARP*) *sound-srate*)))))
(funcall seqrep%closure (local-to-global 0))))))
(defmacro trigger (input beh)
`(let ((nyq%environment (nyq:the-environment)))
(snd-trigger ,input #'(lambda (t0) (with%environment nyq%environment
(at-abs t0 ,beh))))))
;; EVENT-EXPRESSION -- the sound of the event
;;
(setfn event-expression caddr)
;; EVENT-HAS-ATTR -- test if event has attribute
;;
(defun event-has-attr (note attr)
(expr-has-attr (event-expression note)))
;; EXPR-SET-ATTR -- new expression with attribute = value
;;
(defun expr-set-attr (expr attr value)
(cons (car expr) (list-set-attr-value (cdr expr) attr value)))
(defun list-set-attr-value (lis attr value)
(cond ((null lis) (list attr value))
((eq (car lis) attr)
(cons attr (cons value (cddr lis))))
(t
(cons (car lis)
(cons (cadr lis)
(list-set-attr-value (cddr lis) attr value))))))
;; EXPAND-AND-EVAL-EXPR -- evaluate a note, chord, or rest for timed-seq
;;
(defun expand-and-eval-expr (expr)
(let ((pitch (member :pitch expr)))
(cond ((and pitch (cdr pitch) (listp (cadr pitch)))
(setf pitch (cadr pitch))
(simrep (i (length pitch))
(eval (expr-set-attr expr :pitch (nth i pitch)))))
(t
(eval expr)))))
;; (timed-seq '((time1 stretch1 expr1) (time2 stretch2 expr2) ...))
;; a timed-seq takes a list of events as shown above
;; it sums the behaviors, similar to
;; (sim (at time1 (stretch stretch1 expr1)) ...)
;; but the implementation avoids starting all expressions at once
;;
;; Notes: (1) the times must be in increasing order
;; (2) EVAL is used on each event, so events cannot refer to parameters
;; or local variables
;;
;; If score events are very closely spaced (< 1020 samples), the block
;; overlap can cause a ripple effect where to complete one block of the
;; output, you have to compute part of the next score event, but then
;; it in turn computes part of the next score event, and so on, until
;; the stack overflows (if you have 1000's of events).
;;
;; This is really a fundamental problem in Nyquist because blocks are
;; not aligned. To work around the problem (but not totally solve it)
;; scores are evaluated up to a length of 100. If there are more than
;; 100 score events, we form a balanced tree of adders so that maybe
;; we will end up with a lot of sound in memory, but at least the
;; stack will not overflow. Generally, we should not end up with more
;; than 100 times as many blocks as we would like, but since the
;; normal space required is O(1), we're still using constant space +
;; a small constant * log(score-length).
;;
(setf MAX-LINEAR-SCORE-LEN 100)
(defun timed-seq (score)
(let ((len (length score))
pair)
(cond ((< len MAX-LINEAR-SCORE-LEN)
(timed-seq-linear score))
(t ;; split the score -- divide and conquer
(setf pair (score-split score (/ len 2)))
(sum (timed-seq (car pair)) (timed-seq (cdr pair)))))))
;; score-split -- helper function: split score into two, with n elements
;; in the first part; returns a dotted pair
(defun score-split (score n)
;; do the split without recursion to avoid stack overflow
;; algorithm: modify the list destructively to get the first
;; half. Copy it. Reassemble the list.
(let (pair last front back)
(setf last (nthcdr (1- n) score))
(setf back (cdr last))
(rplacd last nil)
(setf front (append score nil)) ; shallow copy
(rplacd last back)
(cons front back)))
(defun timed-seq-linear (score)
; check to insure that times are strictly increasing and >= 0 and stretches are >= 0
(let ((start-time 0) error-msg)
(dolist (event score)
(cond ((< (car event) start-time)
(error (format nil "Out-of-order time in TIMED-SEQ: ~A" event)))
((< (cadr event) 0)
(error (format nil "Negative stretch factor in TIMED-SEQ: ~A" event)))
(t
(setf start-time (car event)))))
;; remove rests (a rest has a :pitch attribute of nil)
(setf score (score-select score #'(lambda (tim dur evt)
(expr-get-attr evt :pitch t))))
(cond ((and score (car score)
(eq (car (event-expression (car score))) 'score-begin-end))
(setf score (cdr score)))) ; skip score-begin-end data
; (score-print score) ;; debugging
(cond ((null score) (s-rest 0))
(t
(at (caar score)
(seqrep (i (length score))
(cond ((cdr score)
(let (event)
(prog1
(set-logical-stop
(stretch (cadar score)
(setf event (expand-and-eval-expr
(caddar score))))
(- (caadr score) (caar score)))
;(display "timed-seq" (caddar score)
; (local-to-global 0)
; (snd-t0 event)
; (- (caadr score)
; (caar score)))
(setf score (cdr score)))))
(t
(stretch (cadar score) (expand-and-eval-expr
(caddar score)))))))))))
|