From 5b98b79ee7129d43144ff9d0350c8da22c4f2070 Mon Sep 17 00:00:00 2001 From: nik gaffney Date: Sat, 11 Feb 2006 07:38:40 +0800 Subject: [PATCH] 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 --- README.txt | 5 +++- osc-dispatch.lisp | 1 + osc-examples.lisp | 5 ++-- osc.asd | 2 +- osc.lisp | 64 +++++++++++++++++++++++++++++------------------ 5 files changed, 47 insertions(+), 30 deletions(-) diff --git a/README.txt b/README.txt index 64132f4..dfd21c8 100644 --- a/README.txt +++ b/README.txt @@ -30,7 +30,7 @@ limitations - only supports the type(tag)s specified in the OSC spec things to do in :osc - - address patterns + - address patterns using pcre - data checking and error handling - portable en/decoding of floats -=> ieee754 tests - doubles and other defacto typetags @@ -42,6 +42,9 @@ things to do in :osc-ex[tensions|tras] changes + 2006-02-11 + - version 0.4 + - partial timetag implemetation 2005-12-05 - version 0.3 - fixed openmcl float bug (decode-uint32) diff --git a/osc-dispatch.lisp b/osc-dispatch.lisp index 8fa3bf4..45ed357 100644 --- a/osc-dispatch.lisp +++ b/osc-dispatch.lisp @@ -68,4 +68,5 @@ (let ((pattern (car osc-message))) (dolist (x (dp-match tree pattern)) (unless (eq x NIL) + ;; (apply #'x '() (cdr osc-message)) (eval `(,x ,@(cdr osc-message))))))) diff --git a/osc-examples.lisp b/osc-examples.lisp index da540b3..80505b3 100644 --- a/osc-examples.lisp +++ b/osc-examples.lisp @@ -13,9 +13,8 @@ ;; ;; Commentry ;; -;; These examples are currently sbcl specific [as is the float code], -;; but should be easily modifyable to work with trivial-sockets, or -;; something similar for portablity. these examples should still be +;; These examples are currently sbcl specific, but should be easily ported to +;; work with trivial-sockets, acl-compat or something similar. They should be ;; able to explain enough to get you started. .. ;; ;; eg. listen on port 6667 for incoming msgs diff --git a/osc.asd b/osc.asd index c850ef6..87b0626 100644 --- a/osc.asd +++ b/osc.asd @@ -7,5 +7,5 @@ :author "nik gaffney " :licence "LLGPL" :description "The Open Sound Control protocol, aka OSC" - :version "0.3" + :version "0.4" :components ((:file "osc"))) diff --git a/osc.lisp b/osc.lisp index e1ce391..cc43009 100644 --- a/osc.lisp +++ b/osc.lisp @@ -36,8 +36,9 @@ ;;; see the README file for more details... ;;; ;;; known BUGS -;;; - only unknown for now.. . - +;;; - encoding a :symbol which is unbound, or has no symbol-value will cause +;;; an error +;;; (defpackage :osc (:use :cl) @@ -49,7 +50,7 @@ (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) +(defun encode-bundle (data &optional timetag) "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 - (encode-timetag :now) + (if timetag + (encode-timetag timetag) + (encode-timetag :now)) (if (listp (car data)) (apply #'cat (mapcar #'encode-bundle-elt data)) (encode-bundle-elt data)))) @@ -123,7 +126,6 @@ (t (enc encode-blob)))) lump))) - ;;;;;; ; ;; ; ; ; ; ; ; ; ;; @@ -131,7 +133,6 @@ ;; ;;; ;; ;; ; ; ; ; ; ; - (defun decode-bundle (data) "decodes an osc bundle into a list of decoded-messages, which has an osc-timetagas its first element" @@ -202,7 +203,7 @@ (push (decode-blob (subseq acc 0 end)) result) (setf acc (subseq acc end)))) - (t (error "unrecognised typetag")))) + (t (error "unrecognised typetag")))) tags) (nreverse result)))) @@ -211,33 +212,46 @@ ;; ;; timetags ;; -;; - not yet, but probably something using -;; (get-universal-time) > see also: CLHS 25.1.4 Time -;; or connecting to an ntp server.,. - ntpdate, ntpq +;; - 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. ;; -;; - begin with bundles using 'now' as the timetag -;; - this should really handle 64bit fixed ints, -;; not signed 32bit ints +;; - 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 +;; convert from 2 32bit ints to 64bit fixed point value. ;; ;;;; ;; ; ; (defconstant +unix-epoch+ (encode-universal-time 0 0 0 1 1 1970 0)) -(defun encode-timetag (ut &optional subseconds) - "encodes an osc timetag from a universal-time and 32bit 'sub-second' part - for an 'instantaneous' timetag use (encode-timetag :now) " - (if (equalp ut :now) - #(0 0 0 0 0 0 0 1) - (cat (encode-int32 (+ ut +unix-epoch+)) - (encode-int32 subseconds)))) +(defun encode-timetag (utime &optional subseconds) + "encodes 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 'imediatly' + ((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) - "decomposes a timetag into ut and a subsecond,. . ." + "decomposes a timetag into unix-time and a subsecond,. . ." (list (decode-int32 (subseq timetag 0 4)) (decode-int32 (subseq timetag 4 8)))) - ;;;;; ; ; ;; ;; ; ; ;; ;; dataformat en- de- cetera.