synchroscope (part 2)
This commit is contained in:
parent
153f07c8fa
commit
15215d5bab
GPG key ID:
989F5E6EDB478160
77
README.md
77
README.md
|
|
@ -1,77 +0,0 @@
|
|||
# Open Sound Control
|
||||
|
||||
This is a common lisp implementation of the Open Sound Control Protocol aka OSC. The code should be close to the 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 from github
|
||||
|
||||
git clone https://github.com/zzkt/osc
|
||||
|
||||
or via quicklisp.. .
|
||||
|
||||
(ql:quickload "osc")
|
||||
|
||||
## limitations
|
||||
|
||||
- doesn't send nested bundles or syncronisable timetags
|
||||
- will raise an exception if the input is malformed
|
||||
- doesn't do any pattern matching on addresses
|
||||
- float en/decoding only tested on sbcl, cmucl, openmcl and allegro
|
||||
- only supports the type(tag)s specified in the OSC spec
|
||||
|
||||
## things to do in :osc
|
||||
|
||||
- address patterns using pcre
|
||||
- data checking and error handling
|
||||
- portable en/decoding of floats -=> ieee754 tests
|
||||
- doubles and other defacto typetags
|
||||
- correct en/decoding of timetags
|
||||
|
||||
## things to do in :osc-ex[tensions|tras]
|
||||
|
||||
- liblo like network wrapping
|
||||
- add namespace exploration using cl-zeroconf
|
||||
|
||||
# changes
|
||||
- 2019-04-02
|
||||
- encoder/decoder refactoring from Javier Olaechea @PuercoPop
|
||||
- 2017-12-10
|
||||
- osc-examples use usocket for portability from @boqs
|
||||
- 2015-08-25
|
||||
- support for 64bit ints from Erik Ronström https://github.com/erikronstrom
|
||||
- 2011-04-19
|
||||
- converted repo from darcs->git
|
||||
- 2007-02-20
|
||||
- version 0.5
|
||||
- Allegro CL float en/decoding from vincent akkermans <vincent.akkermans@gmail.com>
|
||||
- 2006-02-11
|
||||
- version 0.4
|
||||
- partial timetag implemetation
|
||||
- 2005-12-05
|
||||
- version 0.3
|
||||
- fixed openmcl float bug (decode-uint32)
|
||||
- 2005-11-29
|
||||
- version 0.2
|
||||
- openmcl float en/decoding
|
||||
- 2005-08-12
|
||||
- corrections from Matthew Kennedy <mkennedy@gentoo.org>
|
||||
- 2005-08-11
|
||||
- version 0.1
|
||||
- 2005-03-16
|
||||
- packaged as an asdf installable lump
|
||||
- 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
|
||||
|
||||
89
README.org
Normal file
89
README.org
Normal file
|
|
@ -0,0 +1,89 @@
|
|||
# -*- mode: org; coding: utf-8; -*-
|
||||
#+title: Open Sound Control
|
||||
|
||||
This is a lisp implementation of the Open Sound Control protocol (or more accurately “data transport specification” or “encoding”). The code should be close to ANSI standard common lisp and provides self contained code for encoding and decoding of OSC data, messages, and bundles. Since OSC describes a transport independent encoding (and does not specify a transport layer) messages can be send using TCP, UDP or other network protocols (e.g. [[https://www.rfc-editor.org/rfc/rfc2549][RFC 2549]]). It seems UDP is more common amongst programmes that communicate using OSC and. the =osc-examples.lisp= file contains a few simple examples of how to send and receive OSC via UDP. The examples are reasonably compatible with the packets send from/to max-msp, pd, supercollider and liblo. more details about OSC can be found at https://OpenSoundControl.org
|
||||
|
||||
The current version of this code is available from github
|
||||
|
||||
#+BEGIN_SRC shell
|
||||
git clone https://github.com/zzkt/osc
|
||||
#+END_SRC
|
||||
|
||||
or via quicklisp.. .
|
||||
|
||||
#+BEGIN_SRC lisp
|
||||
(ql:quickload "osc")
|
||||
#+END_SRC
|
||||
|
||||
** OSC 1.0 and 1.1 support
|
||||
|
||||
This implementation supports the [[https://opensoundcontrol.stanford.edu/spec-1_0.html][OpenSoundControl Specification 1.0]] and the required typetags listed in the [[https://opensoundcontrol.stanford.edu/spec-1_1.html][OpenSoundControl Specification 1.1]] (as described in an [[https://opensoundcontrol.stanford.edu/files/2009-NIME-OSC-1.1.pdf][NIME 2009 paper]] ). Some optional types are supported.
|
||||
|
||||
| *Type tag* | *type* | *description* | *v1.0* | *v1.1* | *cl-osc* |
|
||||
| i | int32 | 32-bit big-endian two’s complement integer | *R* | *R* | YES |
|
||||
| f | float32 | 32-bit big-endian IEEE 754 floating point number | *R* | *R* | YES |
|
||||
| s | OSC-string | A sequence of non-null ASCII characters followed by a null, | | *R* | |
|
||||
| | | followed by 0-3 additional null characters. Total bits is a multiple of 32. | *R* | N | YES |
|
||||
| b | OSC-blob | An int32 size count, followed by that many 8-bit bytes of arbitrary binary data, | | *R* | |
|
||||
| | | followed by 0-3 additional zero bytes. Total bits is a multiple of 32. | *R* | N | YES |
|
||||
| T | True | No bytes are allocated in the argument data. | O | *R* | |
|
||||
| F | False | No bytes are allocated in the argument data. | O | *R* | |
|
||||
| N | Null | (aka nil, None, etc). No bytes are allocated in the argument data. | O | *R* | |
|
||||
| I | Impulse | (aka “bang”), used for event triggers. No bytes are allocated in the argument data. | O | *R* | |
|
||||
| t | OSC-timetag | an OSC timetag in NTP format, encoded in the data section | O | *R* | |
|
||||
| h | int64 | 64 bit big-endian two’s complement integer | O | O | YES |
|
||||
| d | float64 | 64 bit (“double”) IEEE 754 floating point number | O | O | |
|
||||
| S | OSC-string | Alternate type represented as an OSC-string (e.g to differentiate “symbols” from “strings”) | O | O | YES |
|
||||
| c | | an ascii character, sent as 32 bits | O | O | |
|
||||
| r | | 32 bit RGBA color | O | O | |
|
||||
| m | | 4 byte MIDI message. Bytes from MSB to LSB are: port id, status byte, data1, data2 | O | O | |
|
||||
| [ | | Indicates the beginning of an array. The tags following are for data in the Array. | O | O | YES? |
|
||||
| ] | | Indicates the end of an array. | O | O | YES? |
|
||||
|
||||
|
||||
- *R*equired, *O*ptional and *N*ot supported (or *N*ot required).
|
||||
- data is encoded as =(vector (unsigned 8))= by =cl-osc=
|
||||
|
||||
* Float encoding & decoding
|
||||
|
||||
#+BEGIN_SRC lisp
|
||||
(defun encode-float32 (f)
|
||||
"Encode an ieee754 float as a 4 byte vector. currently sbcl/cmucl specific."
|
||||
(encode-int32 (ieee-floats:encode-float32 f)))
|
||||
;; #+sbcl (encode-int32 (sb-kernel:single-float-bits f))
|
||||
;; #+cmucl (encode-int32 (kernel:single-float-bits f))
|
||||
;; #+openmcl (encode-int32 (CCL::SINGLE-FLOAT-BITS f))
|
||||
;; #+allegro (encode-int32 (multiple-value-bind (x y)
|
||||
;; (excl:single-float-to-shorts f)
|
||||
;; (+ (ash x 16) y)))
|
||||
;; #-(or sbcl cmucl openmcl allegro ieee-floats) (error "Can't encode single-floats using this implementation."))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp
|
||||
(defun decode-float32 (v)
|
||||
"Convert a vector of 4 bytes in network byte order into an ieee754 float."
|
||||
(ieee-floats:decode-float32 (decode-int32 v)))
|
||||
;; #+sbcl (sb-kernel:make-single-float (decode-int32 v))
|
||||
;; #+cmucl (kernel:make-single-float (decode-int32 v))
|
||||
;; #+openmcl (CCL::HOST-SINGLE-FLOAT-FROM-UNSIGNED-BYTE-32 (decode-uint32 v))
|
||||
;; #+allegro (excl:shorts-to-single-float (ldb (byte 16 16) (decode-int32 v))
|
||||
;; (ldb (byte 16 0) (decode-int32 v)))
|
||||
;; #-(or sbcl cmucl openmcl allegro) (error "Can't decode single-floats using this implementation."))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp
|
||||
(defun encode-float64 (d)
|
||||
"Encode an ieee754 float as a 8 byte vector. currently sbcl/cmucl specific."
|
||||
#+sbcl (cat (encode-int32 (sb-kernel:double-float-high-bits d))
|
||||
(encode-int32 (sb-kernel:double-float-low-bits d)))
|
||||
#-(or sbcl ieee-floats) (error "Can't encode double-floats using this implementation."))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC lisp
|
||||
(defun decode-float64 (v)
|
||||
"Convert a vector of 8 bytes in network byte order into an ieee754 float."
|
||||
#+sbcl (sb-kernel:make-double-float
|
||||
(decode-uint32 (subseq v 0 4))
|
||||
(decode-uint32 (subseq v 4 8)))
|
||||
#-(or sbcl ieee-floats) (error "Can't decode single-floats using this implementation."))
|
||||
#+END_SRC
|
||||
414
osc-tests.lisp
414
osc-tests.lisp
|
|
@ -1,51 +1,37 @@
|
|||
;; -*- mode: lisp -*-
|
||||
;;
|
||||
;; Quick and dirty tests for cl-osc
|
||||
;; Various tests for cl-osc using 5am
|
||||
;;
|
||||
;; You are granted the rights to distribute and use this software
|
||||
;; as governed by the terms of GNU Public License (aka the GPL)
|
||||
;; see the LICENCE file.
|
||||
|
||||
;; Authors
|
||||
;; - nik gaffney <nik@fo.am>
|
||||
|
||||
(require "usocket")
|
||||
(defpackage :osc/tests
|
||||
(:use :cl :osc :fiveam))
|
||||
|
||||
(defun osc-write ()
|
||||
"a basic test function which sends various osc stuff on port 5555"
|
||||
(let ((sock (sb-bsd-sockets::make-instance
|
||||
'inet-socket
|
||||
:type :datagram
|
||||
:protocol :udp)))
|
||||
(sb-bsd-sockets::socket-connect sock #(127 0 0 1) 5555)
|
||||
(let ((stream
|
||||
(sb-bsd-sockets::socket-make-stream
|
||||
sock
|
||||
:input t
|
||||
:output t
|
||||
:element-type '(unsigned-byte 8)
|
||||
:buffering :full)))
|
||||
(prin1 "int? ")
|
||||
(write-sequence (oti) stream)
|
||||
(force-output stream)
|
||||
(prin1 "float? ")
|
||||
(write-sequence (otf) stream)
|
||||
(force-output stream)
|
||||
(prin1 "string?")
|
||||
(write-sequence (ots) stream)
|
||||
(force-output stream)
|
||||
(prin1 "mutliple args?")
|
||||
(write-sequence (otm) stream)
|
||||
(force-output stream)
|
||||
(sb-bsd-sockets::socket-close sock)
|
||||
)))
|
||||
(in-package :osc/tests)
|
||||
|
||||
(defun oti () (osc:encode-message "/test/int" 3))
|
||||
(defun otf () (osc:encode-message "/test/float" 4.337))
|
||||
(defun ots () (osc:encode-message "/test/string" "wonky_stringpuk"))
|
||||
(defun otbl () (osc:encode-message "/test/blob" #(0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
|
||||
(defun otm () (osc:encode-message "/test/multi 5.78 1" "five point seven eight" "and one"))
|
||||
(defun otbn () (osc-encode-bundle (osc-make-test-bundle)))
|
||||
;; (in-package :osc)
|
||||
;; (require "fiveam")
|
||||
|
||||
;; setup various test suites
|
||||
|
||||
(def-suite synchroscope
|
||||
:description "OSC test suite(s).")
|
||||
|
||||
(def-suite data-encoding
|
||||
:description "Test encoding and decoding of OSC data types." :in synchroscope)
|
||||
|
||||
(def-suite message-encoding
|
||||
:description "Test encoding and decoding of OSC messages." :in synchroscope)
|
||||
|
||||
(def-suite protocol-v1.0
|
||||
:description "OSC v1.0 compatibility." :in synchroscope)
|
||||
|
||||
(def-suite protocol-v1.1
|
||||
:description "OSC v1.1 compatibility." :in synchroscope)
|
||||
|
||||
(def-suite interoperability
|
||||
:description "Test interoperability (e.g. supercollider & pd)" :in synchroscope)
|
||||
|
||||
;; test todo
|
||||
;; - negative floats
|
||||
|
|
@ -53,144 +39,259 @@
|
|||
;; - blobs, and long args
|
||||
;; - byte aligning 0,1,2,3,4 mod
|
||||
;; - error catching, junk data
|
||||
;; - edge cases?
|
||||
|
||||
(defun osc-test ()
|
||||
(format t "osc tests: ~a"
|
||||
(list
|
||||
(osc-t2) (osc-t3) (osc-t4)
|
||||
(osc-t5) (osc-t6) (osc-t7)
|
||||
(osc-t8) (osc-t9) (osc-t10)
|
||||
(osc-t11) (osc-t12) (osc-t13)))
|
||||
T)
|
||||
(in-suite data-encoding)
|
||||
|
||||
(defun osc-t2 ()
|
||||
(equalp '("/dip/lop" 666)
|
||||
(osc:decode-message #(47 100 105 112 47 108 111 112 0 0 0 0 44 105 0 0 0 0 2 154))))
|
||||
;; required data types
|
||||
(test osc-int32
|
||||
"OSC int32 encoding tests."
|
||||
(is (equalp
|
||||
(osc::encode-int32 16843009) #(1 1 1 1)))
|
||||
(is (equalp
|
||||
(osc::decode-int32 #(1 1 11 111)) 16845679))
|
||||
(is (equalp
|
||||
(osc::encode-int32 -16843010) #(254 254 254 254)))
|
||||
(is (equalp
|
||||
(osc::decode-int32 #(255 255 255 255)) -1)))
|
||||
|
||||
(defun osc-t3 ()
|
||||
(equalp '#(0 0 0 3 116 101 115 116 0 0 0 0 0 0 0 2 0 0 0 1 64 159 92 41)
|
||||
(osc::encode-data '(3 "test" 2 1 4.98))))
|
||||
(test osc-float32
|
||||
"OSC float32 encoding tests."
|
||||
(is (equalp
|
||||
(osc::encode-float32 1.00001) #(63 128 0 84)))
|
||||
(is (equalp
|
||||
(osc::decode-float32 #(1 1 1 1)) 2.3694278e-38))
|
||||
(is (equalp
|
||||
(osc::encode-float32 -2.3694278e33) #(246 233 164 196)))
|
||||
(is (equalp
|
||||
(osc::decode-float32 #(254 254 254 254)) -1.6947395e38)))
|
||||
|
||||
(defun osc-t4 ()
|
||||
(equalp #(44 105 115 102 0 0 0 0)
|
||||
(osc::encode-typetags '(1 "terrr" 3.4))))
|
||||
(test osc-string
|
||||
"OSC string encoding tests."
|
||||
(is (equalp
|
||||
(osc::decode-string #(110 117 108 108 32 112 97 100 100 101 100 0))
|
||||
"null padded"))
|
||||
(is (equalp
|
||||
(osc::encode-string "OSC string encoding test")
|
||||
#(79 83 67 32 115 116 114 105 110 103 32 101
|
||||
110 99 111 100 105 110 103 32 116 101 115 116 0 0 0 0))))
|
||||
|
||||
(defun osc-t5 ()
|
||||
(equalp #(44 105 105 102 0 0 0 0)
|
||||
(osc::encode-typetags '(1 2 3.3))))
|
||||
;; blob
|
||||
;; (osc::encode-blob "THE BLOB")
|
||||
|
||||
(defun osc-t6 ()
|
||||
(equal '("/test/one" 1 2 3.3)
|
||||
(osc:decode-message #(47 116 101 115 116 47 111 110 101 0 0 0 44 105 105 102 0 0 0 0 0 0 0 1 0 0 0 2 64 83 51 51))))
|
||||
(test osc-blob
|
||||
"OSC blob encoding tests."
|
||||
(is (equalp
|
||||
(osc::encode-blob #(1 1 1 1)) #(0 0 0 4 1 1 1 1))))
|
||||
|
||||
(defun osc-t7 ()
|
||||
(equalp '(#(0 0 0 0 0 0 0 1) ("/voices/0/tm/start" 0.0)
|
||||
("/foo/stringmessage" "a" "few" "strings") ("/documentation/all-messages"))
|
||||
(osc:decode-bundle
|
||||
#(#x23 #x62 #x75 #x6e
|
||||
#x64 #x6c #x65 0
|
||||
0 0 0 0
|
||||
0 0 0 #x1
|
||||
0 0 0 #x20
|
||||
#x2f #x64 #x6f #x63
|
||||
#x75 #x6d #x65 #x6e
|
||||
#x74 #x61 #x74 #x69
|
||||
#x6f #x6e #x2f #x61
|
||||
#x6c #x6c #x2d #x6d
|
||||
#x65 #x73 #x73 #x61
|
||||
#x67 #x65 #x73 0
|
||||
#x2c 0 0 0
|
||||
0 0 0 #x2c
|
||||
#x2f #x66 #x6f #x6f
|
||||
#x2f #x73 #x74 #x72
|
||||
#x69 #x6e #x67 #x6d
|
||||
#x65 #x73 #x73 #x61
|
||||
#x67 #x65 0 0
|
||||
#x2c #x73 #x73 #x73
|
||||
0 0 0 0
|
||||
#x61 0 0 0
|
||||
#x66 #x65 #x77 0
|
||||
#x73 #x74 #x72 #x69
|
||||
#x6e #x67 #x73 0
|
||||
0 0 0 #x1c
|
||||
#x2f #x76 #x6f #x69
|
||||
#x63 #x65 #x73 #x2f
|
||||
#x30 #x2f #x74 #x6d
|
||||
#x2f #x73 #x74 #x61
|
||||
#x72 #x74 0 0
|
||||
#x2c #x66 0 0
|
||||
0 0 0 0))))
|
||||
(test osc-timetag
|
||||
"OSC timetag encoding tests."
|
||||
(is (equalp
|
||||
(osc::encode-timetag :now) #(0 0 0 0 0 0 0 1))))
|
||||
|
||||
(defun osc-t8 ()
|
||||
(equalp (osc::encode-message "/blob/x" #(1 2 3 4 5 6 7 8 9))
|
||||
#(47 98 108 111 98 47 120 0 44 98 0 0 0 0 0 9 1 2 3 4 5 6 7 8 9 0 0 0)))
|
||||
(test osc-int64
|
||||
"OSC int64 encoding tests."
|
||||
(is (equalp
|
||||
(osc::encode-int64 16843009) #(0 0 0 0 1 1 1 1)))
|
||||
(is (equalp
|
||||
(osc::decode-int64 #(1 1 1 1 1 1 1 1)) 72340172838076673))
|
||||
(is (equalp
|
||||
(osc::encode-int64 -8000000000000000008) #(144 250 74 98 196 223 255 248)))
|
||||
(is (equalp
|
||||
(osc::decode-int64 #(254 1 254 1 254 1 254 1)) -143554428589179391)))
|
||||
|
||||
(defun osc-t9 ()
|
||||
(equalp '("/blob/x" #(1 2 3 4 5 6 7 8 9))
|
||||
(osc::decode-message
|
||||
#(47 98 108 111 98 47 120 0 44 98 0 0 0 0 0 9 1 2 3 4 5 6 7 8 9 0 0 0))))
|
||||
(test osc-float64
|
||||
"OSC float64 encoding tests."
|
||||
(is (equalp
|
||||
(osc::encode-float64 23.1d0) #(64 55 25 153 153 153 153 154)))
|
||||
(is (equalp
|
||||
(osc::decode-float64 #(64 55 25 153 153 153 153 154)) 23.1d0))
|
||||
(is (equalp
|
||||
(osc::encode-float64 2.31d55) #(75 110 37 155 172 119 156 244)))
|
||||
(is (equalp
|
||||
(osc::decode-float64 #(65 225 53 249 176 0 0 0)) 2.31d9)))
|
||||
|
||||
(defun osc-t10 ()
|
||||
(equalp '("/blob" #(1 29 32 43 54 66 78 81) 2 "lop")
|
||||
(osc:decode-message
|
||||
#(47 98 108 111 98 0 0 0 44 98 105 115 0 0 0 0
|
||||
0 0 0 8 1 29 32 43 54 66 78 81 0 0 0 0 0 0 0 2 108 111 112 0))))
|
||||
;; empty messages tagged T, F, N, I
|
||||
|
||||
(defun osc-t11 ()
|
||||
(equalp '(#(0 0 0 0 0 0 0 1) ("/string/a/ling" "slink" "slonk" "slank")
|
||||
("/we/wo/w" 1 2 3.4) ("/blob" #(1 29 32 43 54 66 78 81 90) "lop" -0.44))
|
||||
(osc:decode-bundle
|
||||
#(35 98 117 110 100 108 101 0 0 0 0 0 0 0 0 1 0 0 0 40 47 98 108 111 98 0 0 0
|
||||
44 98 115 102 0 0 0 0 0 0 0 9 1 29 32 43 54 66 78 81 90 0 0 0 108 111 112 0
|
||||
190 225 71 174 0 0 0 32 47 119 101 47 119 111 47 119 0 0 0 0 44 105 105 102 0
|
||||
0 0 0 0 0 0 1 0 0 0 2 64 89 153 154 0 0 0 48 47 115 116 114 105 110 103 47 97
|
||||
47 108 105 110 103 0 0 44 115 115 115 0 0 0 0 115 108 105 110 107 0 0 0 115
|
||||
108 111 110 107 0 0 0 115 108 97 110 107 0 0 0))))
|
||||
(in-suite message-encoding)
|
||||
|
||||
;; messages
|
||||
|
||||
(test osc-message-1
|
||||
"OSC message encoding tests. address and single int."
|
||||
:suite 'message-encoding
|
||||
(is (equalp
|
||||
'("/test/int" -1)
|
||||
(osc:decode-message #(47 116 101 115 116 47 105 110 116 0 0 0 44 105 0 0 255 255 255 255)))))
|
||||
|
||||
#+sbcl (defun osc-read (port)
|
||||
"A basic test function which attempts to decode osc stuff on PORT."
|
||||
(let ((s (make-instance 'inet-socket
|
||||
:type :datagram
|
||||
:protocol (get-protocol-by-name "udp")))
|
||||
(buffer (make-sequence '(vector (unsigned-byte 8)) 512)))
|
||||
(format t "Socket type is ~A on port ~A~%" (sockopt-type s) port)
|
||||
(socket-bind s #(127 0 0 1) port)
|
||||
(socket-receive s buffer nil :waitall t)
|
||||
(socket-close s)
|
||||
(osc:decode-message buffer)
|
||||
))
|
||||
;; check padding boundaries. 1-3 or 1-4?
|
||||
(test osc-t4
|
||||
"OSC typetag encoding test. string, ints and floats."
|
||||
(is (equalp
|
||||
#(44 105 115 102 0 0 0 0)
|
||||
(osc::encode-typetags '(1 "terrr" 3.4)))))
|
||||
|
||||
;;(osc-decode-message data)
|
||||
(test osc-t5
|
||||
"OSC typetag encoding test. ints and floats."
|
||||
(is (equalp
|
||||
#(44 105 105 102 0 0 0 0)
|
||||
(osc::encode-typetags '(1 2 3.3)))))
|
||||
|
||||
(defun osc-ft ()
|
||||
(and (eql (osc::DECODE-FLOAT32 #(63 84 32 93)) 0.8286188)
|
||||
(eql (osc::DECODE-FLOAT32 #(190 124 183 78)) -0.246793)))
|
||||
(test osc-t6
|
||||
"OSC message decoding test. ints and floats."
|
||||
(is (equalp
|
||||
'("/test/one" 1 2 3.3)
|
||||
(osc:decode-message
|
||||
#(47 116 101 115 116 47 111 110
|
||||
101 0 0 0 44 105 105 102
|
||||
0 0 0 0 0 0 0 1
|
||||
0 0 0 2 64 83 51 51)))))
|
||||
|
||||
(test osc-t7
|
||||
"OSC bundle decoding test. strings, ints and floats."
|
||||
(is (equalp
|
||||
'(#(0 0 0 0 0 0 0 1)
|
||||
("/voices/0/tm/start" 0.0)
|
||||
("/foo/stringmessage" "a" "few" "strings")
|
||||
("/documentation/all-messages"))
|
||||
(osc:decode-bundle
|
||||
#(#x23 #x62 #x75 #x6e
|
||||
#x64 #x6c #x65 0
|
||||
0 0 0 0
|
||||
0 0 0 #x1
|
||||
0 0 0 #x20
|
||||
#x2f #x64 #x6f #x63
|
||||
#x75 #x6d #x65 #x6e
|
||||
#x74 #x61 #x74 #x69
|
||||
#x6f #x6e #x2f #x61
|
||||
#x6c #x6c #x2d #x6d
|
||||
#x65 #x73 #x73 #x61
|
||||
#x67 #x65 #x73 0
|
||||
#x2c 0 0 0
|
||||
0 0 0 #x2c
|
||||
#x2f #x66 #x6f #x6f
|
||||
#x2f #x73 #x74 #x72
|
||||
#x69 #x6e #x67 #x6d
|
||||
#x65 #x73 #x73 #x61
|
||||
#x67 #x65 0 0
|
||||
#x2c #x73 #x73 #x73
|
||||
0 0 0 0
|
||||
#x61 0 0 0
|
||||
#x66 #x65 #x77 0
|
||||
#x73 #x74 #x72 #x69
|
||||
#x6e #x67 #x73 0
|
||||
0 0 0 #x1c
|
||||
#x2f #x76 #x6f #x69
|
||||
#x63 #x65 #x73 #x2f
|
||||
#x30 #x2f #x74 #x6d
|
||||
#x2f #x73 #x74 #x61
|
||||
#x72 #x74 0 0
|
||||
#x2c #x66 0 0
|
||||
0 0 0 0)))))
|
||||
|
||||
(test osc-t8
|
||||
"OSC message encoding test. blob."
|
||||
(is (equalp
|
||||
(osc::encode-message "/blob/x" #(1 2 3 4 5 6 7 8 9))
|
||||
#(47 98 108 111 98 47 120 0 44 98 0 0 0 0 0 9 1 2 3 4 5 6 7 8 9 0 0 0))))
|
||||
|
||||
(test osc-t9
|
||||
"OSC message decoding test. blob."
|
||||
(is (equalp
|
||||
'("/blob/x" #(1 2 3 4 5 6 7 8 9))
|
||||
(osc::decode-message
|
||||
#(47 98 108 111 98 47 120 0 44 98 0 0 0 0 0 9 1 2 3 4 5 6 7 8 9 0 0 0)))))
|
||||
|
||||
(test osc-t10
|
||||
"OSC message decoding test. blob, int, string."
|
||||
(is (equalp '("/blob" #(1 29 32 43 54 66 78 81) "lop" 2)
|
||||
(osc:decode-message
|
||||
#(47 98 108 111 98 0 0 0 44 98 115 105 0 0 0
|
||||
0 0 0 0 8 1 29 32 43 54 66 78 81
|
||||
108 111 112 0 0 0 0 2)))))
|
||||
(test osc-t11
|
||||
"OSC bundle decoding test."
|
||||
(is (equalp
|
||||
'(#(0 0 0 0 0 0 0 1)
|
||||
("/string/a/ling" "slink" "slonk" "slank")
|
||||
("/we/wo/w" 1 2 3.4)
|
||||
("/blob" #(1 29 32 43 54 66 78 81 90) "lop" -0.44))
|
||||
(osc:decode-bundle
|
||||
#(35 98 117 110 100 108 101 0 0 0 0 0 0 0 0 1 0 0 0 40 47 98 108 111 98 0 0 0
|
||||
44 98 115 102 0 0 0 0 0 0 0 9 1 29 32 43 54 66 78 81 90 0 0 0 108 111 112 0
|
||||
190 225 71 174 0 0 0 32 47 119 101 47 119 111 47 119 0 0 0 0 44 105 105 102 0
|
||||
0 0 0 0 0 0 1 0 0 0 2 64 89 153 154 0 0 0 48 47 115 116 114 105 110 103 47 97
|
||||
47 108 105 110 103 0 0 44 115 115 115 0 0 0 0 115 108 105 110 107 0 0 0 115
|
||||
108 111 110 107 0 0 0 115 108 97 110 107 0 0 0)))))
|
||||
|
||||
|
||||
;; equalp but not eql
|
||||
(defun osc-t12 ()
|
||||
(equalp (osc:encode-message "/asdasd" 3.6 4.5)
|
||||
#(47 97 115 100 97 115 100 0 44 102 102 0 64 102 102 102 64 144 0 0)))
|
||||
(test osc-t13
|
||||
"OSC message encoding test."
|
||||
(is (equalp
|
||||
(osc:encode-message "/asdasd" 3.6 4.5)
|
||||
#(47 97 115 100 97 115 100 0 44 102 102 0 64 102 102 102 64 144 0 0))))
|
||||
|
||||
;; equal but not eql
|
||||
(defun osc-t13 ()
|
||||
(equal (osc:decode-message #(47 97 115 100 97 115 100 0 44 102 102 0 64 102 102 102 64 144 0 0))
|
||||
(list "/asdasd" 3.6 4.5)))
|
||||
(test osc-t14
|
||||
"OSC message decoding test."
|
||||
(is (equalp
|
||||
(osc:decode-message
|
||||
#(47 97 115 100 97 115 100 0 44 102 102 0 64 102 102 102 64 144 0 0))
|
||||
(list "/asdasd" 3.6 4.5))))
|
||||
|
||||
;; not symmetrical? how much of a problem is this?
|
||||
(defun osc-asym-t1 ()
|
||||
"this test will fail"
|
||||
(osc:decode-message
|
||||
(osc:encode-message
|
||||
(osc:decode-message #(47 97 115 100 97 115 100 0 44 102 102 0 64 102 102 102 64 144 0 0)))))
|
||||
;; symmetrical? how much of a issue is this?
|
||||
(test osc-recode
|
||||
"OSC message encoding & decoding symmetry test."
|
||||
(let ((message (osc:decode-message
|
||||
#(47 97 115 100 97 115 100 0 44 102 102 0 64 102 102 102 64 144 0 0))))
|
||||
(is (equalp
|
||||
message
|
||||
(osc:decode-message
|
||||
(apply #'osc:encode-message message))))))
|
||||
|
||||
(defun osc-asym-t2 ()
|
||||
"testing the assumptions about representations of messages"
|
||||
(setf packed-msg #(47 97 115 100 97 115 100 0 44 102 102 0 64 102 102 102 64 144 0 0))
|
||||
(setf cons-msg (osc:decode-message packed-msg))
|
||||
(osc:encode-message (values-list cons-msg)))
|
||||
;; partially pathological string tests...
|
||||
(test osc-sp1
|
||||
(is (equalp
|
||||
(osc:encode-message "/s/t0" "four")
|
||||
#(47 115 47 116 48 0 0 0 44 115 0 0 102 111 117 114 0 0 0 0)))
|
||||
(is (equalp
|
||||
(osc:decode-message #(47 115 47 116 48 0 0 0 44 115 0 0 102 111 117 114 0 0 0 0))
|
||||
'("/s/t0" "four"))))
|
||||
|
||||
(test osc-sp2
|
||||
(is (equalp
|
||||
(osc:encode-message "/s/t0" 2 "xxxxx" 3)
|
||||
#(47 115 47 116 48 0 0 0 44 105 115 105 0 0 0 0
|
||||
0 0 0 2 120 120 120 120 120 0 0 0 0 0 0 3)))
|
||||
(is (equalp
|
||||
(osc:decode-message
|
||||
#(47 115 47 116 48 0 0 0 44 105 115 105 0 0 0 0
|
||||
0 0 0 2 120 120 120 120 120 0 0 0 0 0 0 3))
|
||||
'("/s/t0" 2 "xxxxx" 3))))
|
||||
|
||||
;; (test osc-t16
|
||||
;; "OSC message encoding & decoding symmetry test."
|
||||
;; (let* ((packed-msg #(47 97 115 100 97 115 100 0 44 102 102 0 64 102 102 102 64 144 0 0))
|
||||
;; (cons-msg (osc:decode-message packed-msg)))
|
||||
;; (is (equalp
|
||||
;; packed-msg
|
||||
;; (osc:encode-message (values-list cons-msg))))))
|
||||
|
||||
;; v1.0 tests
|
||||
(in-suite protocol-v1.0)
|
||||
|
||||
(test v1.0-required-types
|
||||
"OSC data encoding test. All required types for v1.0"
|
||||
(is (equalp
|
||||
#(0 0 0 3 116 101 115 116 0 0 0 0 67 82 0 0 0 0 0 4 1 2 3 4)
|
||||
(osc::encode-data '(3 "test" 2.1e2 #(1 2 3 4))))))
|
||||
|
||||
;; v1.1. tests
|
||||
(in-suite protocol-v1.1)
|
||||
|
||||
;; play nicely with others
|
||||
(in-suite interoperability)
|
||||
|
||||
#|
|
||||
sc3 server
|
||||
|
|
@ -209,5 +310,4 @@ sc3 server
|
|||
|
||||
|#
|
||||
|
||||
(defun run-tests ()
|
||||
(osc-test))
|
||||
(run! 'synchroscope)
|
||||
|
|
|
|||
23
osc.asd
23
osc.asd
|
|
@ -1,10 +1,19 @@
|
|||
;; -*- mode: lisp -*-
|
||||
(in-package :asdf-user)
|
||||
|
||||
(in-package #:cl-user)
|
||||
|
||||
(asdf:defsystem "osc"
|
||||
:author "nik gaffney <nik@fo.am>"
|
||||
:licence "GPL v3"
|
||||
(defsystem "osc"
|
||||
:description "The Open Sound Control protocol, aka OSC"
|
||||
:version "1.0.0"
|
||||
:components ((:file "osc")))
|
||||
:author "nik gaffney <nik@fo.am>"
|
||||
:depends-on ("ieee-floats")
|
||||
:version "0.9.1"
|
||||
:licence "GPL v3"
|
||||
:components ((:file "osc"))
|
||||
:in-order-to ((test-op (test-op "osc/tests"))))
|
||||
|
||||
;; regression testing. can be ignored/disabled at run time if required
|
||||
(defsystem "osc/tests"
|
||||
:description "Tests for OSC library."
|
||||
:depends-on ("osc" "fiveam")
|
||||
:components ((:file "osc-tests"))
|
||||
:perform (test-op (o c)
|
||||
(uiop:symbol-call :fiveam '#:run! :synchroscope)))
|
||||
|
|
|
|||
89
osc.lisp
89
osc.lisp
|
|
@ -9,34 +9,35 @@
|
|||
;;; the Free Software Foundation, either version 3 of the License, or
|
||||
;;; (at your option) any later version.
|
||||
;;;
|
||||
;;; authors
|
||||
;;; Authors
|
||||
;;;
|
||||
;;; nik gaffney <nik@fo.am> and the listed AUTHORS
|
||||
;;;
|
||||
;;; requirements
|
||||
;;; Requirements
|
||||
;;;
|
||||
;;; dependent on sbcl, cmucl or openmcl for float encoding, other suggestions
|
||||
;;; welcome.
|
||||
;;; depends on ieee-floats for float encoding and 5am for testing
|
||||
;;;
|
||||
;;; commentary
|
||||
;;; Commentary
|
||||
;;;
|
||||
;;; this is a partial implementation of the OSC protocol which is used
|
||||
;;; This is an implementation of the OSC protocol which is used
|
||||
;;; for communication mostly amongst music programs and their attached
|
||||
;;; musicians. eg. sc3, max/pd, reaktor/traktorska etc+. more details
|
||||
;;; of the protocol can be found at the open sound control pages -=>
|
||||
;;; http://www.cnmat.berkeley.edu/OpenSoundControl/
|
||||
;;; musicians (eg. supercollider, max/pd, ableton, etc).
|
||||
;;;
|
||||
;;; The OSC V1.0 is supported, and there is partial support for V1.1
|
||||
;;; More details of the protocol can be found at
|
||||
;;; http://OpenSoundControl.org
|
||||
;;;
|
||||
;;; see the README file for more details...
|
||||
;;; see the README file for further details...
|
||||
;;;
|
||||
;;; known BUGS/Issues
|
||||
;;; Known BUGS/Issues
|
||||
;;; - encoding a :symbol that is unbound or without symbol-value causes an error
|
||||
;;; - unknown types are sent as 'blobs' which may or may not be an issue
|
||||
;;; - malformed input -> exception
|
||||
|
||||
(defpackage :osc
|
||||
(:use :cl)
|
||||
(:documentation "OSC aka the 'open sound control' protocol")
|
||||
(:shadow :ieee-floats)
|
||||
(:documentation "OSC the 'Open Sound Control' protocol")
|
||||
(:export
|
||||
#:encode-message
|
||||
#:encode-bundle
|
||||
|
|
@ -87,7 +88,7 @@
|
|||
|
||||
NOTE: currently handles the following tags
|
||||
i => #(105) => int32
|
||||
f => #(102) => float
|
||||
f => #(102) => float32
|
||||
s => #(115) => string
|
||||
b => #(98) => blob
|
||||
h => #(104) => int64
|
||||
|
|
@ -167,7 +168,7 @@
|
|||
"Decode DATA encoded with typetags.
|
||||
NOTE: currently handles the following tags
|
||||
i => #(105) => int32
|
||||
f => #(102) => float
|
||||
f => #(102) => float32
|
||||
s => #(115) => string
|
||||
b => #(98) => blob
|
||||
h => #(104) => int64"
|
||||
|
|
@ -265,26 +266,7 @@
|
|||
;;
|
||||
;;; ;; ; ; ;
|
||||
|
||||
;; floats are encoded using implementation specific 'internals' which is not
|
||||
;; particularly portable, but 'works for now'.
|
||||
|
||||
(defun encode-float32 (f)
|
||||
"Encode an ieee754 float as a 4 byte vector. currently sbcl/cmucl specific."
|
||||
#+sbcl (encode-int32 (sb-kernel:single-float-bits f))
|
||||
#+cmucl (encode-int32 (kernel:single-float-bits f))
|
||||
#+openmcl (encode-int32 (CCL::SINGLE-FLOAT-BITS f))
|
||||
#+allegro (encode-int32 (multiple-value-bind (x y) (excl:single-float-to-shorts f)
|
||||
(+ (ash x 16) y)))
|
||||
#-(or sbcl cmucl openmcl allegro) (error "Can't encode floats using this implementation."))
|
||||
|
||||
(defun decode-float32 (s)
|
||||
"Convert a vector of 4 bytes in network byte order into an ieee754 float."
|
||||
#+sbcl (sb-kernel:make-single-float (decode-int32 s))
|
||||
#+cmucl (kernel:make-single-float (decode-int32 s))
|
||||
#+openmcl (CCL::HOST-SINGLE-FLOAT-FROM-UNSIGNED-BYTE-32 (decode-uint32 s))
|
||||
#+allegro (excl:shorts-to-single-float (ldb (byte 16 16) (decode-int32 s))
|
||||
(ldb (byte 16 0) (decode-int32 s)))
|
||||
#-(or sbcl cmucl openmcl allegro) (error "Can't decode floats using this implementation."))
|
||||
;; integers. 32 and 64 bit. signed and unsigned.
|
||||
|
||||
(defmacro defint-decoder (num-of-octets &optional docstring)
|
||||
(let ((decoder-name (intern (format nil "~:@(decode-uint~)~D" (* 8 num-of-octets))))
|
||||
|
|
@ -296,13 +278,12 @@
|
|||
(let* ((,int 0)
|
||||
,@(loop
|
||||
for n below num-of-octets
|
||||
collect `(,int (dpb (aref ,seq ,n) (byte 8 (* 8 (- (1- ,num-of-octets) ,n)))
|
||||
,int))))
|
||||
collect `(,int
|
||||
(dpb (aref ,seq ,n)
|
||||
(byte 8 (* 8 (- (1- ,num-of-octets) ,n)))
|
||||
,int))))
|
||||
,int))))
|
||||
|
||||
(defint-decoder 4 "4 byte -> 32 bit unsigned int")
|
||||
(defint-decoder 8 "8 byte -> 64 bit unsigned int")
|
||||
|
||||
(defmacro defint-encoder (num-of-octets &optional docstring)
|
||||
(let ((enc-name (intern (format nil "~:@(encode-int~)~D" (* 8 num-of-octets))))
|
||||
(buf (gensym))
|
||||
|
|
@ -318,6 +299,11 @@
|
|||
,int)))
|
||||
,buf))))
|
||||
|
||||
;; generate functions decode-uint32 and decode-uint64
|
||||
(defint-decoder 4 "4 byte -> 32 bit unsigned int")
|
||||
(defint-decoder 8 "8 byte -> 64 bit unsigned int")
|
||||
|
||||
;; generate functions encode-int32 and encode-int64
|
||||
(defint-encoder 4 "Convert an integer into a sequence of 4 bytes in network byte order.")
|
||||
(defint-encoder 8 "Convert an integer into a sequence of 8 bytes in network byte order.")
|
||||
|
||||
|
|
@ -335,6 +321,28 @@
|
|||
(- (- #.(expt 2 64) i))
|
||||
i)))
|
||||
|
||||
;; floats are encoded using ieee-floats library for brevity and compatibility
|
||||
;; - https://ieee-floats.common-lisp.dev/
|
||||
;;
|
||||
;; implementation specific encoding can be used for sbc, cmucl,
|
||||
;; allegro or ccl if required (see README)
|
||||
|
||||
(defun encode-float32 (f)
|
||||
"Encode an ieee754 float as a 4 byte vector. currently sbcl/cmucl specific."
|
||||
(encode-int32 (ieee-floats:encode-float32 f)))
|
||||
|
||||
(defun decode-float32 (v)
|
||||
"Convert a vector of 4 bytes in network byte order into an ieee754 float."
|
||||
(ieee-floats:decode-float32 (decode-uint32 v)))
|
||||
|
||||
(defun encode-float64 (d)
|
||||
"Encode an ieee754 float as a 8 byte vector."
|
||||
(encode-int64 (ieee-floats:encode-float64 d)))
|
||||
|
||||
(defun decode-float64 (v)
|
||||
"Convert a vector of 8 bytes in network byte order into an ieee754 float."
|
||||
(ieee-floats:decode-float64 (decode-int64 v)))
|
||||
|
||||
;; osc-strings are unsigned bytes, padded to a 4 byte boundary
|
||||
|
||||
(defun decode-string (data)
|
||||
|
|
@ -365,7 +373,8 @@
|
|||
;; utility functions for osc-string/padding/slonking
|
||||
|
||||
(defun cat (&rest catatac)
|
||||
(apply #'concatenate '(vector *) catatac))
|
||||
"Concatenate items into a byte vector."
|
||||
(apply #'concatenate '(vector (unsigned-byte 8)) catatac))
|
||||
|
||||
(defun padding-length (s)
|
||||
"Return the length of padding required for a given length of string."
|
||||
|
|
|
|||
Loading…
Reference in a new issue