roscoelite

A green micaceous mineral occurring in minute scales. Various 'declares' for speed, safety and cluttering. Small bug fixes and optimi[sz]ations.

darcs-hash:20050306122501-2648a-2a2946d523deea88f35d8c262352c1cfd65ef222.gz
This commit is contained in:
nik gaffney 2005-03-06 20:25:01 +08:00
parent 02bf197a6a
commit c22a4e1389
2 changed files with 39 additions and 29 deletions

View file

@ -34,11 +34,17 @@
(in-package :osc) (in-package :osc)
;; should probably be a clos object, and instantiated ;; should probably be a clos object, and instantiated
(defun osc-tree () ;; for now, a hash table is enuf.
(defun make-osc-tree ()
(make-hash-table :test 'equalp)) (make-hash-table :test 'equalp))
;; lookout for leaky abstract trees.. ,
;; how should this be better encapsulatd?? ;;; ;; ;;;;;; ; ; ; ;
;;
;; register/delete and dispatch. ..
;;
;;;; ; ; ; ;;
(defun dp-register (tree address function) (defun dp-register (tree address function)
"registers a function to respond to incoming osc message. since "registers a function to respond to incoming osc message. since
@ -48,7 +54,7 @@
function)) function))
(defun dp-remove (tree address) (defun dp-remove (tree address)
"removes the function associated with the given adress.." "removes the function associated with the given address.."
(remhash address tree)) (remhash address tree))
(defun dp-match (tree pattern) (defun dp-match (tree pattern)
@ -59,7 +65,7 @@
(defun dispatch (tree osc-message) (defun dispatch (tree osc-message)
"calls the function(s) matching the address(pattern) in the osc "calls the function(s) matching the address(pattern) in the osc
message with the data contained in the message" message with the data contained in the message"
(dolist (x (dp-match tree (let ((pattern (car osc-message)))
(car osc-message))) (dolist (x (dp-match tree pattern))
(unless (eq x NIL) (unless (eq x NIL)
(eval `(,x ,@(cdr osc-message)))))) (eval `(,x ,@(cdr osc-message)))))))

View file

@ -65,6 +65,8 @@
:decode-message)) :decode-message))
(in-package :osc) (in-package :osc)
(declaim (optimize (speed 2) (safety 1)))
;;;;;; ; ;; ; ; ; ; ; ; ; ;;;;;; ; ;; ; ; ; ; ; ; ;
;; ;;
@ -74,7 +76,7 @@
(defun encode-message (address &rest data) (defun encode-message (address &rest data)
"encodes an osc message with the given address and data." "encodes an osc message with the given address and data."
(concatenate '(vector '(unsigned-byte 8)) (concatenate '(vector (unsigned-byte 8))
(encode-address address) (encode-address address)
(encode-typetags data) (encode-typetags data)
(encode-data data))) (encode-data data)))
@ -94,7 +96,9 @@
f => #(102) => float f => #(102) => float
s => #(115) => string" s => #(115) => string"
(let ((lump (make-array 0 :adjustable t :fill-pointer t))) (let ((lump (make-array 0 :adjustable t
:fill-pointer t
:element-type 'char)))
(macrolet ((write-to-vector (char) (macrolet ((write-to-vector (char)
`(vector-push-extend `(vector-push-extend
(char-code ,char) lump))) (char-code ,char) lump)))
@ -108,6 +112,7 @@
(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)))
@ -121,9 +126,6 @@
(t (error "wrong type. turn back")))) (t (error "wrong type. turn back"))))
lump))) lump)))
(defun encode-string (string)
(cat (map 'vector #'char-code string)
(pad-string string)))
;;;;;; ; ;; ; ; ; ; ; ; ; ;;;;;; ; ;; ; ; ; ; ; ; ;
@ -134,19 +136,20 @@
(defun decode-message (message) (defun decode-message (message)
"reduces an osc message to an (address . data) pair. .." "reduces an osc message to an (address . data) pair. .."
(declare (type (vector *) message))
(let ((x (position (char-code #\,) message))) (let ((x (position (char-code #\,) message)))
(if (eq x NIL) (if (eq x NIL)
(format "message contains no data.. ") (format t "message contains no data.. ")
(cons (decode-address (subseq message 0 x)) (cons (decode-address (subseq message 0 x))
(decode-taged-data (subseq message x)))))) (decode-taged-data (subseq message x))))))
(defun decode-address (address) (defun decode-address (address)
(coerce (map 'vector #'code-char (delete 0 address)) (coerce (map 'vector #'code-char
'string)) (delete 0 address))
'string))
(defun decode-taged-data (data) (defun decode-taged-data (data)
"decodes data encoded with typetags... "decodes data encoded with typetags...
NOTE: currently handles the following tags only NOTE: currently handles the following tags only
i => #(105) => int32 i => #(105) => int32
f => #(102) => float f => #(102) => float
@ -181,13 +184,6 @@
tags) tags)
(nreverse result))) (nreverse result)))
(defun split-data (data)
"splits incoming data into the relevant unpadded chunks, ready for conversion .. ."
(loop for i = 0 then (1+ j)
as j = (position #\0 string :start i)
collect (subseq string i j)
while j))
;;;;; ; ; ;; ;; ; ; ;;;;; ; ; ;; ;; ; ;
;; ;;
@ -208,6 +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))
"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)
@ -219,17 +216,20 @@
(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."
(declare (type integer s)) (declare (type integer i n))
(let ((buf (make-sequence '(vector (unsigned-byte 8)) 4))) (let ((buf (make-sequence
'(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)
(set-byte 3)) (set-byte 3))
buf)) buf))
(defun decode-string (data) (defun decode-string (data)
"converts a binary vector to a string and removes trailing #\nul characters" "converts a binary vector to a string and removes trailing #\nul characters"
(string-trim '(#\nul) (coerce (map 'vector #'code-char data) 'string))) (string-trim '(#\nul) (coerce (map 'vector #'code-char data) 'string)))
@ -253,19 +253,23 @@
(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))
(let ((n (length string))) (let ((n (length string)))
(+ n (padding-length n)))) (+ n (padding-length n))))
(defun padding-length (s) (defun padding-length (s)
"returns the length of padding required for a given length of string" "returns the length of padding required for a given length of string"
(declare (type fixnum s))
(- 4 (mod s 4))) (- 4 (mod s 4)))
(defun pad-string (string) (defun pad-string (string)
"returns the padding required for a given osc string" "returns the padding required for a given osc string"
(declare (type simple-string string))
(pad (- 4 (mod (length string) 4)))) (pad (- 4 (mod (length string) 4))))
(defun pad (n) (defun pad (n)
"make a sequence of the required number of #\Nul characters" "make a sequence of the required number of #\Nul characters"
(declare (type fixnum n))
(make-array n :initial-element 0 :fill-pointer n)) (make-array n :initial-element 0 :fill-pointer n))
;; end ;; end