devices/client.lisp

@@ -1,6 +1,6 @@
 (cl:in-package #:osc)
 
-(defun make-osc-client (&key(protocol :udp) debug-mode
+(defun make-osc-client (&key (protocol :udp) debug-mode
                         (buffer-size *default-osc-buffer-size*)
                         address-tree cleanup-fun)
   (ecase protocol
@@ -28,25 +28,25 @@
 
 (defmethod make-client-responders ((client osc-client-udp))
   (add-osc-responder client "/cl-osc/server/registered"
-      (cmd args device address port timetag)
+      (cmd args device address port timetag bundle)
     (format t "Registered with server at ~A~%"
             (make-addr+port-string address port)))
   (add-osc-responder client "/cl-osc/server/quit"
-      (cmd args device address port timetag)
+      (cmd args device address port timetag bundle)
     (format t "Server ~A has quit~%"
             (make-addr+port-string address port))))
 
 (defgeneric register (client)
   (:method ((client osc-client-udp))
-    (send client "/cl-osc/register" (port client))))
+    (send-msg client "/cl-osc/register" (port client))))
 
 (defmethod osc-device-cleanup ((device osc-client-udp))
-  (send device "/cl-osc/quit")
+  (send-msg device "/cl-osc/quit")
   (call-next-method))
 
 (defun make-osc-client-endpoint-tcp (socket debug-mode buffer-size
                                      address-tree clients &optional
-                                                            cleanup-fun)
+                                     cleanup-fun)
   (socket-make-stream socket
                       :input nil :output t
                       :element-type '(unsigned-byte 8)
@@ -74,14 +74,14 @@
                   (when (eq length 0)   ; Closed by remote
                     (sb-thread:terminate-thread
                      sb-thread:*current-thread*))
-                  (multiple-value-bind (message timetag)
-                      (decode-bundle buffer length)
+                  (multiple-value-bind (data timetag)
+                      (decode-bundle buffer :end length)
                     (when (debug-mode receiver)
-                      (print-osc-debug-msg receiver message length
+                      (print-osc-debug-msg receiver data length
                                            (peer-address receiver)
                                            (peer-port receiver) timetag))
-                    (dispatch (address-tree receiver) message receiver
-                              address port timetag))))
+                    (dispatch (address-tree receiver) data receiver
+                              address port))))
        (osc-device-cleanup receiver)))
    :name (format nil "osc-client-tcp-connection: ~A~%"
                  (name receiver))))

devices/dispatching-device.lisp

@@ -9,13 +9,13 @@
              do (multiple-value-bind (buffer length address port)
                     (socket-receive (socket receiver)
                                     (socket-buffer receiver) nil)
-                  (multiple-value-bind (message timetag)
-                      (osc:decode-bundle buffer length)
+                  (multiple-value-bind (data timetag)
+                      (osc:decode-bundle buffer :end length)
                     (when (debug-mode receiver)
-                      (print-osc-debug-msg receiver message length
+                      (print-osc-debug-msg receiver data length
                                            address port timetag))
-                    (osc:dispatch (address-tree receiver) message
-                                  receiver address port timetag))))
+                    (dispatch (address-tree receiver) data receiver
+                              address port))))
        (osc-device-cleanup receiver)))
    :name (format nil "osc-receiver-udp: ~A~%" (name receiver))))
 
