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

Cleaning

Browse source
This commit is contained in:
ErikR 2015-08-25 21:59:32 +02:00
parent 953af87fe4
commit 3bde47386a
1 changed files with 26 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
osc.lisp
View file

@ -180,38 +180,38 @@
(let ((div (position 0 data))) (let ((div (position 0 data)))
(let ((tags (subseq data 1 div)) (let ((tags (subseq data 1 div))
(acc (subseq data (padded-length div))) (acc (subseq data (padded-length div)))
(result '())) (result '()))
(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 #\h)) ((eq x (char-code #\h))
(push (decode-uint64 (subseq acc 0 8)) (push (decode-uint64 (subseq acc 0 8))
result) result)
(setf acc (subseq acc 8))) (setf acc (subseq acc 8)))
((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 (padded-length (position 0 acc)))) (let ((pointer (padded-length (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)) ((eq x (char-code #\b))
(let* ((size (decode-int32 (subseq acc 0 4))) (let* ((size (decode-int32 (subseq acc 0 4)))
(bl (+ 4 size)) (bl (+ 4 size))
(end (+ bl (mod (- 4 bl) 4)))) ; NOTE: cannot use (padded-length bl), as it is not the same algorithm. Blobs of 4, 8, 12 etc bytes should not be padded! (end (+ bl (mod (- 4 bl) 4)))) ; NOTE: cannot use (padded-length bl), as it is not the same algorithm. Blobs of 4, 8, 12 etc bytes should not be padded!
(push (decode-blob (subseq acc 0 end)) (push (decode-blob (subseq acc 0 end))
result) result)
(setf acc (subseq acc end)))) (setf acc (subseq acc end))))
(t (error "unrecognised typetag ~a" x)))) (t (error "unrecognised typetag ~a" x))))
tags) tags)
(nreverse result)))) (nreverse result))))