microscale

reduce size. return to the core. #18

.github/workflows/ci.yaml

@@ -17,7 +17,7 @@ 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, ccl-bin/1.12]
+        lisp: [sbcl-bin]
         os: [ windows-latest, ubuntu-latest, macos-latest]
 
     # run the job on every combination of "lisp" and "os" above

osc-tests.lisp

@@ -9,7 +9,7 @@
 ;; Authors
 ;;  - nik gaffney <nik@fo.am>
 
-#+sbcl (require 'sb-bsd-sockets)
+(require "usocket")
 
 (defun osc-write ()
   "a basic test function which sends various osc stuff on port 5555"
@@ -55,10 +55,13 @@
 ;;  - error catching, junk data
 
 (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-t2) (osc-t3) (osc-t4)
-   (osc-t10) (osc-t11) (osc-t12) (osc-t13)
+           (osc-t5) (osc-t6) (osc-t7)
-   ))
+           (osc-t8) (osc-t9) (osc-t10)
+           (osc-t11) (osc-t12) (osc-t13)))
+  T)
 
 (defun osc-t2 ()
   (equalp '("/dip/lop" 666)
@@ -146,8 +149,8 @@
 
 
 
-(defun osc-read (port)
+#+sbcl (defun osc-read (port)
-  "a basic test function which attempts to decode osc stuff on port xc"
+  "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")))
@@ -159,7 +162,7 @@
     (osc:decode-message buffer)
     ))
 
