/usr/share/audacity/nyquist/seqmidi.lsp is in audacity-data 2.0.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 | ;; seqmidi.lsp -- functions to use MIDI files in Nyquist
;
; example call:
;
; (seq-midi my-seq
; (note (chan pitch velocity) (= chan 2) (my-note pitch velocity))
; (ctrl (chan control value) (...))
; (bend (chan value) (...))
; (touch (chan value) (...))
; (prgm (chan value) (setf (aref my-prgm chan) value))
;; seq-midi - a macro to create a sequence of sounds based on midi file
;
;
(defmacro seq-midi (the-seq &rest cases)
(seq-midi-cases-syntax-check cases)
`(let (_the-event _next-time _the-seq _seq-midi-closure _nyq-environment
_the-seq _tag)
(setf _the-seq (seq-copy ,the-seq))
(setf _nyq-environment (nyq:the-environment))
(setf _seq-midi-closure #'(lambda (t0)
; (format t "_seq_midi_closure: t0 = ~A~%" t0)
(prog (_the-sound)
loop ; go forward until we find note to play (we may be there)
; then go forward to find time of next note
(setf _the-event (seq-get _the-seq))
; (display "seq-midi" _the-event t0)
(setf _tag (seq-tag _the-event))
(cond ((= _tag seq-ctrl-tag)
,(make-ctrl-handler cases))
((= _tag seq-bend-tag)
,(make-bend-handler cases))
((= _tag seq-touch-tag)
,(make-touch-handler cases))
((= _tag seq-prgm-tag)
,(make-prgm-handler cases))
((= _tag seq-done-tag)
; (format t "_seq_midi_closure: seq-done")
(cond (_the-sound ; this is the last sound of sequence
; (format t "returning _the-sound~%")
(return _the-sound))
(t ; sequence is empty, return silence
; (format t "returning snd-zero~%")
(return (snd-zero t0 *sound-srate*)))))
((and (= _tag seq-note-tag)
,(make-note-test cases))
(cond (_the-sound ; we now have time of next note
(setf _next-time (/ (seq-time _the-event) 1000.0))
(go exit-loop))
(t
(setf _the-sound ,(make-note-handler cases))))))
(seq-next _the-seq)
(go loop)
exit-loop ; here, we know time of next note
; (display "seq-midi" _next-time)
; (format t "seq-midi calling snd-seq\n")
(return (snd-seq
(set-logical-stop-abs _the-sound
(local-to-global _next-time))
_seq-midi-closure)))))
; (display "calling closure" (get-lambda-expression _seq-midi-closure))
(funcall _seq-midi-closure (local-to-global 0))))
(defun seq-midi-cases-syntax-check (cases &aux n)
(cond ((not (listp cases))
(break "syntax error in" cases)))
(dolist (case cases)
(cond ((or (not (listp case))
(not (member (car case) '(NOTE CTRL BEND TOUCH PRGM)))
(not (listp (cdr case)))
(not (listp (cadr case)))
(not (listp (cddr case)))
(not (listp (last (cddr case)))))
(break "syntax error in" case))
((/= (length (cadr case))
(setf n (cdr (assoc (car case)
'((NOTE . 3) (CTRL . 3) (BEND . 2)
(TOUCH . 2) (PRGM . 2))))))
(break (format nil "expecting ~A arguments in" n) case))
((and (eq (car case) 'NOTE)
(not (member (length (cddr case)) '(1 2))))
(break
"note handler syntax is (NOTE (ch pitch vel) [filter] behavior)"
case)))))
(defun make-ctrl-handler (cases)
(let ((case (assoc 'ctrl cases)))
(cond (case
`(let ((,(caadr case) (seq-channel _the-event))
(,(cadadr case) (seq-control _the-event))
(,(caddar (cdr case)) (seq-value _the-event)))
,@(cddr case)))
(t nil))))
(defun make-bend-handler (cases)
(let ((case (assoc 'bend cases)))
(cond (case
`(let ((,(caadr case) (seq-channel _the-event))
(,(cadadr case) (seq-value _the-event)))
,@(cddr case)))
(t nil))))
(defun make-touch-handler (cases)
(let ((case (assoc 'touch cases)))
(cond (case
`(let ((,(caadr case) (seq-channel _the-event))
(,(cadadr case) (seq-value _the-event)))
,@(cddr case)))
(t nil))))
(defun make-prgm-handler (cases)
(let ((case (assoc 'pgrm cases)))
(cond (case
`(let ((,(caadr case) (seq-channel _the-event))
(,(cadadr case) (seq-value _the-event)))
,@(cddr case)))
(t nil))))
(defun make-note-test (cases)
(let ((case (assoc 'note cases)))
(cond ((and case (cdddr case))
(caddr case))
(t t))))
(defun make-note-handler (cases)
(let ((case (assoc 'note cases))
behavior)
(cond ((and case (cdddr case))
(setf behavior (cadddr case)))
(t
(setf behavior (caddr case))))
`(with%environment _nyq-environment
(with-note-args ,(cadr case) _the-event ,behavior))))
(defmacro with-note-args (note-args the-event note-behavior)
; (display "with-note-args" the-event)
`(let ((,(car note-args) (seq-channel ,the-event))
(,(cadr note-args) (seq-pitch ,the-event))
(,(caddr note-args) (seq-velocity ,the-event)))
(at (/ (seq-time ,the-event) 1000.0)
(stretch (/ (seq-duration ,the-event) 1000.0) ,note-behavior))))
;(defun seq-next-note-time (the-seq find-first-flag)
; (prog (event)
; (if find-first-flag nil (seq-next the-seq))
;loop
; (setf event (seq-get the-seq))
; (cond ((eq (seq-tag event) seq-done-tag)
; (return (if find-first-flag 0.0 nil)))
; ((eq (seq-tag event) seq-note-tag)
; (return (/ (seq-time event) 1000.0))))
; (seq-next the-seq)
; (go loop)))
;
|