From ec7bbbe3eceab1484858cc5db34c75d42917ba4f Mon Sep 17 00:00:00 2001
From: nik gaffney <nik@fo.am>
Date: Mon, 26 Feb 2007 23:20:53 +0800
Subject: [PATCH] isosceles

encode-int32 and decode-int32 should work for allegro, using a patch from Vincent Akkermans.

darcs-hash:20070226152053-2648a-ebccfc38619ab82bb8572b66e69d95dd12d658a3.gz
---
 README.txt |  3 +++
 osc.asd    |  2 +-
 osc.lisp   | 16 +++++++++++-----
 3 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/README.txt b/README.txt
index f96c4fe..8713019 100644
--- a/README.txt
+++ b/README.txt
@@ -40,6 +40,9 @@ things to do in :osc-ex[tensions|tras]
 
 
 changes
+  2007-02-20
+     - version 0.5
+     - Allegro CL float en/decoding from vincent akkermans <vincent.akkermans@gmail.com> 
   2006-02-11
      - version 0.4
      - partial timetag implemetation 
diff --git a/osc.asd b/osc.asd
index 87b0626..5c187aa 100644
--- a/osc.asd
+++ b/osc.asd
@@ -7,5 +7,5 @@
     :author "nik gaffney <nik@fo.am>"
     :licence "LLGPL"
     :description "The Open Sound Control protocol, aka OSC"
-    :version "0.4"
+    :version "0.5"
     :components ((:file "osc")))
diff --git a/osc.lisp b/osc.lisp
index d3f2063..cf7cab5 100644
--- a/osc.lisp
+++ b/osc.lisp
@@ -221,6 +221,9 @@
 ;;   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
+;;   http://groups.google.com/group/comp.lang.lisp/browse_thread/thread/c207fef63a78d720/adc7442d2e4de5a0?lnk=gst&q=internal-real-time-sync&rnum=1#adc7442d2e4de5a0
+;;
 ;;;; ;; ; ; 
 
 (defconstant +unix-epoch+ (encode-universal-time 0 0 0 1 1 1970 0))
@@ -230,7 +233,7 @@
    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' 
+    ;; a 1bit timetag will be interpreted as 'imediately' 
     ((equalp utime :now)
      #(0 0 0 0 0 0 0 1)) 
     ;; converts seconds since 19000101 to seconds since 19700101
@@ -253,6 +256,7 @@
    (decode-int32 (subseq timetag 0 4))
    (decode-int32 (subseq timetag 4 8))))
 
+
 ;;;;; ; ; ;;    ;; ; ;
 ;;
 ;; dataformat en- de- cetera.
@@ -267,14 +271,18 @@
   #+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))
-  #-(or sbcl cmucl openmcl) (error "cant encode floats using this implementation"))
+  #+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"))
 
 (defun decode-float32 (s)
   "ieee754 float from a vector of 4 bytes in network byte order"
   #+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))
-  #-(or sbcl cmucl openmcl) (error "cant decode floats using this implementation"))
+  #+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"))
 
 (defun decode-int32 (s)
   "4 byte -> 32 bit int -> two's compliment (in network byte order)"
@@ -334,7 +342,6 @@
     (cat (encode-int32 bl) blob
 	 (pad (padding-length bl)))))      
 
-
 ;; utility functions for osc-string/padding slonking
 
 (defun cat (&rest catatac)
@@ -360,6 +367,5 @@
   (declare (type fixnum n))
   (make-array n :initial-element 0 :fill-pointer n))
 
-
 (provide :osc)
 ;; end