@@ -25,12 +25,13 @@
 ;;;=====================================================================
 
 (defmacro add-osc-responder (dispatcher cmd-name
-                             (cmd args disp addr port timetag) &body
-                                                                 body)
+                             (cmd args device address port timetag bundle)
+                             &body body)
   `(dp-register (address-tree ,dispatcher) ,cmd-name
-                (lambda (,cmd ,args ,disp ,addr ,port ,timetag)
-                  (declare (ignorable ,cmd ,args ,disp ,addr
-                                      ,port ,timetag))
+                (lambda (,cmd ,args ,device ,address ,port ,timetag
+                         ,bundle)
+                  (declare (ignorable ,cmd ,args ,device ,address
+                                      ,port ,timetag ,bundle))
                   ,@body)))
 
 (defgeneric remove-osc-responder (dispatcher address)

devices/examples/osc-device-examples.lisp

@@ -23,7 +23,7 @@
 (peer-address *osc-transmitter*)
 (peer-port *osc-transmitter*)
 
-(send *osc-transmitter* "/bar" 1 2 9)
+(send-msg *osc-transmitter* "/bar" 1 2 9)
 
 (send-bundle *osc-transmitter*
              :time ; current real time
@@ -37,6 +37,24 @@
              (unix-time->timetag 1234567890.1234567d0)
              "/foo" 1 2 3)
 
+;; The lower-level send function can be used to send message and
+;; bundle objects directly. This allows more complex (nested) bundles
+;; to be created.
+
+(send *osc-transmitter* (make-message "/foo" 1 2 3))
+
+(send *osc-transmitter* (make-bundle :now
+                                     (make-message "/foo" 1 2 3)))
+
+(let ((bundle
+       (make-bundle :now
+                    (make-message "/foo" '(1 2 3))
+                    (make-bundle :now
+                                 (make-bundle :now
+                                              (make-message "/bar"
+                                                            '(10 20 30)))))))
+  (send *osc-transmitter* bundle))
+
 (quit *osc-transmitter*)
 (quit *osc-server*)
 
@@ -65,7 +83,7 @@
 
 (connect *osc-client* 57127 :host-name "localhost")
 
-(send *osc-client* "/foo" 2 99)
+(send-msg *osc-client* "/foo" 2 99)
 
 (send-bundle *osc-client*
              (unix-time->timetag 1234567890.1234567d0)
@@ -76,45 +94,65 @@
 (send-bundle *osc-client* :time "/foo" 1)
 
 ;; Using the server as a transmitter.
-(send-to *osc-server* (address *osc-client*) (port *osc-client*)
-         "/bar" 1 2 3)
+(send-msg-to *osc-server*
+             (address *osc-client*) (port *osc-client*)
+             "/bar" 1 2 3)
+
+(send-bundle-to *osc-server*
+                (address *osc-client*) (port *osc-client*)
+                :now "/bar" 1 2 3)
 
 ;; If a client is registered...
-(send-to-client *osc-server* (make-name-string *osc-client*)
-                "/bar" 2 99)
+(send-msg-to-client *osc-server* (make-name-string *osc-client*)
+                    "/bar" 2 99)
 
 (register *osc-client*)
 
-(send-to-client *osc-server* (make-name-string *osc-client*)
-                "/bar" 2 99)
+(send-msg-to-client *osc-server* (make-name-string *osc-client*)
+                    "/bar" 2 99)
 
 (send-bundle-to-client *osc-server*
                        (make-name-string *osc-client*)
-                       :timeq "/bar" 2 99)
+                       :time "/bar" 2 99)
 
 (add-osc-responder *osc-server* "/echo-sum"
-    (cmd args device address port timetag)
-  (send-to device address port "/echo-answer" (apply #'+ args)))
+    (cmd args dev addr port timetag bundle)
+  (send-msg-to dev addr port
+           "/echo-answer" (apply #'+ args)))
 
 (add-osc-responder *osc-client* "/echo-answer"
-    (cmd args device address port timetag)
-  (format t "~%Sum is ~A" (car args)))
+    (cmd args dev addr port timetag bundle)
+  (format t "Sum is ~a~%" (car args)))
 
-(send *osc-client* "/echo-sum" 1 2 3 4)
+(send-msg *osc-client* "/echo-sum" 1 2 3 4)
 
 (add-osc-responder *osc-server* "/timetag+1"
-    (cmd args device address port timetag)
-  (send-bundle-to device address port (timetag+ timetag 1) "/future"))
+    (cmd args dev addr port timetag bundle)
+  (send-bundle-to dev addr port (timetag+ timetag 1) "/the-future"))
 
 (send-bundle *osc-client* (get-current-timetag)
              "/timetag+1")
 
 ;; Send a messages to all registered clients.
-(send-all *osc-server* "/foo" 1 2 3)
+(send-msg-all *osc-server* "/foo" 1 2 3)
 
 (send-bundle-all *osc-server* :now "/foo" 1 2 3)
 
+(defparameter *osc-client2* (make-osc-client
+                             :protocol :udp
+                             :debug-mode t))
+
+(connect *osc-client2* 57127)
+(register *osc-client2*)
+
+(add-osc-responder *osc-server* "/echo-sum"
+    (cmd args dev addr port timetag bundle)
+  (send-msg-all dev "/echo-answer" (apply #'+ args)))
+
+(send-msg *osc-client* "/echo-sum" 1 2 3 4)
+
 (quit *osc-client*)
+(quit *osc-client2*)
 (quit *osc-server*)
 
 
@@ -137,11 +175,11 @@
 (device-socket-name *osc-client*)
 (device-socket-peername *osc-client*)
 
-(send *osc-client* "/foo" 1 2 3)
+(send-msg *osc-client* "/foo" 1 2 3)
 
-(send-to-client *osc-server* (make-name-string
-                              *osc-client*)
-                "/foo" 1 2 3)
+(send-msg-to-client *osc-server* (make-name-string
+                                  *osc-client*)
+                    "/foo" 1 2 3)
 
 (defparameter *osc-client2* (make-osc-client
                              :protocol :tcp
@@ -153,30 +191,30 @@
 
 (device-socket-name *osc-client2*)
 
-(send *osc-client2* "/bar" 4 5 6 9)
+(send-msg *osc-client2* "/bar" 4 5 6 9)
 
 (print-clients *osc-server*)
 
 (add-osc-responder *osc-server* "/print-sum"
-    (cmd args device address port timetag)
+    (cmd args dev addr port timetag bundle)
   (format t "Sum = ~A~%" (apply #'+ args)))
 
-(send *osc-client2* "/print-sum" 4 5 6 9)
+(send-msg *osc-client2* "/print-sum" 4 5 6 9)
 
 (add-osc-responder *osc-server* "/echo-sum"
-    (cmd args disp address port timetag)
-  (send disp cmd (apply #'+ args)))
+    (cmd args dev addr port timetag bundle)
+  (send-msg dev cmd (apply #'+ args)))
 
-(send *osc-client2* "/echo-sum" 4 5 6 9)
+(send-msg *osc-client2* "/echo-sum" 4 5 6 9)
 
-(send-all *osc-server* "/bar" 1 2 3) ; send to all peers
+(send-msg-all *osc-server* "/bar" 1 2 3) ; send to all peers
 
 (add-osc-responder *osc-server* "/echo-sum-all"
-    (cmd args disp address port timetag)
-  (send-all disp cmd (apply #'+ args)))
+    (cmd args dev addr port timetag bundle)
+  (send-msg-all dev cmd (apply #'+ args)))
 
-; Send to all peers (excluding self).
-(send *osc-client2* "/echo-sum-all" 1 2 3)
+; Send to all peers (including self).
+(send-msg *osc-client2* "/echo-sum-all" 1 2 3)
 
 (quit *osc-client*)
 (quit *osc-client2*)
@@ -204,15 +242,15 @@ c=OSCresponder(nil,
                {|t,r,msg,addr| [t,r,msg,addr].postln}).add
 ;;---------------------------------------------------------------------
 
-(send *osc-client* "/foo" 1 2 3)
+(send-msg *osc-client* "/foo" 1 2 3)
 
 (send-bundle *osc-client*
              (get-current-timetag)
              "/foo" 3)
 
 (add-osc-responder *osc-client* "/echo-sum"
-    (cmd args disp addr port timetag)
-  (send disp cmd (apply #'+ args)))
+    (cmd args dev addr port timetag bundle)
+  (send-msg dev cmd (apply #'+ args)))
 
 ;;---------------------------------------------------------------------
 ;; Send /echo-sum from sc, and lisp returns the sum.
@@ -240,15 +278,15 @@ n.sendMsg('/echo-sum', 1, 2, 3) // send numbers, lisp returns sum.
 
 (connect *osc-client* 57110 :host-name "localhost" :port 57127)
 
-(send *osc-client* "/s_new" "default" 1001 0 0 "freq" 500)
+(send-msg *osc-client* "/s_new" "default" 1001 0 0 "freq" 500)
 
-(send *osc-client* "/n_free" 1001)
+(send-msg *osc-client* "/n_free" 1001)
 
 (send-bundle *osc-client*
              (timetag+ (get-current-timetag) 2) ; 2 secs later
              "/s_new" "default" 1001 0 0 "freq" 500)
 
-(send *osc-client* "/n_free" 1001)
+(send-msg *osc-client* "/n_free" 1001)
 
 (quit *osc-client*) ; Sends default /quit notification which scsynth
                     ; ignores. Ideally osc-client should be subclassed

devices/listening-device.lisp

@@ -19,9 +19,13 @@
   (fill (socket-buffer device) 0)
   (call-next-method))
 
-(defun print-osc-debug-msg (receiver message length address port
-                            timetag)
-  (format t "~%~A~%received:~A~A~%bytes:~A~A~A~%from:~A~A~A ~A ~%timetag:~A~A~%unix-time:~A~F~%"
-          (name receiver) #\Tab message #\Tab #\Tab length #\Tab #\Tab
+(defun print-osc-debug-msg (receiver data length address port
+                            timetag &optional (stream t))
+  (format stream
+          "~&~a~%bytes rx:~a~a~%from:~a~a~a ~a~%timetag:~a~a~%unix-time:~a~f~%data:~a~a"
+          (name receiver) #\Tab length #\Tab #\Tab
           address port #\Tab timetag #\Tab
-          (when timetag (timetag->unix-time timetag))))
+          (when timetag (timetag->unix-time timetag))
+          #\Tab #\Tab)
+  (format-osc-data data stream)
+  (format stream "~%"))

devices/server.lisp

@@ -80,13 +80,13 @@
 
 (defmethod make-server-responders ((server osc-server-udp))
   (add-osc-responder server "/cl-osc/register"
-      (cmd args device address port timetag)
+      (cmd args device address port timetag bundle)
     (let ((listening-port (car args))) ; Optional port for sending
-                                        ; return messages to.
+                                       ; return messages.
       (register-udp-client device address
                            (if listening-port listening-port port))))
   (add-osc-responder server "/cl-osc/quit"
-      (cmd args device address port timetag)
+      (cmd args device address port timetag bundle)
     (unregister-udp-client device address port)))
 
 (defun register-udp-client (server addr port)
@@ -107,10 +107,10 @@
     (notify-registered server client-name)))
 
 (defun notify-registered (server client-name)
-  (send-to-client server client-name "/cl-osc/server/registered"))
+  (send-msg-to-client server client-name "/cl-osc/server/registered"))
 
 (defun notify-quit (server client-name)
-  (send-to-client server client-name "/cl-osc/server/quit"))
+  (send-msg-to-client server client-name "/cl-osc/server/quit"))
 
 
 ;;;=====================================================================
@@ -153,30 +153,72 @@
 ;;; Server sending functions
 ;;;=====================================================================
 
-(defgeneric send-to-client (server client-name &rest msg)
-  (:method :around ((server osc-server) client-name &rest msg)
+;; Send to a client
+
+(defgeneric send-to-client (server client-name data)
+  (:method :around ((server osc-server) client-name data)
            (let ((client (gethash client-name (clients server))))
              (if client
-                 (apply #'call-next-method server client msg)
+                 (call-next-method server client data)
                  (warn "No client called ~A~%" client-name)))))
 
-(defmethod send-to-client ((server osc-server-udp) client-name &rest
-                                                                 msg)
-  (apply #'send-to server (first client-name) (second client-name)
-         msg))
+(defmethod send-to-client ((server osc-server-udp) client-name data)
+  (send-to server (first client-name) (second client-name) data))
 
-(defmethod send-to-client ((server osc-server-tcp) client &rest msg)
-  (apply #'send client msg))
+(defmethod send-to-client ((server osc-server-tcp) client data)
+  (send client data))
 
-(defgeneric send-bundle-to-client (server client-name timetag &rest
-                                                                msg)
-  (:method :around ((server osc-server) client-name timetag &rest msg)
-           (let ((client (gethash client-name (clients server))))
-             (if client
-                 (apply #'call-next-method server client timetag msg)
-                 (warn "No client called ~A~%" client-name)))))
+(defgeneric send-msg-to-client (server client-name command &rest args)
+  (:method ((server osc-server) client-name command &rest args)
+    (let ((message (apply #'make-message command args)))
+      (send-to-client server client-name message))))
 
-(defmethod send-bundle-to-client ((server osc-server-udp) client-name
-                                  timetag &rest msg)
-  (apply #'send-bundle-to server (first client-name)
-         (second client-name) timetag msg))
+(defgeneric send-bundle-to-client (server client-name timetag command
+                                   &rest args)
+  (:method ((server osc-server) client-name timetag command &rest
+                                                              args)
+    (let ((bundle (make-bundle timetag
+                               (apply #'make-message command args))))
+      (send-to-client server client-name bundle))))
+
+;; Send all
+
+(defgeneric send-all (server data))
+
+(defmethod send-all ((server osc-server-udp) data)
+  (loop for addr+port being the hash-value in (clients server)
+     do (send-to server (first addr+port) (second addr+port) data)))
+
+(defmethod send-all ((server osc-server-tcp) data)
+  (loop for endpoint being the hash-value in (clients server)
+     do (send endpoint data)))
+
+(defmethod send-all ((client-endpoint osc-client-endpoint) data)
+  (loop for endpoint being the hash-value in (clients client-endpoint)
+     ;; FIXME: Don't not reply to the sender in this case so that the
+     ;; behaviour of send-all is uniform for both UDP and TCP. But
+     ;; could be useful to have a means of broadcasting messages to
+     ;; all clients of a server except the client that generated the
+     ;; message.
+     ;;
+     ;; unless (eq endpoint client-endpoint) ; don't send to sender
+     do (send endpoint data)))
+
+(defgeneric send-msg-all (server command &rest args)
+  (:method ((server osc-server) command &rest args)
+    (let ((message (apply #'make-message command args)))
+      (send-all server message)))
+  (:method ((client-endpoint osc-client-endpoint) command &rest args)
+    (let ((message (apply #'make-message command args)))
+      (send-all client-endpoint message))))
+
+(defgeneric send-bundle-all (server timetag command &rest args)
+  (:method ((server osc-server) timetag command &rest args)
+    (let ((bundle (make-bundle timetag
+                               (apply #'make-message command args))))
+      (send-all server bundle)))
+  (:method ((client-endpoint osc-client-endpoint) timetag command
+            &rest args)
+    (let ((bundle (make-bundle timetag
+                               (apply #'make-message command args))))
+      (send-all client-endpoint bundle))))

devices/transmitter.lisp

@@ -59,69 +59,41 @@
   `(progn (write-sequence ,@msg ,stream)
           (finish-output ,stream)))
 
