implement sending and receiving of nested bundles
This commit is contained in:
Jamie Forth
parent
00c9020045
commit
f5a9fd8069
10 changed files with 414 additions and 228 deletions
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 "~%"))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
49
osc-data.lisp
Normal file
49
osc-data.lisp
Normal file
|
|
@ -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 "~&]~%"))
|
||||
|
|
@ -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)))
|
||||
|
|
|
|||
40
osc.asd
40
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"))))))
|
||||
|
|
|
|||
164
osc.lisp
164
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. .."
|
||||
|
|
|
|||
Loading…
Reference in a new issue