forked from defaultxr/cl-patterns
-
Notifications
You must be signed in to change notification settings - Fork 0
/
supercollider-score.lisp
157 lines (141 loc) · 8.16 KB
/
supercollider-score.lisp
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
(in-package #:cl-patterns)
;;; support for importing/exporting SuperCollider score files (for NRT synthesis)
;; http://doc.sccode.org/Classes/Score.html
(defclass supercollider-score ()
((list :initarg :list :accessor score-list :documentation "The list of directives in the score."))
(:documentation "A list of instructions for the SuperCollider server to `render' in non-realtime."))
(defun write-synthdef-file (synth)
"Helper function to write the synthdef file for SYNTH to the synthdef path.
See also: `as-score', `render', `write-encoded-score'"
(let ((cl-collider::*synth-definition-mode* :load)
(meta (cl-collider:synthdef-metadata synth)))
(if meta
(eval `(cl-collider:defsynth ,synth ,(getf meta :controls)
,@(getf meta :body)))
(error "Couldn't find metadata for a synthdef with name ~s." synth))))
(defgeneric as-score (object &key tempo dur max-length)
(:documentation "Convert an object into score format.
See also: `render', `write-encoded-score'"))
(defmethod as-score ((events list) &key (tempo (tempo *clock*)) (dur nil dur-provided-p) (max-length *max-pattern-yield-length*))
;; FIX: handle :set events, :mono, etc
(declare (ignore max-length))
(let ((instruments (remove-duplicates (mapcar #'instrument events)))
(gen-events (list))
(dur (if dur-provided-p
dur
(last-dur events)))
(node-id 999))
(flet ((def-name (sym)
(string-downcase (symbol-name sym))))
(append
;; create default group
(list (list 0d0 (list "/g_new" 1 0 0)))
;; load instruments (and make sure their definitions are written)
(loop :for inst :in instruments
:collect (list 0d0 (list "/d_load" (def-name inst)))
:do (write-synthdef-file inst))
;; insert events
(dolist (event events)
(unless (rest-p event)
(let ((ebeat (beat event))
(inst (instrument event))
(cur-node (incf node-id)))
(push (list (float (dur-time (if dur
(min ebeat dur)
ebeat)
tempo)
0d0)
(append (list "/s_new"
(def-name inst)
cur-node
(or (event-value event :add-action) 0)
(event-value event :group))
(loop :for (k v) :on (backend-instrument-args-list inst event :supercollider) :by #'cddr
:append (list (def-name k)
(typecase v
(integer v)
(number (coerce v 'single-float))
(t v))))))
gen-events)
(when (backend-instrument-has-gate-p inst :supercollider)
(let ((end-beat (+ ebeat (sustain event))))
(push (list (float (dur-time (if dur
(min end-beat dur)
end-beat)
tempo)
0d0)
(list "/n_set" cur-node "gate" 0))
gen-events))))))
(sort gen-events #'< :key #'car)
;; add last event to set output length
(when dur
(list (list (float dur 0d0) (list "/c_set" 0 0))))))))
(defmethod as-score ((pattern pattern) &rest args &key (tempo (tempo *clock*)) (dur (dur pattern)) (max-length *max-pattern-yield-length*) &allow-other-keys)
(apply #'as-score (next-upto-n pattern max-length) args))
(defun score-as-sclang-code (score &optional (stream t))
"Write SCORE to STREAM as sclang code.
See also: `as-score', `write-encoded-score'"
(format stream "[~%")
(dolist (item score)
(format stream " [~f, [~{~s, ~}]],~%" (car item) (cadr item)))
(format stream "]~%"))
(defun write-encoded-score (score stream)
"Write SCORE as an encoded score to STREAM. Note that the score's events must be in order based on start time, and all start times must be double floats. Additionally, all instrument parameters must be either integers or single floats."
(dolist (bundle score)
(let ((msg (sc-osc::encode-bundle (cadr bundle) (- (car bundle) osc::+unix-epoch+))))
(write-sequence (osc::encode-int32 (length msg)) stream)
(write-sequence msg stream))))
(defmethod render ((list list) (filename string) &rest args &key sample-rate (sample-format :int24))
(assert (member sample-format (list :int16 :int24 :int32 :float :double)) (sample-format))
(when (event-p (car list))
(return-from render (apply #'render (as-score list) filename args)))
(let ((sample-rate (or sample-rate
(let ((s-sr (cl-collider::server-options-hardware-samplerate
(cl-collider::server-options cl-collider:*s*))))
(unless (zerop s-sr)
s-sr))
48000))
(osc-bin-file (generate-temporary-file-name :directory "/tmp/cl-patterns/osc/"
:extension "osc"))
(extension (pathname-type filename)))
(with-open-file (stream osc-bin-file :direction :output :element-type '(unsigned-byte 8)
:if-exists :rename-and-delete :if-does-not-exist :create)
(write-encoded-score list stream))
(let ((result (multiple-value-list
(uiop:run-program (list "scsynth"
"-o" "2" ;; 2 output channels
"-N" ;; non-realtime rendering
osc-bin-file ;; OSC command file
"_" ;; input audio file (underscore means none)
filename ;; output audio file
(write-to-string sample-rate) ;; sample rate
(if (position extension (list "wav" "aiff") :test #'string-equal) ;; header format
extension
"WAV")
(string-downcase (symbol-name sample-format))) ;; sample format
:ignore-error-status t
:output (list :string :stripped t)
:error-output (list :string :stripped t)))))
(apply #'values (if (zerop (third result))
filename
nil)
result))))
(defmethod render ((event event) output &rest args &key &allow-other-keys)
;; if the user wants to render a lone event without an explicitly-set beat, we assume they just want the event without its `beat' offset.
;; if the user is rendering multiple "tracks" then they will be provided as lists of events or as a pstream, pattern, etc, in which case we don't remove the `beat'.
(apply #'render
(as-score (if (eql t (nth-value 1 (beat event)))
(list (combine-events event (event :beat 0)))
(list event)))
output
args))
(defmethod render ((pattern pattern) output &rest args &key &allow-other-keys)
(apply #'render (as-score pattern) output args))
(defmethod render ((pattern pattern) (output (eql :score)) &rest args &key &allow-other-keys)
(apply #'as-score pattern args))
(defmethod render (object (output (eql :supercollider)) &rest args &key &allow-other-keys)
(let ((wav-file-name (generate-temporary-file-name
:directory (namestring (merge-pathnames "wav/" *cl-patterns-temporary-directory*))
:extension "wav")))
(apply #'render object wav-file-name args)
(cl-collider:buffer-read wav-file-name)))