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:
parent
73f33aac45
commit
5b98b79ee7
5 changed files with 47 additions and 30 deletions
|
@ -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)
|
||||||
|
|
|
@ -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)))))))
|
||||||
|
|
|
@ -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
|
||||||
|
|
2
osc.asd
2
osc.asd
|
@ -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")))
|
||||||
|
|
62
osc.lisp
62
osc.lisp
|
@ -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.
|
||||||
|
|
Loading…
Reference in a new issue