synchroscope (part 2)

This commit is contained in:
nik gaffney 2023-12-31 17:33:12 +01:00
parent 153f07c8fa
commit 15215d5bab
Signed by: nik
GPG key ID: 989F5E6EDB478160
5 changed files with 411 additions and 281 deletions

View file

@ -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
View 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 twos 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 twos 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

View file

@ -1,51 +1,37 @@
;; -*- mode: lisp -*- ;; -*- 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 ;; Authors
;; - nik gaffney <nik@fo.am> ;; - nik gaffney <nik@fo.am>
(require "usocket") (defpackage :osc/tests
(:use :cl :osc :fiveam))
(defun osc-write () (in-package :osc/tests)
"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)
)))
(defun oti () (osc:encode-message "/test/int" 3)) ;; (in-package :osc)
(defun otf () (osc:encode-message "/test/float" 4.337)) ;; (require "fiveam")
(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))) ;; setup various test suites
(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))) (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 ;; test todo
;; - negative floats ;; - negative floats
@ -53,144 +39,259 @@
;; - blobs, and long args ;; - blobs, and long args
;; - byte aligning 0,1,2,3,4 mod ;; - byte aligning 0,1,2,3,4 mod
;; - error catching, junk data ;; - error catching, junk data
;; - edge cases?
(defun osc-test () (in-suite data-encoding)
(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)
(defun osc-t2 () ;; required data types
(equalp '("/dip/lop" 666) (test osc-int32
(osc:decode-message #(47 100 105 112 47 108 111 112 0 0 0 0 44 105 0 0 0 0 2 154)))) "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 () (test osc-float32
(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 float32 encoding tests."
(osc::encode-data '(3 "test" 2 1 4.98)))) (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 () (test osc-string
(equalp #(44 105 115 102 0 0 0 0) "OSC string encoding tests."
(osc::encode-typetags '(1 "terrr" 3.4)))) (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 () ;; blob
(equalp #(44 105 105 102 0 0 0 0) ;; (osc::encode-blob "THE BLOB")
(osc::encode-typetags '(1 2 3.3))))
(defun osc-t6 () (test osc-blob
(equal '("/test/one" 1 2 3.3) "OSC blob encoding tests."
(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)))) (is (equalp
(osc::encode-blob #(1 1 1 1)) #(0 0 0 4 1 1 1 1))))
(defun osc-t7 () (test osc-timetag
(equalp '(#(0 0 0 0 0 0 0 1) ("/voices/0/tm/start" 0.0) "OSC timetag encoding tests."
("/foo/stringmessage" "a" "few" "strings") ("/documentation/all-messages")) (is (equalp
(osc:decode-bundle (osc::encode-timetag :now) #(0 0 0 0 0 0 0 1))))
#(#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))))
(defun osc-t8 () (test osc-int64
(equalp (osc::encode-message "/blob/x" #(1 2 3 4 5 6 7 8 9)) "OSC int64 encoding tests."
#(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))) (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 () (test osc-float64
(equalp '("/blob/x" #(1 2 3 4 5 6 7 8 9)) "OSC float64 encoding tests."
(osc::decode-message (is (equalp
#(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)))) (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 () ;; empty messages tagged T, F, N, I
(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))))
(defun osc-t11 () (in-suite message-encoding)
(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))))
;; 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) ;; check padding boundaries. 1-3 or 1-4?
"A basic test function which attempts to decode osc stuff on PORT." (test osc-t4
(let ((s (make-instance 'inet-socket "OSC typetag encoding test. string, ints and floats."
:type :datagram (is (equalp
:protocol (get-protocol-by-name "udp"))) #(44 105 115 102 0 0 0 0)
(buffer (make-sequence '(vector (unsigned-byte 8)) 512))) (osc::encode-typetags '(1 "terrr" 3.4)))))
(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)
))
;;(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 () (test osc-t6
(and (eql (osc::DECODE-FLOAT32 #(63 84 32 93)) 0.8286188) "OSC message decoding test. ints and floats."
(eql (osc::DECODE-FLOAT32 #(190 124 183 78)) -0.246793))) (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 ;; equalp but not eql
(defun osc-t12 () (test osc-t13
(equalp (osc:encode-message "/asdasd" 3.6 4.5) "OSC message encoding test."
#(47 97 115 100 97 115 100 0 44 102 102 0 64 102 102 102 64 144 0 0))) (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 ;; equal but not eql
(defun osc-t13 () (test osc-t14
(equal (osc:decode-message #(47 97 115 100 97 115 100 0 44 102 102 0 64 102 102 102 64 144 0 0)) "OSC message decoding test."
(list "/asdasd" 3.6 4.5))) (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? ;; symmetrical? how much of a issue is this?
(defun osc-asym-t1 () (test osc-recode
"this test will fail" "OSC message encoding & decoding symmetry test."
(osc:decode-message (let ((message (osc:decode-message
(osc:encode-message #(47 97 115 100 97 115 100 0 44 102 102 0 64 102 102 102 64 144 0 0))))
(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 () ;; partially pathological string tests...
"testing the assumptions about representations of messages" (test osc-sp1
(setf packed-msg #(47 97 115 100 97 115 100 0 44 102 102 0 64 102 102 102 64 144 0 0)) (is (equalp
(setf cons-msg (osc:decode-message packed-msg)) (osc:encode-message "/s/t0" "four")
(osc:encode-message (values-list cons-msg))) #(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 sc3 server
@ -209,5 +310,4 @@ sc3 server
|# |#
(defun run-tests () (run! 'synchroscope)
(osc-test))

23
osc.asd
View file

@ -1,10 +1,19 @@
;; -*- mode: lisp -*- ;; -*- mode: lisp -*-
(in-package :asdf-user)
(in-package #:cl-user) (defsystem "osc"
(asdf:defsystem "osc"
:author "nik gaffney <nik@fo.am>"
:licence "GPL v3"
:description "The Open Sound Control protocol, aka OSC" :description "The Open Sound Control protocol, aka OSC"
:version "1.0.0" :author "nik gaffney <nik@fo.am>"
:components ((:file "osc"))) :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)))

View file

@ -9,34 +9,35 @@
;;; the Free Software Foundation, either version 3 of the License, or ;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version. ;;; (at your option) any later version.
;;; ;;;
;;; authors ;;; Authors
;;; ;;;
;;; nik gaffney <nik@fo.am> and the listed AUTHORS ;;; nik gaffney <nik@fo.am> and the listed AUTHORS
;;; ;;;
;;; requirements ;;; Requirements
;;; ;;;
;;; dependent on sbcl, cmucl or openmcl for float encoding, other suggestions ;;; depends on ieee-floats for float encoding and 5am for testing
;;; welcome.
;;; ;;;
;;; 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 ;;; for communication mostly amongst music programs and their attached
;;; musicians. eg. sc3, max/pd, reaktor/traktorska etc+. more details ;;; musicians (eg. supercollider, max/pd, ableton, etc).
;;; of the protocol can be found at the open sound control pages -=>
;;; http://www.cnmat.berkeley.edu/OpenSoundControl/
;;; ;;;
;;; 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 ;;; - 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 ;;; - unknown types are sent as 'blobs' which may or may not be an issue
;;; - malformed input -> exception ;;; - malformed input -> exception
(defpackage :osc (defpackage :osc
(:use :cl) (:use :cl)
(:documentation "OSC aka the 'open sound control' protocol") (:shadow :ieee-floats)
(:documentation "OSC the 'Open Sound Control' protocol")
(:export (:export
#:encode-message #:encode-message
#:encode-bundle #:encode-bundle
@ -87,7 +88,7 @@
NOTE: currently handles the following tags NOTE: currently handles the following tags
i => #(105) => int32 i => #(105) => int32
f => #(102) => float f => #(102) => float32
s => #(115) => string s => #(115) => string
b => #(98) => blob b => #(98) => blob
h => #(104) => int64 h => #(104) => int64
@ -167,7 +168,7 @@
"Decode DATA encoded with typetags. "Decode DATA encoded with typetags.
NOTE: currently handles the following tags NOTE: currently handles the following tags
i => #(105) => int32 i => #(105) => int32
f => #(102) => float f => #(102) => float32
s => #(115) => string s => #(115) => string
b => #(98) => blob b => #(98) => blob
h => #(104) => int64" h => #(104) => int64"
@ -265,26 +266,7 @@
;; ;;
;;; ;; ; ; ; ;;; ;; ; ; ;
;; floats are encoded using implementation specific 'internals' which is not ;; integers. 32 and 64 bit. signed and unsigned.
;; 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."))
(defmacro defint-decoder (num-of-octets &optional docstring) (defmacro defint-decoder (num-of-octets &optional docstring)
(let ((decoder-name (intern (format nil "~:@(decode-uint~)~D" (* 8 num-of-octets)))) (let ((decoder-name (intern (format nil "~:@(decode-uint~)~D" (* 8 num-of-octets))))
@ -296,13 +278,12 @@
(let* ((,int 0) (let* ((,int 0)
,@(loop ,@(loop
for n below num-of-octets for n below num-of-octets
collect `(,int (dpb (aref ,seq ,n) (byte 8 (* 8 (- (1- ,num-of-octets) ,n))) collect `(,int
,int)))) (dpb (aref ,seq ,n)
(byte 8 (* 8 (- (1- ,num-of-octets) ,n)))
,int))))
,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) (defmacro defint-encoder (num-of-octets &optional docstring)
(let ((enc-name (intern (format nil "~:@(encode-int~)~D" (* 8 num-of-octets)))) (let ((enc-name (intern (format nil "~:@(encode-int~)~D" (* 8 num-of-octets))))
(buf (gensym)) (buf (gensym))
@ -318,6 +299,11 @@
,int))) ,int)))
,buf)))) ,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 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.") (defint-encoder 8 "Convert an integer into a sequence of 8 bytes in network byte order.")
@ -335,6 +321,28 @@
(- (- #.(expt 2 64) i)) (- (- #.(expt 2 64) i))
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 ;; osc-strings are unsigned bytes, padded to a 4 byte boundary
(defun decode-string (data) (defun decode-string (data)
@ -365,7 +373,8 @@
;; utility functions for osc-string/padding/slonking ;; utility functions for osc-string/padding/slonking
(defun cat (&rest catatac) (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) (defun padding-length (s)
"Return the length of padding required for a given length of string." "Return the length of padding required for a given length of string."