pseudoscholastic
darcs-hash:20050306124728-2648a-e3eb0f8e6157cd343a9b7b7fe114b5894ceb5cf7.gz
This commit is contained in:
parent
c22a4e1389
commit
271545fbad
1 changed files with 27 additions and 26 deletions
53
osc.lisp
53
osc.lisp
|
@ -17,7 +17,7 @@
|
|||
;;
|
||||
;; requirements
|
||||
;;
|
||||
;; dependent on sbcl for float encoding, other suggestions welcome.
|
||||
;; dependent on sbcl or cmucl for float encoding, other suggestions welcome.
|
||||
;;
|
||||
;; commentary
|
||||
;;
|
||||
|
@ -57,6 +57,8 @@
|
|||
;; - in-package'd
|
||||
;; 2005-03-01
|
||||
;; - fixed address string bug
|
||||
;; 2005-0305
|
||||
;; - 'declare' scattering and other optimisations
|
||||
|
||||
(defpackage :osc
|
||||
(:use :cl)
|
||||
|
@ -66,7 +68,7 @@
|
|||
|
||||
(in-package :osc)
|
||||
|
||||
(declaim (optimize (speed 2) (safety 1)))
|
||||
(declaim (optimize (speed 3) (safety 1)))
|
||||
|
||||
;;;;;; ; ;; ; ; ; ; ; ; ;
|
||||
;;
|
||||
|
@ -112,7 +114,6 @@
|
|||
(cat lump
|
||||
(pad (padding-length (length lump)))))))
|
||||
|
||||
|
||||
(defun encode-data (data)
|
||||
"encodes data in a format suitable for an OSC message"
|
||||
(let ((lump (make-array 0 :adjustable t :fill-pointer t)))
|
||||
|
@ -127,7 +128,6 @@
|
|||
lump)))
|
||||
|
||||
|
||||
|
||||
;;;;;; ; ;; ; ; ; ; ; ; ;
|
||||
;;
|
||||
;; decoding OSC messages
|
||||
|
@ -164,23 +164,23 @@
|
|||
(map 'vector
|
||||
#'(lambda (x)
|
||||
(cond
|
||||
((eq x (char-code #\i))
|
||||
(push (decode-int32 (subseq acc 0 4))
|
||||
result)
|
||||
(setf acc (subseq acc 4)))
|
||||
((eq x (char-code #\f))
|
||||
(push (decode-float32 (subseq acc 0 4))
|
||||
result)
|
||||
(setf acc (subseq acc 4)))
|
||||
((eq x (char-code #\s))
|
||||
(let ((pointer (+ (padding-length (position 0 acc))
|
||||
(position 0 acc))))
|
||||
(push (decode-string
|
||||
(subseq acc 0 pointer))
|
||||
result)
|
||||
(setf acc (subseq acc pointer))))
|
||||
((eq x (char-code #\b)) (decode-blob x))
|
||||
(t (error "unrecognised typetag"))))
|
||||
((eq x (char-code #\i))
|
||||
(push (decode-int32 (subseq acc 0 4))
|
||||
result)
|
||||
(setf acc (subseq acc 4)))
|
||||
((eq x (char-code #\f))
|
||||
(push (decode-float32 (subseq acc 0 4))
|
||||
result)
|
||||
(setf acc (subseq acc 4)))
|
||||
((eq x (char-code #\s))
|
||||
(let ((pointer (+ (padding-length (position 0 acc))
|
||||
(position 0 acc))))
|
||||
(push (decode-string
|
||||
(subseq acc 0 pointer))
|
||||
result)
|
||||
(setf acc (subseq acc pointer))))
|
||||
((eq x (char-code #\b)) (decode-blob x))
|
||||
(t (error "unrecognised typetag"))))
|
||||
tags)
|
||||
(nreverse result)))
|
||||
|
||||
|
@ -204,7 +204,7 @@
|
|||
#-(or sbcl cmucl) (error "cant decode floats using this implementation"))
|
||||
|
||||
(defun decode-int32 (s)
|
||||
(declare (type (simple-array integer) s))
|
||||
(declare (type (simple-array integer) s))
|
||||
"4 byte > 32 bit int > two's compliment (in network byte order)"
|
||||
(let ((i (+ (ash (elt s 0) 24)
|
||||
(ash (elt s 1) 16)
|
||||
|
@ -212,7 +212,7 @@
|
|||
(elt s 3))))
|
||||
(if (>= i #x7fffffff)
|
||||
(- 0 (- #x100000000 i))
|
||||
i)))
|
||||
i)))
|
||||
|
||||
(defun encode-int32 (i)
|
||||
"convert integer into a sequence of 4 bytes in network byte order."
|
||||
|
@ -220,8 +220,8 @@
|
|||
(let ((buf (make-sequence
|
||||
'(vector (unsigned-byte 8)) 4)))
|
||||
(macrolet ((set-byte (n)
|
||||
`(setf (elt buf ,n)
|
||||
(logand #xff (ash i ,(* 8 (- n 3)))))))
|
||||
`(setf (elt buf ,n)
|
||||
(logand #xff (ash i ,(* 8 (- n 3)))))))
|
||||
(set-byte 0)
|
||||
(set-byte 1)
|
||||
(set-byte 2)
|
||||
|
@ -253,8 +253,9 @@
|
|||
|
||||
(defun osc-string-length (string)
|
||||
"determines the length required for a padded osc string"
|
||||
(declare (type simple-string string))
|
||||
(declare (type simple-string string))
|
||||
(let ((n (length string)))
|
||||
(declare (type fixnum n))
|
||||
(+ n (padding-length n))))
|
||||
|
||||
(defun padding-length (s)
|
||||
|
|
Loading…
Reference in a new issue