add convenience functions for constructing message and bundle objects

This commit is contained in:
Jamie Forth 2015-08-21 18:22:49 +01:00
parent 9fde4ea5ce
commit fb81d63d1e
6 changed files with 110 additions and 92 deletions

View file

@ -41,18 +41,18 @@
;; bundle objects directly. This allows more complex (nested) bundles
;; to be created.
(send *osc-transmitter* (make-message "/foo" 1 2 3))
(send *osc-transmitter* (message "/foo" 1 2 3))
(send *osc-transmitter* (make-bundle :now
(make-message "/foo" 1 2 3)))
(send *osc-transmitter* (bundle :now
(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)))))))
(bundle :now
(message "/foo" '(1 2 3))
(bundle :now
(bundle :now
(message "/bar"
'(10 20 30)))))))
(send *osc-transmitter* bundle))
(quit *osc-transmitter*)

View file

@ -170,15 +170,15 @@
(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)))
(let ((message (make-message command args)))
(send-to-client server client-name message))))
(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))))
(let ((bundle (bundle timetag
(make-message command args))))
(send-to-client server client-name bundle))))
;; Send all
@ -206,19 +206,19 @@
(defgeneric send-msg-all (server command &rest args)
(:method ((server osc-server) command &rest args)
(let ((message (apply #'make-message command args)))
(let ((message (make-message command args)))
(send-all server message)))
(:method ((client-endpoint osc-client-endpoint) command &rest args)
(let ((message (apply #'make-message command args)))
(let ((message (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))))
(let ((bundle (bundle timetag
(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))))
(let ((bundle (bundle timetag
(make-message command args))))
(send-all client-endpoint bundle))))

View file

@ -67,13 +67,13 @@
(defgeneric send-msg (transmitter command &rest args)
(:method ((transmitter osc-transmitter) command &rest args)
(let ((message (apply #'make-message command args)))
(let ((message (make-message command args)))
(send transmitter message))))
(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))))
(let ((bundle (bundle timetag
(make-message command args))))
(send transmitter bundle))))
;; Unconnected sending (UDP only)
@ -87,13 +87,13 @@
(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)))
(let ((message (make-message command args)))
(send-to transmitter address port message))))
(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))))
(let ((bundle (bundle timetag
(make-message command args))))
(send-to transmitter address port bundle))))

View file

@ -25,16 +25,26 @@
;; Constructors
(defun make-message (command &rest args)
(defun make-message (command args)
(unless (listp args)
(setf args (list args)))
(make-instance 'message
:command command
:args args))
(defun make-bundle (timetag &rest elements)
(defun message (command &rest args)
(make-message command args))
(defun make-bundle (timetag elements)
(unless (listp elements)
(setf elements (list elements)))
(make-instance 'bundle
:timetag timetag
:elements elements))
(defun bundle (timetag &rest elements)
(make-bundle timetag elements))
(defgeneric format-osc-data (data &key stream width))
(defmethod format-osc-data ((message message) &key (stream t)
@ -45,8 +55,7 @@
(concatenate 'string
(subseq args-string 0 width)
"...")))
(format stream "~a~a ~a~%"
#\Tab
(format stream "~a ~a~%"
(command message)
args-string)))

View file

@ -210,13 +210,13 @@ pair in the buffer."
into elements
do (incf start (+ element-length))
finally (return
(values (apply #'make-bundle timetag elements)
(values (make-bundle timetag elements)
timetag))))
;; Message
(let ((message
(decode-message
(subseq buffer start (+ start end)))))
(apply #'make-message (car message) (cdr message)))))
(make-message (car message) (cdr message)))))
(defun decode-message (message)
"reduces an osc message to an (address . data) pair. .."

View file

@ -1,67 +1,76 @@
(defpackage :osc
(:use :cl :sb-bsd-sockets)
(:documentation "OSC aka the 'open sound control' protocol")
(:export #:encode-message
#:encode-bundle
#:decode-message
#:decode-bundle
#:make-osc-tree
#:dp-register
#:dp-remove
#:dp-match
#:dispatch
(:export
#:make-message
#:message
#:make-bundle
#:bundle
#:command
#:args
#:timetag
#:elements
#:encode-message
#:encode-bundle
#:decode-message
#:decode-bundle
#:make-osc-tree
#:dp-register
#:dp-remove
#:dp-match
#:dispatch
#:get-current-timetag ; osc-time
#:timetag+
#:get-unix-time
#:unix-time->timetag
#:timetag->unix-time
#:print-as-double
#:get-current-timetag ; osc-time
#:timetag+
#:get-unix-time
#:unix-time->timetag
#:timetag->unix-time
#:print-as-double
#:osc-transmitter ; osc-devices
#:osc-transmitter-udp
#:osc-client
#:osc-client-udp
#:osc-client-tcp
#:osc-server
#:osc-server-udp
#:osc-server-tcp
#:protocol
#:name
#:buffer-size
#:quit
#:osc-device-cleanup
#:make-listening-thread ; listening
#:add-osc-responder ; dispatching
#:remove-osc-responder
#:make-osc-transmitter ; transmitters
#:connect
#:send
#:send-bundle
#:send-to
#:send-bundle-to
#:send-all
#:send-bundle-all
#:make-osc-client ; clients
#:make-client-responders
#:register
#:make-osc-server ; servers
#:boot
#:make-server-responders
#:register-udp-client
#:unregister-udp-client
#:register-tcp-client
#:unregister-tcp-client
#:post-register-hook
#:get-tcp-client
#:print-clients
#:send-to-client
#:send-bundle-to-client
#:*default-osc-buffer-size* ; sockets
#:make-name-string
#:device-active-p
#:device-socket-name
#:address
#:port
#:peer-address
#:peer-port))
#:osc-transmitter ; osc-devices
#:osc-transmitter-udp
#:osc-client
#:osc-client-udp
#:osc-client-tcp
#:osc-server
#:osc-server-udp
#:osc-server-tcp
#:protocol
#:name
#:buffer-size
#:quit
#:osc-device-cleanup
#:make-listening-thread ; listening
#:add-osc-responder ; dispatching
#:remove-osc-responder
#:make-osc-transmitter ; transmitters
#:connect
#:send
#:send-bundle
#:send-to
#:send-bundle-to
#:send-all
#:send-bundle-all
#:make-osc-client ; clients
#:make-client-responders
#:register
#:make-osc-server ; servers
#:boot
#:make-server-responders
#:register-udp-client
#:unregister-udp-client
#:register-tcp-client
#:unregister-tcp-client
#:post-register-hook
#:get-tcp-client
#:print-clients
#:send-to-client
#:send-bundle-to-client
#:*default-osc-buffer-size* ; sockets
#:make-name-string
#:device-active-p
#:device-socket-name
#:address
#:port
#:peer-address
#:peer-port))