add supercollider score generation functionality + render function

README.org

@@ -144,6 +144,7 @@ Don't cut yourself on these. These are the weaker parts of the library; they're
 *** formats
 
 - [[file:src/formats/midifile.lisp][midifile.lisp]] - functionality to interact with MIDI files (load the ~cl-patterns/midifile~ system to use this).
+- [[file:src/formats/supercollider-score.lisp][supercollider-score.lisp]] - functionality to interact with [[http://doc.sccode.org/Classes/Score.html][SuperCollider Score]] files (load the ~cl-patterns/supercollider/score~ system to use this).
 
 *** extensions
 

cl-patterns.asd

@@ -67,7 +67,8 @@
   :depends-on (#:cl-patterns
                #:cl-collider)
   :serial t
-  :components ((:file "src/backends/supercollider")))
+  :components ((:file "src/backends/supercollider")
+               (:file "src/formats/supercollider-score")))
 
 (asdf:defsystem #:cl-patterns/incudine
   :name "cl-patterns/incudine"

src/formats/supercollider-score.lisp

@@ -0,0 +1,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 (multiple-value-elt (beat event) 1))
+                       (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)))

src/package.lisp

@@ -6,6 +6,8 @@
 
    ;;; utility.lisp
 
+   #:*cl-patterns-temporary-directory*
+
    #:*event*
    #:*clock*
 
@@ -25,6 +27,7 @@
    #:loop-p
    #:play-or-stop
    #:play-or-end
+   #:render
 
    ;;; conversions.lisp
 

src/utility.lisp

@@ -1,5 +1,11 @@
 (in-package #:cl-patterns)
 
+;;; customizable settings
+
+(defvar *cl-patterns-temporary-directory*
+  (merge-pathnames "cl-patterns/" (uiop:temporary-directory))
+  "The default directory to store `render'ed files in.")
+
 ;;; special variables
 
 (defvar *event* nil
@@ -302,11 +308,60 @@ See also: `play-or-stop', `play-or-end', `playing-pdefs'"))
         nil)
       (play object)))
 
-
-
-
-
-
+(defgeneric render (object output &key tempo max-pattern-yield-length max-output-duration &allow-other-keys)
+  (:documentation "Render a pattern or other object as audio or other format. OUTPUT is what the pattern should be rendered as. It accepts the following values:
+
+- A string - Output file name (file format is determined by the file extension).
+- :buffer - Render to a buffer in the relevant backend (determined by parameters of OBJECT, i.e. instrument or backend keys of events).
+- :bdef - Render to a buffer handled by `bdef:bdef' if the bdef library is loaded. Falls back to :buffer if bdef is not loaded.
+- :file - Render to a file in the `*cl-patterns-temporary-directory*'.
+- :score - Render as a SuperCollider score in memory. Only works if the cl-patterns/supercollider/score system is loaded. Can also be rendered to a file if a .osc filename is provided and :supercollider is provided for BACKEND.
+- :pstream - Make a pstream from the pattern and grab outputs to it. Effectively defers to `next-upto-n'.
+- :eseq - Make an `eseq' from the pattern. Effectively defers to `as-eseq'.
+- Any backend name - Render as a buffer in that backend.
+
+The following additional keyword arguments are also supported, depending on the output type:
+
+- BACKEND - The name of the backend to use to render. Defaults to the first enabled backend.
+- TEMPO - The tempo of the result in beats per second. Defaults to `*clock*''s current tempo.
+- MAX-PATTERN-YIELD-LENGTH - Maximum number of outputs to grab from the source pattern. Must be an integer (cannot be :inf). See also: `*max-pattern-yield-length*'.
+- MAX-OUTPUT-DURATION - The maximum duration of the output in seconds. Defaults to infinite, in which case the pattern is limited by MAX-PATTERN-YIELD-LENGTH.
+
+See also: `as-eseq'"))
+
+(defmethod render (object (output (eql :pstream)) &key max-pattern-yield-length)
+  (next-upto-n object (or max-pattern-yield-length *max-pattern-yield-length*)))
+
+(defmethod render (object (output pathname) &rest args &key &allow-other-keys)
+  (apply #'render object (namestring output) args))
+
+(defun find-backend-supporting-render (render-type)
+  "Get the output and backend names of the first enabled backend that supports RENDER-TYPE (i.e. :buffer, :file, :score, etc), or nil if none support it.
+
+See also: `render'"
+  (let ((backends (enabled-backends)))
+    (dolist (backend backends)
+      (let ((sym (my-intern (concat backend "-" render-type) :keyword)))
+        (when (find-method #'render nil (list t (list 'eql sym)) nil)
+          (return-from find-backend-supporting-render (values sym backend)))))))
+
+(defmacro make-default-render-method (type)
+  "Generate a default `render' method."
+  `(defmethod render (object (output (eql ,type)) &rest args &key &allow-other-keys)
+     (let ((backend (getf args :backend)))
+       (if backend
+           (apply #'render object output args)
+           (if-let ((backend (find-backend-supporting-render ,type)))
+             (apply #'render object backend args)
+             (error "No enabled backend supports rendering as ~s." ,type))))))
+
+(defmacro make-default-render-methods ()
+  "Generate the default `render' methods for :buffer, :file, :score, etc."
+  `(progn
+     ,@(loop :for type :in (list :buffer :file :score)
+             :collect `(make-default-render-method ,type))))
+
+(make-default-render-methods)
 
 ;;; macros / MOP stuff