mirror of
https://github.com/cookiengineer/audacity
synced 2026-01-12 15:45:54 +01:00
Locate and position the current Audacity source code, and clear a variety of old junk out of the way into junk-branches
This commit is contained in:
ra
252
nyquist/seq.lsp
Normal file
252
nyquist/seq.lsp
Normal file
@@ -0,0 +1,252 @@
|
||||
;; 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
|
||||
;;
|
||||
(defun timed-seq (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)))))))))))
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user