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)))
;
|