-(defgeneric send (transmitter &rest msg-args)
-  (:method ((transmitter osc-transmitter) &rest msg-args)
-    (let ((msg (apply #'encode-message msg-args)))
+(defgeneric send (transmitter data)
+  (:method ((transmitter osc-transmitter) data)
+    (let ((bytes (encode-osc-data data)))
       (osc-write-to-stream
-          (slot-value (socket transmitter) 'stream) msg))))
+          (slot-value (socket transmitter) 'stream) bytes))))
 
-(defgeneric send-bundle (transmitter timetag &rest msg-args)
-  (:method ((transmitter osc-transmitter) timetag &rest msg-args)
-    (let ((msg (encode-bundle msg-args timetag)))
-      (osc-write-to-stream
-          (slot-value (socket transmitter) 'stream) msg))))
+(defgeneric send-msg (transmitter command &rest args)
+  (:method ((transmitter osc-transmitter) command &rest args)
+    (let ((message (apply #'make-message command args)))
+      (send transmitter message))))
 
-;; Unconnected sending
+(defgeneric send-bundle (transmitter timetag command &rest args)
+  (:method ((transmitter osc-transmitter) timetag command &rest args)
+    (let ((bundle (make-bundle timetag
+                               (apply #'make-message command args))))
+      (send transmitter bundle))))
 
-(defgeneric send-to (transmitter address port &rest msg-args)
-  (:method ((transmitter osc-transmitter-udp) address port &rest
-                                                             msg-args)
+;; Unconnected sending (UDP only)
+
+(defgeneric send-to (transmitter address port data)
+  (:method ((transmitter osc-transmitter-udp) address port data)
     (socket-send (socket transmitter)
-                 (apply #'encode-message msg-args) nil
+                 (encode-osc-data data) nil
                  :address (list address port))))
 
-(defgeneric send-bundle-to (transmitter address port timestamp &rest
-                                                                 msg-args)
-  (:method ((transmitter osc-transmitter-udp) address port timestamp
-            &rest msg-args)
-    (socket-send (socket transmitter)
-                 (apply #'encode-bundle msg-args (list timestamp)) nil
-                 :address (list address port))))
+(defgeneric send-msg-to (transmitter address port command &rest args)
+  (:method ((transmitter osc-transmitter-udp) address port command
+            &rest args)
+    (let ((message (apply #'make-message command args)))
+      (send-to transmitter address port message))))
 
-;; Server functions
-
-(defgeneric send-all (server &rest msg-args))
-
-(defmethod send-all ((server osc-server-udp) &rest msg-args)
-  (loop for addr+port being the hash-value in (clients server)
-     do (apply #'send-to server (first addr+port) (second addr+port)
-               msg-args)))
-
-(defmethod send-all ((server osc-server-tcp) &rest msg-args)
-  (loop for endpoint being the hash-value in (clients server)
-     do (apply #'send endpoint msg-args)))
-
-(defmethod send-all ((client-endpoint osc-client-endpoint) &rest
-                                                             msg-args)
-  (loop for endpoint being the hash-value in (clients client-endpoint)
-     unless (eq endpoint client-endpoint) ; don't send to sender
-     do (apply #'send endpoint msg-args)))
-
-(defgeneric send-bundle-all (server timetag &rest msg-args))
-
-(defmethod send-bundle-all ((server osc-server-udp) timetag &rest
-                                                              msg-args)
-  (loop for addr+port being the hash-value in (clients server)
-     do (apply #'send-bundle-to server (first addr+port)
-               (second addr+port) timetag msg-args)))
-
-(defmethod send-bundle-all ((server osc-server-tcp) timetag &rest
-                                                              msg-args)
-  (loop for endpoint being the hash-value in (clients server)
-     do (apply #'send-bundle endpoint timetag msg-args)))
-
-(defmethod send-bundle-all ((client-endpoint osc-client-endpoint)
-                            timetag &rest msg-args)
-  (loop for endpoint being the hash-value in (clients client-endpoint)
-     unless (eq endpoint client-endpoint) ; don't send to sender
-     do (apply #'send-bundle endpoint timetag msg-args)))
+(defgeneric send-bundle-to (transmitter address port timetag command
+                            &rest args)
+  (:method ((transmitter osc-transmitter-udp) address port timetag
+            command &rest args)
+    (let ((bundle (make-bundle timetag
+                               (apply #'make-message command args))))
+      (send-to transmitter address port bundle))))

osc-data.lisp

@@ -0,0 +1,49 @@
+(cl:in-package #:osc)
+
+;; Classes
+
+(defclass osc-data () ())
+
+(defclass message (osc-data)
+  ((command
+    :reader command
+    :initarg :command)
+   (args
+    :reader args
+    :initarg :args
+    :initform nil)))
+
+(defclass bundle (osc-data)
+  ((timetag
+    :reader timetag
+    :initarg :timetag
+    :initform :now)
+   (elements
+    :reader elements
+    :initarg :elements
+    :initform nil)))
+
+;; Constructors
+
+(defun make-message (command &rest args)
+  (make-instance 'message
+                 :command command
+                 :args args))
+
+(defun make-bundle (timetag &rest elements)
+  (make-instance 'bundle
+                 :timetag timetag
+                 :elements elements))
+
+(defgeneric format-osc-data (data &optional stream))
+
+(defmethod format-osc-data ((message message) &optional (stream t))
+  (format stream "~a~{ ~a~}~%"
+          (command message)
+          (args message)))
+
+(defmethod format-osc-data ((bundle bundle) &optional (stream t))
+  (format stream "~&[ ~a~%" (timetag bundle))
+  (dolist (element (elements bundle))
+    (format-osc-data element stream))
+  (format stream "~&]~%"))

osc-dispatch.lisp

@@ -47,27 +47,41 @@
 ;;;;  ; ; ;   ;; 
 
 (defun dp-register (tree address function)
-  "registers a function to respond to incoming osc message. since
+  "Registers a function to respond to incoming osc messages. Since
    only one function should be associated with an address, any
-   previous registration will be overwritten"
+   previous registration will be overwritten."
   (setf (gethash address tree)
         function))
 
 (defun dp-remove (tree address)
-  "removes the function associated with the given address.."
+  "Removes the function associated with the given address."
   (remhash address tree))
 
 (defun dp-match (tree pattern)
-  "returns a list of functions which are registered for dispatch for a
-given address pattern.."
+  "Returns a list of functions which are registered for dispatch for a
+given address pattern."
   (list (gethash pattern tree)))
 
-(defun dispatch (tree osc-message &optional device address port
-                                    timetag)
-  "calls the function(s) matching the address(pattern) in the osc 
-   message with the data contained in the message"
-  (let ((pattern (car osc-message)))
+(defgeneric dispatch (tree data device address port &optional timetag
+                                                      parent-bundle))
+
+(defmethod dispatch (tree (data message) device address port &optional
+                                                               timetag
+                                                               parent-bundle)
+  "Calls the function(s) matching the address(pattern) in the osc
+message passing the message object, the recieving device, and
+optionally in the case where a message is part of a bundle, the
+timetag of the bundle and the enclosing bundle."
+  (let ((pattern (command data)))
     (dolist (x (dp-match tree pattern))
       (unless (eq x NIL)
-        (funcall x (car osc-message) (cdr osc-message) device address
-                 port timetag)))))
+        (funcall x (command data) (args data) device address port
+                 timetag parent-bundle)))))
+
+(defmethod dispatch (tree (data bundle) device address port &optional
+                                                              timetag
+                                                              parent-bundle)
+  "Dispatches each bundle element in sequence."
+  (declare (ignore timetag parent-bundle))
+  (dolist (element (elements data))
+    (dispatch tree element device address port (timetag data) data)))

osc.asd

@@ -8,22 +8,24 @@
     :licence "LLGPL"
     :description "The Open Sound Control protocol, aka OSC"
     :version "0.5"
-    :components ((:file "osc" :depends-on ("osc-time"))
-		 (:file "osc-dispatch" :depends-on ("osc"))
-		 (:file "osc-time" :depends-on ("package"))
-		 (:file "package")
-		 (:module "devices"
-			  :depends-on ("package")
-			  ::components
-			  ((:file "socket-functions")
-			   (:file "device")
-			   (:file "transmitter"
-				  :depends-on ("device"
-					       "socket-functions"))
-			   (:file "listening-device"
-				  :depends-on ("transmitter"))
-			   (:file "dispatching-device"
-				  :depends-on ("listening-device"))
-			   (:file "client"
-				  :depends-on ("dispatching-device"))
-			   (:file "server" :depends-on ("client"))))))
+    :components
+    ((:file "osc" :depends-on ("osc-data" "osc-time"))
+     (:file "osc-data" :depends-on ("package"))
+     (:file "osc-dispatch" :depends-on ("osc"))
+     (:file "osc-time" :depends-on ("package"))
+     (:file "package")
+     (:module "devices"
+              :depends-on ("package" "osc-data")
+              ::components
+              ((:file "socket-functions")
+               (:file "device")
+               (:file "transmitter"
+                      :depends-on ("device"
+                                   "socket-functions"))
+               (:file "listening-device"
+                      :depends-on ("transmitter"))
+               (:file "dispatching-device"
+                      :depends-on ("listening-device"))
+               (:file "client"
+                      :depends-on ("dispatching-device"))
+               (:file "server" :depends-on ("client"))))))

osc.lisp

@@ -50,28 +50,41 @@
 ;;
 ;;;; ;;  ;;   ; ; ;;           ;      ;  ;                  ;
 
-(defun encode-bundle (data &optional timetag)
-  "will encode an osc message, or list of messages as a bundle
-   with an optional timetag (symbol or 64bit int).
-   doesnt handle nested bundles"
-  (cat '(35 98 117 110 100 108 101 0)    ; #bundle
-       (if timetag
-           (encode-timetag timetag)
-           (encode-timetag :now))
-       (if (listp (car data))
-           (apply #'cat (mapcar #'encode-bundle-elt data))
-           (encode-bundle-elt data))))
+(defparameter *debug* 0
+  "Set debug verbosity for core library functions. Currently levels
+  are 0-3.")
 
-(defun encode-bundle-elt (data)
-  (let ((message (apply #'encode-message data)))
-    (cat (encode-int32 (length message)) message)))
+(defgeneric encode-osc-data (data))
 
-(defun encode-message (address &rest data)
-  "encodes an osc message with the given address and data."
-  (concatenate '(vector (unsigned-byte 8))
-               (encode-address address)
-               (encode-typetags data)
-               (encode-data data)))
+(defmethod encode-osc-data ((data message))
+  "Encode an osc message with the given address and args."
+  (with-slots (command args) data
+    (concatenate '(vector (unsigned-byte 8))
+                 (encode-address command)
+                 (encode-typetags args)
+                 (encode-args args))))
+
+(defmethod encode-osc-data ((data bundle))
+  "Encode an osc bundle. A bundle contains a timetag (symbol or 64bit
+  int) and a list of message or nested bundle elements."
+  (with-slots (timetag elements) data
+    (cat '(35 98 117 110 100 108 101 0)    ; #bundle
+         (if timetag
+             (encode-timetag timetag)
+             (encode-timetag :now))
+         (apply #'cat (mapcar #'encode-bundle-elt elements)))))
+
+(defgeneric encode-bundle-elt (data))
+
+(defmethod encode-bundle-elt ((data message))
+  (let ((bytes (encode-osc-data data)))
+    (cat (encode-int32 (length bytes)) bytes)))
+
+(defmethod encode-bundle-elt ((data bundle))
+  (let ((bytes (encode-osc-data data)))
+    (cat (encode-int32 (length bytes)) bytes)))
+
+;; Auxilary functions
 
 (defun encode-address (address)
   (cat (map 'vector #'char-code address)
@@ -106,12 +119,12 @@
     (cat lump
          (pad (padding-length (length lump))))))
 
-(defun encode-data (data)
-  "encodes data in a format suitable for an OSC message"
+(defun encode-args (args)
+  "encodes args in a format suitable for an OSC message"
   (let ((lump (make-array 0 :adjustable t :fill-pointer t)))
     (macrolet ((enc (f)
                  `(setf lump (cat lump (,f x)))))
-      (dolist (x data)
+      (dolist (x args)
         (typecase x
           (integer (enc encode-int32))
           (float (enc encode-float32))
@@ -126,33 +139,84 @@
 ;;
 ;;; ;;    ;;     ; ;     ;      ;      ; ;
 
-(defun decode-bundle (data &optional bundle-length)
-  "Decodes an osc bundle into a list of decoded-messages, which has an
-osc-timetag as its first element. An optional buffer-length argument
-can be supplied (i.e. the length value returned by socket-receive),
-otherwise the entire buffer is decoded - in which case, if you are
-reusing buffers, you are responsible for ensuring that the buffer does
-not contain stale data."
-  (unless bundle-length
-    (setf bundle-length (length data)))
-  ;; (print (subseq data 0 bundle-length))
-  (let ((contents '()))
-    (if (equalp 35 (elt data 0))           ; a bundle begins with
-                                           ; '#bundle' (8 bytes)
-        (let ((timetag (subseq data 8 16)) ; bytes 8-15 are timestamp
-              (i 16))
-          (loop while (< i bundle-length)
-             do (let ((mark (+ i 4))
-                      (size (decode-int32
-                             (subseq data i (+ i 4)))))
-                  (if (eq size 0)
-                      (setf bundle-length 0)
-                      (push (decode-bundle
-                             (subseq data mark (+ mark size)))
-                            contents))
-                  (incf i (+ 4 size))))
-          (values (car contents) (decode-timetag timetag)))
-        (values (decode-message data) nil))))
+(defun bundle-p (buffer &optional (start 0))
+  "A bundle begins with '#bundle' (8 bytes). The start argument should
+index the beginning of a bundle in the buffer."
+  (= 35 (elt buffer start)))
+
+(defun get-timetag (buffer &optional (start 0))
+  "Bytes 8-15 are the bundle timestamp. The start argument should
+index the beginning of a bundle in the buffer."
+  (decode-timetag (subseq buffer
+                          (+ 8 start)
+                          (+ 16 start))))
+
+(defun get-bundle-element-length (buffer &optional (start 16))
+  "Bytes 16-19 are the size of the bundle element. The start argument
+should index the beginning of the bundle element (length, content)
+pair in the buffer."
+  (decode-int32 (subseq buffer start (+ 4 start))))
+
+(defun get-bundle-element (buffer &optional (start 16))
+  "Bytes 20 upto to the length of the content (defined by the
+preceeding 4 bytes) are the content of the bundle. The start argument
+should index the beginning of the bundle element (length, content)
+pair in the buffer."
+  (let ((length (get-bundle-element-length buffer start)))
+    (subseq buffer
+            (+ 4 start)
+            (+ (+ 4 start)
+               (+ length)))))
+
+(defun split-sequence-by-n (sequence n)
+  (loop :with length := (length sequence)
+     :for start :from 0 :by n :below length
+     :collecting (coerce
+                  (subseq sequence start (min length (+ start n)))
+                  'list)))
+
+(defun print-buffer (buffer &optional (n 8))
+  (format t "~%~{~{ ~5d~}~%~}Total: ~a bytes~2%"
+          (split-sequence-by-n buffer n)
+          (length buffer)))
+
+(defun decode-bundle (buffer &key (start 0) end)
+  "Decodes an osc bundle/message into a bundle/message object. Bundles
+  comprise an osc-timetag and a list of elements, which may be
+  messages or bundles recursively. An optional end argument can be
+  supplied (i.e. the length value returned by socket-receive, or the
+  element length in the case of nested bundles), otherwise the entire
+  buffer is decoded - in which case, if you are reusing buffers, you
+  are responsible for ensuring that the buffer does not contain stale
+  data."
+  (unless end
+    (setf end (- (length buffer) start)))
+  (when (>= *debug* 2)
+    (format t "~%Buffer start: ~a end: ~a~%" start end)
+    (print-buffer (subseq buffer start end)))
+  (if (bundle-p buffer start)
+      ;; Bundle
+      (let ((timetag (get-timetag buffer start)))
+        (incf start (+ 8 8))            ; #bundle, timetag bytes
+        (loop while (< start end)
+           for element-length = (get-bundle-element-length
+                                 buffer start)
+           do (incf start 4)            ; length bytes
+           when (>= *debug* 1)
+           do (format t "~&Bundle element length: ~a~%" element-length)
+           collect (decode-bundle buffer
+                                  :start start
+                                  :end (+ start element-length))
+           into elements
+           do (incf start (+ element-length))
+           finally (return
+                     (values (apply #'make-bundle timetag elements)
+                             timetag))))
+      ;; Message
+      (let ((message
+             (decode-message
+              (subseq buffer start (+ start end)))))
+        (apply #'make-message (car message) (cdr message)))))
 
 (defun decode-message (message)
   "reduces an osc message to an (address . data) pair. .."