-                                        ;(osc-decode-message data)
+;;(osc-decode-message data)
 
 (defun osc-ft ()
   (and (eql (osc::DECODE-FLOAT32 #(63 84 32 93))  0.8286188)
@@ -189,9 +192,6 @@
   (setf cons-msg (osc:decode-message packed-msg))
   (osc:encode-message (values-list cons-msg)))
 
-;;
-
-
 #|
 sc3 server
 
@@ -209,4 +209,5 @@ sc3 server
 
 |#
 
-;; (osc-test)
+(defun run-tests ()
+  (osc-test))

osc.asd

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

osc.lisp

@@ -1,19 +1,17 @@
 ;;; -*- mode: lisp -*-
 ;;;
-;;; an implementation of the OSC (Open Sound Control) protocol
+;;; An implementation of the OSC (Open Sound Control) protocol
 ;;;
-;;; copyright (C) 2004 FoAM vzw. 
+;;; Copyright (c) 2004 FoAM
 ;;;
-;;; You are granted the rights to distribute and use this software
+;;; cl-osc is free software: you can redistribute it and/or modify it
-;;; under the terms of the Lisp Lesser GNU Public License, known 
+;;; under the terms of the GNU General Public License as published by
-;;; as the LLGPL. The LLGPL consists of a preamble and the LGPL. 
+;;; the Free Software Foundation, either version 3 of the License, or
-;;; Where these conflict, the preamble takes precedence. The LLGPL
+;;; (at your option) any later version.
-;;; is available online at http://opensource.franz.com/preamble.html 
-;;; and is distributed with this code (see: LICENCE and LGPL files)
 ;;;
 ;;; authors
 ;;;
-;;;  nik gaffney <nik@f0.am>
+;;;  nik gaffney <nik@fo.am> and the listed AUTHORS
 ;;;
 ;;; requirements
 ;;;
@@ -23,34 +21,30 @@
 ;;; commentary
 ;;;
 ;;;  this is a partial implementation of the OSC protocol which is used
-;;;  for communication mostly amongst music programs and their attatched
+;;;  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/
 ;;;
-;;;   - doesnt send nested bundles or timetags later than 'now' 
-;;;   - malformed input -> exception
-;;;   - int32 en/de-coding based on code (c) Walter C. Pelissero
-;;;   - unknown types are sent as 'blobs' which may or may not be an issue
 ;;;
 ;;;  see the README file for more details...
 ;;;
-;;; known BUGS
+;;;  known BUGS/Issues
-;;;   - encoding a :symbol which is unbound, or has no symbol-value will cause
+;;;   - encoding a :symbol that is unbound or without symbol-value causes an error
-;;;     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")
-  (:export :encode-message
+  (:export
-	   :encode-bundle
+   #:encode-message
-	   :decode-message
+   #:encode-bundle
-	   :decode-bundle))
+   #:decode-message
+   #:decode-bundle))
 
 (in-package :osc)
- 
+;; (declaim (optimize (speed 3) (safety 1) (debug 3)))
-;(declaim (optimize (speed 3) (safety 1) (debug 3)))
 
 ;;;;;; ;    ;;    ;     ; ;     ; ; ;         ;
 ;;
@@ -86,8 +80,8 @@
        (string-padding address)))
 
 (defun encode-typetags (data)
-  "creates a typetag string suitable for the given data.
+  "Create a typetag string suitable for the given DATA.
-  valid typetags according to the osc spec are ,i ,f ,s and ,b
+  valid typetags according to the OSC spec are ,i ,f ,s and ,b
   non-std extensions include ,{h|t|d|S|c|r|m|T|F|N|I|[|]}
                              see the spec for more details. ..
 
@@ -115,7 +109,7 @@
          (pad (padding-length (length lump))))))
 
 (defun encode-data (data)
-  "encodes data in a format suitable for an OSC message"
+  "Encode DATA in a format suitable for an OSC message."
   (let ((lump (make-array 0 :adjustable t :fill-pointer t)))
     (macrolet ((enc (f)
                  `(setf lump (cat lump (,f x)))))
@@ -135,10 +129,10 @@
 ;;; ;;    ;;     ; ;     ;      ;      ; ;
 
 (defun decode-bundle (data)
-  "decodes an osc bundle into a list of decoded-messages, which has
+  "Decode an OSC bundle into a list of decoded-messages.
-   an osc-timetagas its first element"
+ The first element is an osc-timetag."
   (let ((contents '()))
-    (if (equalp 35 (elt data 0))	; a bundle begins with '#'
+    (if (equalp 35 (elt data 0)) ;; a bundle begins with '#'
         (let ((timetag (subseq data 8 16))
               (i 16)
               (bundle-length (length data)))
@@ -156,11 +150,11 @@
         (decode-message data))))
 
 (defun decode-message (message)
-  "reduces an osc message to an (address . data) pair. .." 
+  "Reduce an OSC MESSAGE to an (address . data) pair."
   (declare (type (vector *) message))
   (let ((x (position (char-code #\,) message)))
     (if (eq x NIL)
-        (format t "message contains no data.. ")
+        (format t "Message contains no data.. ")
         (cons (decode-address (subseq message 0 x))
               (decode-taged-data (subseq message x))))))
 
@@ -170,7 +164,7 @@
           'string))
 
 (defun decode-taged-data (data)
-  "decodes data encoded with typetags...
+  "Decode DATA encoded with typetags.
   NOTE: currently handles the following tags
    i => #(105) => int32
    f => #(102) => float
@@ -206,7 +200,8 @@
                  ((eq x (char-code #\b))
                   (let* ((size (decode-int32 (subseq acc 0 4)))
                          (bl (+ 4 size))
-                        (end (+ bl (mod (- 4 bl) 4)))) ; NOTE: cannot use (padded-length bl), as it is not the same algorithm. Blobs of 4, 8, 12 etc bytes should not be padded!
+                         (end (+ bl (mod (- 4 bl) 4))))
+                    ;; NOTE: cannot use (padded-length bl), as it is not the same algorithm. Blobs of 4, 8, 12 etc bytes should not be padded!
                     (push (decode-blob (subseq acc 0 end))
                           result)
                     (setf acc (subseq acc end))))
@@ -217,15 +212,15 @@
 
 ;;;;;; ;; ;; ; ; ;  ;  ; ;;     ;
 ;;
-;; timetags
+;; Timetags
 ;;
 ;; - timetags can be encoded using a value, or the :now and :time keywords. the
 ;;   keywords enable either a tag indicating 'immediate' execution, or
 ;;   a tag containing the current time (which will most likely be in the past
-;;   of anyt receiver) to be created.
+;;   of any receiver) to be created.
 ;;
 ;; - note: not well tested, and probably not accurate enough for syncronisation.
-;;   see also: CLHS 25.1.4 Time, and the ntp timestamp format. also needs to
+;;   see also: CLHS 25.1.4 Time, and the NTP timestamp format. also needs to
 ;;   convert from 2 32bit ints to 64bit fixed point value.
 ;;
 ;; - see this c.l.l thread to sync universal-time and internal-time
@@ -236,15 +231,15 @@
 (defconstant +unix-epoch+ (encode-universal-time 0 0 0 1 1 1970 0))
 
 (defun encode-timetag (utime &optional subseconds)
-  "encodes an osc timetag from a universal-time and 32bit 'sub-second' part.
+  "Encode an OSC timetag from a universal-time and 32bit 'sub-second' part.
    for an 'instantaneous' timetag use (encode-timetag :now)
    for a timetag with the current time use (encode-timetag :time)"
   (cond
-    ;; a 1bit timetag will be interpreted as 'imediately' 
+    ;; a timetag of 1 will be interpreted as 'immediately'
     ((equalp utime :now)
      #(0 0 0 0 0 0 0 1))
     ;; converts seconds since 19000101 to seconds since 19700101
-    ;; note: fractions of a second is accurate, but not syncronised.
+    ;; note: fractions of seconds are accurate, but not synchronised.
     ((equalp utime :time)
      (cat (encode-int32 (- (get-universal-time) +unix-epoch+))
           (encode-int32
@@ -255,10 +250,10 @@
     ((integerp utime)
      (cat (encode-int32 (+ utime +unix-epoch+))
           (encode-int32 subseconds)))
-    (t (error "the time or subsecond given is not an integer"))))
+    (t (error "The time or subsecond given is not an integer."))))
 
 (defun decode-timetag (timetag)
-  "decomposes a timetag into unix-time and a subsecond,. . ."
+  "Decompose a TIMETAG into unix-time and subsecond."
   (list
    (decode-int32 (subseq timetag 0 4))
    (decode-int32 (subseq timetag 4 8))))
@@ -271,25 +266,25 @@
 ;;; ;; ;   ;  ;
 
 ;; floats are encoded using implementation specific 'internals' which is not
-;; particulaly portable, but 'works for now'. 
+;; particularly portable, but 'works for now'.
 
 (defun encode-float32 (f)
-  "encode an ieee754 float as a 4 byte vector. currently sbcl/cmucl specifc"
+  "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 "cant encode floats using this implementation"))
+  #-(or sbcl cmucl openmcl allegro) (error "Can't encode floats using this implementation."))
 
 (defun decode-float32 (s)
-  "ieee754 float from a vector of 4 bytes in network byte order"
+  "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 "cant decode floats using this implementation"))
+  #-(or sbcl cmucl openmcl allegro) (error "Can't decode floats using this implementation."))
 
 (defmacro defint-decoder (num-of-octets &optional docstring)
   (let ((decoder-name (intern (format nil "~:@(decode-uint~)~D" (* 8 num-of-octets))))
@@ -343,11 +338,11 @@
 ;; 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"
+  "Convert a binary vector to a string and remove any trailing #\nul characters."
   (string-trim '(#\nul) (coerce (map 'vector #'code-char data) 'string)))
 
 (defun encode-string (string)
-  "encodes a string as a vector of character-codes, padded to 4 byte boundary"
+  "Encode a STRING as a vector of character-codes padded to 4 byte boundary."
   (cat (map 'vector #'char-code string)
        (string-padding string)))
 
@@ -355,41 +350,43 @@
 ;; osc-padded to a 4 byte boundary.
 
 (defun decode-blob (blob)
-  "decode a blob as a vector of unsigned bytes."
+  "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"
+  "Encode BLOB as a vector."
   (let ((bl (length blob)))
     (cat (encode-int32 bl) blob
-	 (pad (mod (- 4 bl) 4))))) ; NOTE: cannot use (padding-length bl), as it is not the same algorithm. Blobs of 4, 8, 12 etc bytes should not be padded!
+         (pad (mod (- 4 bl) 4)))))
+;; NOTE: cannot use (padding-length bl), as it is not the same algorithm. Blobs of 4, 8, 12 etc bytes should not be padded!
 
-;; utility functions for osc-string/padding slonking
+;; utility functions for osc-string/padding/slonking
 
 (defun cat (&rest catatac)
   (apply #'concatenate '(vector *) catatac))
 
 (defun padding-length (s)
-  "returns the length of padding required for a given length of string"
+  "Return the length of padding required for a given length of string."
   (declare (type fixnum s))
   (- 4 (mod s 4)))
 
 (defun padded-length (s)
-  "returns the length of an osc-string made from a given length of string"
+  "Return 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"
+  "Return the padding required for a given osc string."
   (declare (type simple-string string))
   (pad (padding-length (length string))))
 
 (defun pad (n)
-  "make a sequence of the required number of #\Nul characters"
+  "Make a sequence of the required number of #\Nul characters."
   (declare (type fixnum n))
   (make-array n :initial-element 0 :fill-pointer n))
 
 (provide :osc)
+
 ;; end