Autres/audacity
1
0
Fork 0
mirror of https://github.com/cookiengineer/audacity synced 2026-01-12 15:45:54 +01:00
Code Issues Releases Wiki Activity

Update Nyquist runtime to r288

Browse Source 
Totally forgot about these when upgrading Nyquist to r288.
This commit is contained in:
Leland Lucius
2020-01-13 12:43:39 -06:00
parent 69ee0a8963
commit e6c1a89123
18 changed files with 3263 additions and 1434 deletions
Download Patch File Download Diff File Expand all files Collapse all files

119
nyquist/seq.lsp
View File

@@ -25,44 +25,50 @@
; later. Finally, it is also necessary to save the current transformation
; environment until later.
;; SEQ-EXPR-EXPAND - helper function, expands expression to push/pop entry
;; on *sal-call-stack* to help debug calls into SAL from lazy evaluation
;; of SAL code by SEQ
(defun seq-expr-expand (expr)
(if *sal-call-stack*
(list 'prog2 (list 'sal-trace-enter (list 'quote (list "Expression in SEQ:" expr)))
expr
'(sal-trace-exit))
expr))
(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))
;; SEQ with 2 behaviors
`(let* ((first%sound ,(seq-expr-expand (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)))))))
(force-srates s%rate ,(seq-expr-expand (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))
#'(lambda (t0)
(with%environment ',(nyq:the-environment)
(at-abs t0
(force-srate s%rate ,(cadr list))))))))))
(force-srate s%rate ,(seq-expr-expand (cadr list)))))))))))
(t
(t ;; SEQ with more than 2 behaviors
`(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)
@@ -76,9 +82,10 @@
(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))
;; last expression in list
`(eval-seq-behavior ,(seq-expr-expand (car behavior-list))))
(t ;; more expressions after this one
`(snd-seq (eval-seq-behavior ,(seq-expr-expand (car behavior-list)))
(evalhook '#'(lambda (t0)
; (format t "lambda depth ~A~%" (envdepth (getenv)))
(seq-iterate ,(cdr behavior-list)))
@@ -86,11 +93,10 @@
(defmacro multiseq-iterate (behavior-list)
(cond ((null (cdr behavior-list))
`(eval-multiseq-behavior ,(car behavior-list)))
`(eval-multiseq-behavior ,(seq-expr-expand (car behavior-list))))
(t
`(snd-multiseq (eval-multiseq-behavior ,(car behavior-list))
`(snd-multiseq (eval-multiseq-behavior ,(seq-expr-expand (car behavior-list)))
(evalhook '#'(lambda (t0)
; (format t "lambda depth ~A~%" (envdepth (getenv)))
(multiseq-iterate ,(cdr behavior-list)))
nil nil seq%environment)))))
@@ -101,7 +107,6 @@
(defmacro eval-multiseq-behavior (beh)
`(with%environment nyq%environment
; (display "MULTISEQ 2" t0)
(at-abs t0
(force-srates s%rate ,beh))))
@@ -121,7 +126,7 @@
(error "bad argument type" loop%count))
(t
(setf seqrep%closure #'(lambda (t0)
; (display "SEQREP" loop%count ,(car pair))
; (display "SEQREP" loop%count ,(car pair))
(cond ((< ,(car pair) loop%count)
(setf first%sound
(with%environment nyq%environment
@@ -159,7 +164,7 @@
(defmacro trigger (input beh)
`(let ((nyq%environment (nyq:the-environment)))
(snd-trigger ,input #'(lambda (t0) (with%environment nyq%environment
(at-abs t0 ,beh))))))
(at-abs t0 ,beh))))))
;; EVENT-EXPRESSION -- the sound of the event
;;
@@ -179,12 +184,12 @@
(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))))))
((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
@@ -192,11 +197,11 @@
(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)))))
(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) ...))
@@ -227,6 +232,7 @@
;;
(setf MAX-LINEAR-SCORE-LEN 100)
(defun timed-seq (score)
(must-be-valid-score "TIMED-SEQ" score)
(let ((len (length score))
pair)
(cond ((< len MAX-LINEAR-SCORE-LEN)
@@ -250,12 +256,15 @@
(cons front back)))
;; TIMED-SEQ-LINEAR - check to insure that times are strictly increasing
;; and >= 0 and stretches are >= 0
(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)
(let ((start-time 0) error-msg rslt)
(dolist (event score)
(cond ((< (car event) start-time)
(error (format nil "Out-of-order time in TIMED-SEQ: ~A" event)))
(error (format nil
"Out-of-order time in TIMED-SEQ: ~A, consider using SCORE-SORT"
event)))
((< (cadr event) 0)
(error (format nil "Negative stretch factor in TIMED-SEQ: ~A" event)))
(t
@@ -264,30 +273,26 @@
(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
(eq (car (event-expression (car score))) 'score-begin-end))
(setf score (cdr score)))) ; skip score-begin-end data
(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)))))))))))
(progn
(cond (*sal-call-stack*
(sal-trace-enter (list "Score event:" (car score)) nil nil)
(setf *sal-line* 0)))
(setf rslt
(cond ((cdr score)
(prog1
(set-logical-stop
(stretch (cadar score)
(expand-and-eval-expr (caddar score)))
(- (caadr score) (caar score)))
(setf score (cdr score))))
(t
(stretch (cadar score) (expand-and-eval-expr
(caddar score))))))
(if *sal-call-stack* (sal-trace-exit))
rslt)))))))