synchroscope

zzkt · Dec 31, 2023 · 8f023c5 · 8f023c5
1 parent a75d2a2
commit 8f023c5
Show file tree

Hide file tree

Showing 5 changed files with 167 additions and 100 deletions.
diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml
@@ -17,8 +17,8 @@ jobs:
       matrix:
       # current ccl-bin has a flaky zip file, so roswell can't install it.
       # Specify a version that works for now.
-        lisp: [sbcl-bin]
-        os: [ windows-latest, ubuntu-latest, macos-latest]
+        lisp: [ sbcl-bin ]
+        os: [ windows-latest, ubuntu-latest, macos-latest ]
 
     # run the job on every combination of "lisp" and "os" above
     runs-on: ${{ matrix.os }}
@@ -75,10 +75,11 @@ jobs:
       run: |
         ros -e '(format t "~a:~a on ~a~%...~%~%" (lisp-implementation-type) (lisp-implementation-version) (machine-type))'
         ros -e '(format t " fixnum bits:~a~%" (integer-length most-positive-fixnum))'
+        ros -e "(ql:quickload 'fiveam)"
         ros -e "(ql:quickload 'trivial-features)" -e '(format t "features = ~s~%" *features*)'
     - name: update ql dist if we have one cached
       run: ros -e "(ql:update-all-dists :prompt nil)"
 
     - name: load code and run tests
       run: |
-        ros -e '(handler-bind (#+asdf3.2(asdf:bad-SYSTEM-NAME (function MUFFLE-WARNING))) (handler-case (ql:quickload :osc) (error (a) (format t "caught error ~s~%~a~%" a a) (uiop:quit 123))))' -e '(osc:run-tests)'
+        ros -e '(handler-bind (#+asdf3.2(asdf:bad-SYSTEM-NAME (function MUFFLE-WARNING))) (handler-case (ql:quickload :osc) (error (a) (format t "caught error ~s~%~a~%" a a) (uiop:quit 123))))' -e '(asdf:test-system :osc)'
diff --git a/README.org b/README.org
@@ -43,3 +43,47 @@ This implementation supports the [[https://opensoundcontrol.stanford.edu/spec-1_
 
 - *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
diff --git a/osc-tests.lisp b/osc-tests.lisp
@@ -1,34 +1,37 @@
 ;; -*- mode: lisp -*-
 ;;
-;; Quick and dirty tests for cl-osc using 5am
+;; Various tests for cl-osc using 5am
 ;;
 ;; Authors
 ;;  - nik gaffney <nik@fo.am>
 
-(defpackage :osc-tests
+(defpackage :osc/tests
   (:use :cl :osc :fiveam))
 
-(in-package :osc-tests)
+(in-package :osc/tests)
+
+;; (in-package :osc)
+;; (require "fiveam")
 
 ;; setup various test suites
 
-(def-suite osc-test-suite
+(def-suite synchroscope
   :description "OSC test suite(s).")
 
 (def-suite data-encoding
-  :description "Test encoding and decoding of OSC data types."  :in osc-test-suite)
+  :description "Test encoding and decoding of OSC data types."  :in synchroscope)
 
 (def-suite message-encoding
-  :description "Test encoding and decoding of OSC messages."  :in osc-test-suite)
+  :description "Test encoding and decoding of OSC messages."  :in synchroscope)
 
 (def-suite protocol-v1.0
-  :description "OSC v1.0 compatibility."  :in osc-test-suite)
+  :description "OSC v1.0 compatibility."  :in synchroscope)
 
 (def-suite protocol-v1.1
-  :description "OSC v1.1 compatibility."  :in osc-test-suite)
+  :description "OSC v1.1 compatibility."  :in synchroscope)
 
 (def-suite interoperability
-  :description "Test interoperability (e.g. supercollider & pd)"  :in osc-test-suite)
+  :description "Test interoperability (e.g. supercollider & pd)"  :in synchroscope)
 
 ;; test todo
 ;;  - negative floats
@@ -81,7 +84,6 @@
   (is (equalp
        (osc::encode-blob #(1 1 1 1)) #(0 0 0 4 1 1 1 1))))
 
-
 (test osc-timetag
   "OSC timetag encoding tests."
   (is (equalp
@@ -98,16 +100,16 @@
   (is (equalp
        (osc::decode-int64 #(254 1 254 1 254 1 254 1)) -143554428589179391)))
 
- (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)))
+(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)))
 
 ;; empty messages tagged T, F, N, I
 
@@ -122,12 +124,6 @@
        '("/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)))))
 
-(test osc-message-2
-  "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))))))
-
 ;; check padding boundaries. 1-3 or 1-4?
 (test osc-t4
   "OSC typetag encoding test. string, ints and floats."
@@ -208,24 +204,25 @@
 
 (test osc-t10
   "OSC message decoding test. blob, int, string."
-  (is (equalp '("/blob" #(1 29 32 43 54 66 78 81) 2 "lop")
+  (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 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)))))
-
-(test osc-t10
+               #(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)))))
+  (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
@@ -245,13 +242,33 @@
 
 ;; 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))))))
+  "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))))))
+
+;; 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."
@@ -261,7 +278,19 @@
 ;;         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)
 
 #|
@@ -281,4 +310,4 @@ sc3 server
 
 |#
 
-;; (run! 'osc-test-suite)
+(run! 'synchroscope)
diff --git a/osc.asd b/osc.asd
@@ -1,18 +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"
+  :author "nik gaffney <nik@fo.am>"
+  :depends-on ("ieee-floats")
   :version "0.9.1"
-  :components ((:file "osc")))
+  :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
-(asdf:defsystem "osc/tests"
+(defsystem "osc/tests"
+  :description "Tests for OSC library."
   :depends-on ("osc" "fiveam")
   :components ((:file "osc-tests"))
   :perform (test-op (o c)
-                    (symbol-call :fiveam '#:run! :osc-test-suite)))
+                    (uiop:symbol-call :fiveam '#:run! :synchroscope)))