zzkt/osc
1
0
Fork 0
Code Issues 7 Pull requests Projects Releases Activity Actions

pseudoscholastic

Browse source 
darcs-hash:20050306124728-2648a-e3eb0f8e6157cd343a9b7b7fe114b5894ceb5cf7.gz
This commit is contained in:
nik gaffney 2005-03-06 20:47:28 +08:00
parent c22a4e1389
commit 271545fbad
1 changed files with 27 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
osc.lisp
View file

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