podoscaph
#bundle support added to the feet. small step towards watertightness darcs-hash:20050314140505-2648a-268ae71e964c269e196c590d867970411d786804.gz
This commit is contained in:
parent
c7a22c9e4a
commit
f8cc808c44
4 changed files with 209 additions and 102 deletions
62
README.txt
62
README.txt
|
|
@ -1,12 +1,60 @@
|
|||
|
||||
what ->
|
||||
This is a common-lisp implementation of the Open Sound Control Protocol, aka OSC. It should be close to ansi standard, and does not rely on any external code/ffi/etc+ to do the basic encoding and decoding of packets. since OSC does not specify a transport layer, messages can be send using TCP or UDP, however it seems UDP is more common amongst the programms that communicate using the protocol.
|
||||
|
||||
else ->
|
||||
- specific info about what is/isnt working can be found in the header of osc.lisp
|
||||
- more details about OSC can be found at
|
||||
http://www.cnmat.berkeley.edu/OpenSoundControl/
|
||||
- current versions of this code can be found at http://fo.am/darcs/osc
|
||||
This is a common-lisp implementation of the Open Sound Control
|
||||
Protocol, aka OSC. The code should be close to ansi standard, and does
|
||||
not rely on any external code/ffi/etc+ to do the basic encoding and
|
||||
decoding of packets. since OSC does not specify a transport layer,
|
||||
messages can be send using TCP or UDP (or carrier pigeons), however it
|
||||
seems UDP is more common amongst the programmes that communicate using
|
||||
the OSC protocol. the osc-examples.lisp file contains a few simple
|
||||
examples of how to send and recieve OSC via UDP, and so far seems
|
||||
reasonably compatible with the packets send from/to max-msp, pd,
|
||||
supercollider and liblo. . .
|
||||
|
||||
more details about OSC can be found at . .,
|
||||
http://www.cnmat.berkeley.edu/OpenSoundControl/
|
||||
|
||||
the current version of this code is avilable using darcs
|
||||
darcs get http://fo.am/darcs/osc
|
||||
|
||||
|
||||
limitations
|
||||
- doesnt send nested bundles or timetags later than 'now'
|
||||
- will most likely crash if the input is malformed
|
||||
- doesnt do any pattern matching on addresses
|
||||
- sbcl/cmucl specific float en/decoding
|
||||
- only supports the type(tag)s specified in the OSC spec
|
||||
|
||||
things to do
|
||||
- address patterns
|
||||
- liblo like network wrapping
|
||||
- data checking and error handling
|
||||
- portable en/decoding of floats -=> ieee754 tests
|
||||
- doubles and other defacto typetags
|
||||
- correct en/decoding of timetags
|
||||
- asdf-installable
|
||||
|
||||
|
||||
changes
|
||||
|
||||
2005-03-11
|
||||
- bundle and blob en/de- coding
|
||||
2005-03-05
|
||||
- 'declare' scattering and other optimisations
|
||||
2005-02-08
|
||||
- in-package'd
|
||||
- basic dispatcher
|
||||
2005-03-01
|
||||
- fixed address string bug
|
||||
2005-01-26
|
||||
- fixed string handling bug
|
||||
2005-01-24
|
||||
- sends and receives multiple arguments
|
||||
- tests in osc-tests.lisp
|
||||
2004-12-18
|
||||
- initial version, single args only
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@
|
|||
|
||||
(in-package :osc)
|
||||
|
||||
;; should probably be a clos object, and instantiated
|
||||
;; should probably be a clos object or an alist.
|
||||
;; for now, a hash table is enuf.
|
||||
|
||||
(defun make-osc-tree ()
|
||||
|
|
|
|||
|
|
@ -29,19 +29,19 @@
|
|||
|
||||
(require :sb-bsd-sockets)
|
||||
(use-package :osc)
|
||||
(use-package :sb-bsd-sockets)
|
||||
|
||||
|
||||
(defun osc-listen (port)
|
||||
"a basic test function which attempts to decode osc stuff a
|
||||
given port. default ogreOSC port is 4178"
|
||||
|
||||
"a basic test function which attempts to decode an osc message a given port."
|
||||
(let ((s (make-udp-socket))
|
||||
(buffer (make-sequence '(vector (unsigned-byte 8)) 1024)))
|
||||
(socket-bind s #(0 0 0 0) port)
|
||||
(format t "listening on localhost port ~A~%~%" port)
|
||||
(unwind-protect
|
||||
(loop do
|
||||
(socket-receive s buffer nil :waitall t)
|
||||
(format t "receiveded -=> ~S~%" (osc:decode-message buffer)))
|
||||
(socket-receive s buffer nil)
|
||||
(format t "receiveded -=> ~S~%" (osc:decode-bundle buffer)))
|
||||
(when s (socket-close s)))))
|
||||
|
||||
|
||||
|
|
@ -59,10 +59,10 @@
|
|||
:element-type '(unsigned-byte 8) :buffering :full)))
|
||||
(unwind-protect
|
||||
(loop do
|
||||
(socket-receive in buffer nil :waitall t)
|
||||
(let ((oscuff (osc:decode-message buffer)))
|
||||
(socket-receive in buffer nil)
|
||||
(let ((oscuff (osc:decode-bundle buffer)))
|
||||
(format t "glonked -=> message with ~S~% arg(s)" (length oscuff))
|
||||
(stream-t1 oscuff stream)))
|
||||
(write-stream-t1 oscuff stream)))
|
||||
(when in (socket-close in))
|
||||
(when out (socket-close out))))))
|
||||
|
||||
|
|
@ -70,7 +70,7 @@
|
|||
(defun make-udp-socket()
|
||||
(make-instance 'inet-socket :type :datagram :protocol :udp))
|
||||
|
||||
(defun stream-t1 (osc-message stream)
|
||||
(defun write-stream-t1 (osc-message stream)
|
||||
"writes a given message to a stream. keep in mind that when using a buffered
|
||||
stream any funtion writing to the stream should call (finish-output stream)
|
||||
after it sends the mesages,. ."
|
||||
|
|
|
|||
217
osc.lisp
217
osc.lisp
|
|
@ -27,48 +27,27 @@
|
|||
;; of the protocol can be found at the open sound control pages -=>
|
||||
;; http://www.cnmat.berkeley.edu/OpenSoundControl/
|
||||
;;
|
||||
;; - currently doesnt send timetags, but does send typetags
|
||||
;; - will most likely crash if the input is malformed
|
||||
;; - int32 en/de-coding based on code (c) Walter C. Pelissero
|
||||
|
||||
;; to do
|
||||
;; - doesnt send nested bundles or timetags later than 'now'
|
||||
;; - will most likely crash if the input is malformed
|
||||
;; - int32 en/de-coding based on code (c) Walter C. Pelissero
|
||||
;;
|
||||
;; see the README file for more details...
|
||||
;;
|
||||
;; - liblo like network wrapping
|
||||
;; - error handling
|
||||
;; - receiver -> osc-responder.lisp
|
||||
;; - osc-tree as name.value alist for responder/serve-event
|
||||
;; - portable en/decoding of floats -=> ieee754 tests
|
||||
;; - bundles, blobs, doubles and other typetags
|
||||
;; - asdf-installable
|
||||
|
||||
;; known BUGS
|
||||
;; - only unknown for now.. .
|
||||
|
||||
;; changes
|
||||
;;
|
||||
;; 2004-12-18
|
||||
;; - initial version, single args only
|
||||
;; 2005-01-24
|
||||
;; - sends and receives multiple arguments
|
||||
;; - tests in osc-test.lisp
|
||||
;; 2005-01-26
|
||||
;; - fixed string handling bug
|
||||
;; 2005-02-08
|
||||
;; - in-package'd
|
||||
;; 2005-03-01
|
||||
;; - fixed address string bug
|
||||
;; 2005-0305
|
||||
;; - 'declare' scattering and other optimisations
|
||||
|
||||
(defpackage :osc
|
||||
(:use :cl)
|
||||
(:documentation "OSC aka the 'open sound control' protocol")
|
||||
(:export :encode-message
|
||||
:decode-message))
|
||||
:encode-bundle
|
||||
:decode-message
|
||||
:decode-bundle))
|
||||
|
||||
(in-package :osc)
|
||||
|
||||
(declaim (optimize (speed 3) (safety 1)))
|
||||
;(declaim (optimize (speed 3) (safety 1)))
|
||||
|
||||
;;;;;; ; ;; ; ; ; ; ; ; ;
|
||||
;;
|
||||
|
|
@ -76,6 +55,20 @@
|
|||
;;
|
||||
;;; ;; ;; ; ; ;; ; ; ; ;
|
||||
|
||||
|
||||
(defun encode-bundle (data)
|
||||
"will encode an osc message, or list of messages as a bundle
|
||||
with an optional timetag. doesnt handle nested bundles"
|
||||
(cat '(35 98 117 110 100 108 101 0) ; #bundle
|
||||
(encode-timetag :now)
|
||||
(if (listp (car data))
|
||||
(apply #'cat (mapcar #'encode-bundle-elt data))
|
||||
(encode-bundle-elt data))))
|
||||
|
||||
(defun encode-bundle-elt (data)
|
||||
(let ((message (apply #'encode-message data)))
|
||||
(cat (encode-int32 (length message)) message)))
|
||||
|
||||
(defun encode-message (address &rest data)
|
||||
"encodes an osc message with the given address and data."
|
||||
(concatenate '(vector (unsigned-byte 8))
|
||||
|
|
@ -85,7 +78,7 @@
|
|||
|
||||
(defun encode-address (address)
|
||||
(cat (map 'vector #'char-code address)
|
||||
(pad-string address)))
|
||||
(string-padding address)))
|
||||
|
||||
(defun encode-typetags (data)
|
||||
"creates a typetag string suitable for the given data.
|
||||
|
|
@ -93,10 +86,11 @@
|
|||
non-std extensions include ,{h|t|d|S|c|r|m|T|F|N|I|[|]}
|
||||
see the spec for more details. ..
|
||||
|
||||
NOTE: currently handles the following tags only
|
||||
NOTE: currently handles the following tags
|
||||
i => #(105) => int32
|
||||
f => #(102) => float
|
||||
s => #(115) => string"
|
||||
s => #(115) => string
|
||||
b => #(98) => blob"
|
||||
|
||||
(let ((lump (make-array 0 :adjustable t
|
||||
:fill-pointer t
|
||||
|
|
@ -110,6 +104,7 @@
|
|||
(integer (write-to-vector #\i))
|
||||
(float (write-to-vector #\f))
|
||||
(simple-string (write-to-vector #\s))
|
||||
(simple-vector (write-to-vector #\b))
|
||||
(t (error "can only encode ints, floats or strings"))))
|
||||
(cat lump
|
||||
(pad (padding-length (length lump)))))))
|
||||
|
|
@ -124,16 +119,40 @@
|
|||
(integer (enc encode-int32))
|
||||
(float (enc encode-float32))
|
||||
(simple-string (enc encode-string))
|
||||
(simple-vector (enc encode-blob))
|
||||
(t (error "wrong type. turn back"))))
|
||||
lump)))
|
||||
|
||||
|
||||
|
||||
;;;;;; ; ;; ; ; ; ; ; ; ;
|
||||
;;
|
||||
;; decoding OSC messages
|
||||
;;
|
||||
;;; ;; ;; ; ; ; ; ; ;
|
||||
|
||||
|
||||
(defun decode-bundle (data)
|
||||
"decodes an osc bundle into a list of decoded-messages, which has
|
||||
an osc-timetagas its first element"
|
||||
(let ((contents '()))
|
||||
(if (equalp 35 (elt data 0)) ; a bundle begins with '#'
|
||||
(let ((timetag (subseq data 8 16))
|
||||
(i 16)
|
||||
(bundle-length (length data)))
|
||||
(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))))
|
||||
(push timetag contents))
|
||||
(decode-message data))))
|
||||
|
||||
(defun decode-message (message)
|
||||
"reduces an osc message to an (address . data) pair. .."
|
||||
(declare (type (vector *) message))
|
||||
|
|
@ -150,39 +169,73 @@
|
|||
|
||||
(defun decode-taged-data (data)
|
||||
"decodes data encoded with typetags...
|
||||
NOTE: currently handles the following tags only
|
||||
NOTE: currently handles the following tags
|
||||
i => #(105) => int32
|
||||
f => #(102) => float
|
||||
s => #(115) => string"
|
||||
s => #(115) => string
|
||||
b => #(98) => blob"
|
||||
|
||||
(setf div (position 0 data))
|
||||
(let ((tags (subseq data 1 div))
|
||||
(chunks (subseq data (osc-string-length (subseq data 0 div))))
|
||||
(acc '())
|
||||
(result '()))
|
||||
(setf acc chunks)
|
||||
(map 'vector
|
||||
#'(lambda (x)
|
||||
(cond
|
||||
((eq x (char-code #\i))
|
||||
(push (decode-int32 (subseq acc 0 4))
|
||||
result)
|
||||
(setf acc (subseq acc 4)))
|
||||
((eq x (char-code #\f))
|
||||
(push (decode-float32 (subseq acc 0 4))
|
||||
result)
|
||||
(setf acc (subseq acc 4)))
|
||||
((eq x (char-code #\s))
|
||||
(let ((pointer (+ (padding-length (position 0 acc))
|
||||
(position 0 acc))))
|
||||
(push (decode-string
|
||||
(subseq acc 0 pointer))
|
||||
result)
|
||||
(setf acc (subseq acc pointer))))
|
||||
((eq x (char-code #\b)) (decode-blob x))
|
||||
(t (error "unrecognised typetag"))))
|
||||
tags)
|
||||
(nreverse result)))
|
||||
(let ((div (position 0 data)))
|
||||
(let ((tags (subseq data 1 div))
|
||||
(acc (subseq data (padded-length div)))
|
||||
(result '()))
|
||||
(map 'vector
|
||||
#'(lambda (x)
|
||||
(cond
|
||||
((eq x (char-code #\i))
|
||||
(push (decode-int32 (subseq acc 0 4))
|
||||
result)
|
||||
(setf acc (subseq acc 4)))
|
||||
((eq x (char-code #\f))
|
||||
(push (decode-float32 (subseq acc 0 4))
|
||||
result)
|
||||
(setf acc (subseq acc 4)))
|
||||
((eq x (char-code #\s))
|
||||
(let ((pointer (padded-length (position 0 acc))))
|
||||
(push (decode-string
|
||||
(subseq acc 0 pointer))
|
||||
result)
|
||||
(setf acc (subseq acc pointer))))
|
||||
((eq x (char-code #\b))
|
||||
(let ((size (decode-int32 (subseq acc 0 4))))
|
||||
(let ((end (padded-length (+ 4 size))))
|
||||
(push (decode-blob (subseq acc 0 end))
|
||||
result)
|
||||
(setf acc (subseq acc end)))))
|
||||
(t (error "unrecognised typetag"))))
|
||||
tags)
|
||||
(nreverse result))))
|
||||
|
||||
|
||||
;;; ; ;; ;
|
||||
;;
|
||||
;; timetags
|
||||
;;
|
||||
;; - not yet, but probably something using
|
||||
;; (get-universal-time) > see also: CLHS 25.1.4 Time
|
||||
;; or connecting to an ntp server.,. - ntpdate, ntpq
|
||||
;;
|
||||
;; - begin with bundles using 'now' as the timetag
|
||||
;; - this should really handle 64bit fixed ints,
|
||||
;; not signed 32bit ints
|
||||
;;
|
||||
;;;; ;; ; ;
|
||||
|
||||
(defconstant +unix-epoch+ (encode-universal-time 0 0 0 1 1 1970 0))
|
||||
|
||||
(defun encode-timetag (ut &optional subseconds)
|
||||
"encodes an osc timetag from a universal-time and 32bit 'sub-second' part
|
||||
for an 'instantaneous' timetag use (encode-timetag :now) "
|
||||
(if (equalp ut :now)
|
||||
#(0 0 0 0 0 0 0 1)
|
||||
(cat (encode-int32 (+ ut +unix-epoch+))
|
||||
(encode-int32 (subseconds)))))
|
||||
|
||||
(defun decode-timetag (timetag)
|
||||
"decomposes a timetag into ut and a subsecond,. . ."
|
||||
(list
|
||||
(decode-int32 (subseq timetag 0 4))
|
||||
(decode-int32 (subseq timetag 4 8))))
|
||||
|
||||
|
||||
;;;;; ; ; ;; ;; ; ;
|
||||
|
|
@ -204,7 +257,6 @@
|
|||
#-(or sbcl cmucl) (error "cant decode floats using this implementation"))
|
||||
|
||||
(defun decode-int32 (s)
|
||||
(declare (type (vector (unsigned-byte 8) s)))
|
||||
"4 byte > 32 bit int > two's compliment (in network byte order)"
|
||||
(let ((i (+ (ash (elt s 0) 24)
|
||||
(ash (elt s 1) 16)
|
||||
|
|
@ -228,7 +280,7 @@
|
|||
(set-byte 3))
|
||||
buf))
|
||||
|
||||
|
||||
;; osc-strings are unsigned bytes, padded to a 4 byte boundary
|
||||
|
||||
(defun decode-string (data)
|
||||
"converts a binary vector to a string and removes trailing #\nul characters"
|
||||
|
|
@ -237,33 +289,40 @@
|
|||
(defun encode-string (string)
|
||||
"encodes a string as a vector of character-codes, padded to 4 byte boundary"
|
||||
(cat (map 'vector #'char-code string)
|
||||
(pad-string string)))
|
||||
(string-padding string)))
|
||||
|
||||
(defun decode-blob (b)
|
||||
(error "cant decode blobs for now. .."))
|
||||
;; blobs are binary data, consisting of a length (int32) and bytes which are
|
||||
;; osc-padded to a 4 byte boundary.
|
||||
|
||||
(defun encode-blob (b)
|
||||
(error "cant encode blobs for now. .."))
|
||||
(defun decode-blob (blob)
|
||||
"decode a blob as a vector of unsigned bytes."
|
||||
(let ((size (decode-int32
|
||||
(subseq blob 0 4))))
|
||||
(subseq blob 4 (+ 4 size))))
|
||||
|
||||
(defun encode-blob (blob)
|
||||
"encodes a blob from a given vector"
|
||||
(let ((bl (length blob)))
|
||||
(cat (encode-int32 bl) blob
|
||||
(pad (padding-length bl)))))
|
||||
|
||||
|
||||
;; utility functions for OSC slonking
|
||||
;; utility functions for osc-string/padding slonking
|
||||
|
||||
(defun cat (&rest catatac)
|
||||
(apply #'concatenate '(vector *) catatac))
|
||||
|
||||
(defun osc-string-length (string)
|
||||
"determines the length required for a padded osc string"
|
||||
(declare (type simple-string string))
|
||||
(let ((n (length string)))
|
||||
(declare (type fixnum n))
|
||||
(+ n (padding-length n))))
|
||||
|
||||
(defun padding-length (s)
|
||||
"returns the length of padding required for a given length of string"
|
||||
(declare (type fixnum s))
|
||||
(- 4 (mod s 4)))
|
||||
|
||||
(defun pad-string (string)
|
||||
(defun padded-length (s)
|
||||
"returns the length of an osc-string made from a given length of string"
|
||||
(declare (type fixnum s))
|
||||
(+ s (- 4 (mod s 4))))
|
||||
|
||||
(defun string-padding (string)
|
||||
"returns the padding required for a given osc string"
|
||||
(declare (type simple-string string))
|
||||
(pad (- 4 (mod (length string) 4))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue