aproscapula

extended timetag support, including a first attempt at using (get-universal-time)
for timestamping. still not ntp compatible.

darcs-hash:20060210233840-2648a-b16d4ceb60e9ed6d0a18b8b4ed051ebaf7336752.gz
This commit is contained in:
nik gaffney 2006-02-11 07:38:40 +08:00
parent 73f33aac45
commit 5b98b79ee7
5 changed files with 47 additions and 30 deletions

View file

@ -30,7 +30,7 @@ limitations
- only supports the type(tag)s specified in the OSC spec - only supports the type(tag)s specified in the OSC spec
things to do in :osc things to do in :osc
- address patterns - address patterns using pcre
- data checking and error handling - data checking and error handling
- portable en/decoding of floats -=> ieee754 tests - portable en/decoding of floats -=> ieee754 tests
- doubles and other defacto typetags - doubles and other defacto typetags
@ -42,6 +42,9 @@ things to do in :osc-ex[tensions|tras]
changes changes
2006-02-11
- version 0.4
- partial timetag implemetation
2005-12-05 2005-12-05
- version 0.3 - version 0.3
- fixed openmcl float bug (decode-uint32) - fixed openmcl float bug (decode-uint32)

View file

@ -68,4 +68,5 @@
(let ((pattern (car osc-message))) (let ((pattern (car osc-message)))
(dolist (x (dp-match tree pattern)) (dolist (x (dp-match tree pattern))
(unless (eq x NIL) (unless (eq x NIL)
;; (apply #'x '() (cdr osc-message))
(eval `(,x ,@(cdr osc-message))))))) (eval `(,x ,@(cdr osc-message)))))))

View file

@ -13,9 +13,8 @@
;; ;;
;; Commentry ;; Commentry
;; ;;
;; These examples are currently sbcl specific [as is the float code], ;; These examples are currently sbcl specific, but should be easily ported to
;; but should be easily modifyable to work with trivial-sockets, or ;; work with trivial-sockets, acl-compat or something similar. They should be
;; something similar for portablity. these examples should still be
;; able to explain enough to get you started. .. ;; able to explain enough to get you started. ..
;; ;;
;; eg. listen on port 6667 for incoming msgs ;; eg. listen on port 6667 for incoming msgs

View file

@ -7,5 +7,5 @@
:author "nik gaffney <nik@fo.am>" :author "nik gaffney <nik@fo.am>"
:licence "LLGPL" :licence "LLGPL"
:description "The Open Sound Control protocol, aka OSC" :description "The Open Sound Control protocol, aka OSC"
:version "0.3" :version "0.4"
:components ((:file "osc"))) :components ((:file "osc")))

View file

@ -36,8 +36,9 @@
;;; see the README file for more details... ;;; see the README file for more details...
;;; ;;;
;;; known BUGS ;;; known BUGS
;;; - only unknown for now.. . ;;; - encoding a :symbol which is unbound, or has no symbol-value will cause
;;; an error
;;;
(defpackage :osc (defpackage :osc
(:use :cl) (:use :cl)
@ -49,7 +50,7 @@
(in-package :osc) (in-package :osc)
;(declaim (optimize (speed 3) (safety 1))) ;(declaim (optimize (speed 3) (safety 1) (debug 3)))
;;;;;; ; ;; ; ; ; ; ; ; ; ;;;;;; ; ;; ; ; ; ; ; ; ;
;; ;;
@ -57,12 +58,14 @@
;; ;;
;;;; ;; ;; ; ; ;; ; ; ; ; ;;;; ;; ;; ; ; ;; ; ; ; ;
(defun encode-bundle (data &optional timetag)
(defun encode-bundle (data)
"will encode an osc message, or list of messages as a bundle "will encode an osc message, or list of messages as a bundle
with an optional timetag. doesnt handle nested bundles" with an optional timetag (symbol or 64bit int).
doesnt handle nested bundles"
(cat '(35 98 117 110 100 108 101 0) ; #bundle (cat '(35 98 117 110 100 108 101 0) ; #bundle
(encode-timetag :now) (if timetag
(encode-timetag timetag)
(encode-timetag :now))
(if (listp (car data)) (if (listp (car data))
(apply #'cat (mapcar #'encode-bundle-elt data)) (apply #'cat (mapcar #'encode-bundle-elt data))
(encode-bundle-elt data)))) (encode-bundle-elt data))))
@ -124,14 +127,12 @@
lump))) lump)))
;;;;;; ; ;; ; ; ; ; ; ; ; ;;;;;; ; ;; ; ; ; ; ; ; ;
;; ;;
;; decoding OSC messages ;; decoding OSC messages
;; ;;
;;; ;; ;; ; ; ; ; ; ; ;;; ;; ;; ; ; ; ; ; ;
(defun decode-bundle (data) (defun decode-bundle (data)
"decodes an osc bundle into a list of decoded-messages, which has "decodes an osc bundle into a list of decoded-messages, which has
an osc-timetagas its first element" an osc-timetagas its first element"
@ -211,33 +212,46 @@
;; ;;
;; timetags ;; timetags
;; ;;
;; - not yet, but probably something using ;; - timetags can be encoded using a value, or the :now and :time keywords. the
;; (get-universal-time) > see also: CLHS 25.1.4 Time ;; keywords enable either a tag indicating 'immediate' execution, or
;; or connecting to an ntp server.,. - ntpdate, ntpq ;; a tag containing the current time (which will most likely be in the past
;; of anyt receiver) to be created.
;; ;;
;; - begin with bundles using 'now' as the timetag ;; - note: not well tested, and probably not accurate enough for syncronisation.
;; - this should really handle 64bit fixed ints, ;; see also: CLHS 25.1.4 Time, and the ntp timestamp format. also needs to
;; not signed 32bit ints ;; convert from 2 32bit ints to 64bit fixed point value.
;; ;;
;;;; ;; ; ; ;;;; ;; ; ;
(defconstant +unix-epoch+ (encode-universal-time 0 0 0 1 1 1970 0)) (defconstant +unix-epoch+ (encode-universal-time 0 0 0 1 1 1970 0))
(defun encode-timetag (ut &optional subseconds) (defun encode-timetag (utime &optional subseconds)
"encodes an osc timetag from a universal-time and 32bit 'sub-second' part "encodes an osc timetag from a universal-time and 32bit 'sub-second' part.
for an 'instantaneous' timetag use (encode-timetag :now) " for an 'instantaneous' timetag use (encode-timetag :now)
(if (equalp ut :now) for a timetag with the current time use (encode-timetag :time)"
#(0 0 0 0 0 0 0 1) (cond
(cat (encode-int32 (+ ut +unix-epoch+)) ;; a 1bit timetag will be interpreted as 'imediatly'
(encode-int32 subseconds)))) ((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.
((equalp utime :time)
(cat (encode-int32 (- (get-universal-time) +unix-epoch+))
(encode-int32
(round (* 1000 (second (multiple-value-list
(floor (/ (get-internal-real-time)
internal-time-units-per-second)))))))))
((integerp utime)
(cat (encode-int32 (+ utime +unix-epoch+))
(encode-int32 subseconds)))
(t (error "the time or subsecond given is not an integer"))))
(defun decode-timetag (timetag) (defun decode-timetag (timetag)
"decomposes a timetag into ut and a subsecond,. . ." "decomposes a timetag into unix-time and a subsecond,. . ."
(list (list
(decode-int32 (subseq timetag 0 4)) (decode-int32 (subseq timetag 0 4))
(decode-int32 (subseq timetag 4 8)))) (decode-int32 (subseq timetag 4 8))))
;;;;; ; ; ;; ;; ; ; ;;;;; ; ; ;; ;; ; ;
;; ;;
;; dataformat en- de- cetera. ;; dataformat en- de- cetera.