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

zymoscope

Browse source 
removed the 'osc-' prefix from most of the function names and packaged it as :osc

darcs-hash:20050210133251-2648a-94a88ade8074d89e0f7de8a9bff440e99235fa05.gz
This commit is contained in:
nik gaffney 2005-02-10 21:32:51 +08:00
parent d22ba88cc5
commit 424b187234
2 changed files with 64 additions and 51 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
osc-examples.lisp
View file

@ -28,9 +28,7 @@
;;;;;:::;;: ; ; ;::: ; ;; ;; ; ;; ;
(require :sb-bsd-sockets)
;(require :osc)
(use-package :sb-bsd-sockets)
(use-package :osc)
(defun osc-listen (port)
"a basic test function which attempts to decode osc stuff a
@ -44,7 +42,7 @@
(unwind-protect
(loop do
(socket-receive s buffer nil :waitall t)
(format t "receiveded -=> ~S~%" (osc-decode-message buffer)))
(format t "receiveded -=> ~S~%" (osc:decode-message buffer)))
(when s (socket-close s)))))
@ -65,18 +63,24 @@
(unwind-protect
(loop do
(socket-receive in buffer nil :waitall t)
(let ((oscuff (osc-decode-message buffer)))
(let ((oscuff (osc:decode-message buffer)))
(format t "glonked -=> message with ~S~% arg(s)" (length oscuff))
(write-sequence (stream-t1 oscuff) stream)))
(stream-t1 oscuff stream)))
(when in (socket-close in))
(when out (socket-close sc))))))
(when out (socket-close out))))))
(defun stream-t1 (osc-message stream)
"writes a given message to a stream. keep in mind that when using a buffered stream
any funtion writing to the stream should call (finish-output stream) after it sends
the mesages,. ."
(write-sequence (osc-encode-message osc-message) stream)
"writes a given message to a stream. keep in mind that when using a buffered
stream any funtion writing to the stream should call (finish-output stream)
after it sends the mesages,. ."
(write-sequence
(osc:encode-message "/bzzp" "got" "it" )
stream)
(finish-output stream))
(defmacro osc-write-to-stream (stream &body args)
`(progn (write-sequence (osc:encode-message ,@args) ,stream)
(finish-output ,stream)))
;end

87
osc.lisp
View file

@ -4,10 +4,11 @@
;;
;; copyright (C) 2004 FoAM vzw.
;;
;; This software is licensed under the terms of the Lisp Lesser GNU Public
;; License , known as the LLGPL. The LLGPL consists of a preamble and
;; the LGPL. Where these conflict, the preamble takes precedence. The
;; LLGPL is available online at http://opensource.franz.com/preamble.html
;; You are granted the rights to distribute and use this software
;; under the terms of the Lisp Lesser GNU Public License, known
;; as the LLGPL. The LLGPL consists of a preamble and the LGPL.
;; Where these conflict, the preamble takes precedence. The LLGPL
;; is available online at http://opensource.franz.com/preamble.html
;; and is distributed with this code (see: LICENCE and LGPL files)
;;
;; authors
@ -21,9 +22,9 @@
;; commentary
;;
;; this is a partial implementation of the OSC protocol which is used
;; for communicatin mostly amognst music programs and their attatched
;; for communication mostly amongst music programs and their attatched
;; musicians. eg. sc3, max/pd, reaktor/traktorska etc+. more details
;; of the procol can be found at the open sound control pages -=>
;; of the protocol can be found at the open sound control pages -=>
;; http://www.cnmat.berkeley.edu/OpenSoundControl/
;;
;; - currently doesnt send timetags, but does send typetags
@ -34,26 +35,34 @@
;;
;; - liblo like network wrapping
;; - error handling
;; - receiver
;; - receiver -> osc-responder.lisp
;; - osc-tree as name.value alist for responder/serve-event
;; - portable en/decoding of floats -=> ieee754 tests
;; - (in-package 'osc)
;; - bundles
;; - blobs
;; - bundles, blobs, doubles and other typetags
;; - asdf-installable
;; known BUGS
;; - only unknown for now.. .
;; changes
;;
;; Sat, 18 Dec 2004 15:41:26 +0100
;; 2004-12-18
;; - initial version, single args only
;; Mon, 24 Jan 2005 15:43:20 +0100
;; 2005-01-24
;; - sends and receives multiple arguments
;; - tests in osc-test.lisp
;; Wed, 26 Jan 2005 16:18:36 +0100
;; 2005-01-26
;; - fixed string handling bug
;; 2005-02-08
;; - in-package'd
(defpackage :osc
(:use :cl)
(:documentation "OSC aka the 'open sound control' protocol")
(:export :encode-message
:decode-message))
(in-package :osc)
;;;;;; ; ;; ; ; ; ; ; ; ;
;;
@ -61,19 +70,19 @@
;;
;;; ;; ;; ; ; ;; ; ; ; ;
(defun osc-encode-message (address &rest data)
(defun encode-message (address &rest data)
"encodes an osc message with the given address and data."
(concatenate '(vector '(unsigned-byte 8))
(osc-encode-address address)
(osc-encode-typetags data)
(osc-encode-data data)))
(encode-address address)
(encode-typetags data)
(encode-data data)))
(defun osc-encode-address (address)
(defun encode-address (address)
(cat (map 'vector #'char-code address)
(osc-string-padding address)))
(pad-string address)))
(defun osc-encode-typetags (data)
"creates a typetag string suitable for teh given data.
(defun encode-typetags (data)
"creates a typetag string suitable for the given data.
valid typetags according to the osc spec are ,i ,f ,s and ,b
non-std extensions include ,{h|t|d|S|c|r|m|T|F|N|I|[|]}
see the spec for more details. ..
@ -96,9 +105,9 @@
(t
(error "can only encode ints, floats or string"))))
(cat lump
(osc-pad (osc-padding-length (length lump))))))
(pad (padding-length (length lump))))))
(defun osc-encode-data (data)
(defun encode-data (data)
"encodes data in a format suitable for an OSC message"
(let ((lump (make-array 0 :adjustable t :fill-pointer t)))
(dolist (x data)
@ -115,7 +124,7 @@
(defun encode-string (string)
(cat (map 'vector #'char-code string)
(osc-string-padding string)))
(pad-string string)))
;;;;;; ; ;; ; ; ; ; ; ; ;
@ -124,16 +133,17 @@
;;
;;; ;; ;; ; ; ; ; ; ;
(defun osc-decode-message (message)
(defun decode-message (message)
"reduces an osc message to an (address . data) pair. .."
(declare (omptimize debug 3))
(let ((x (position (char-code #\,) message)))
(cons (osc-decode-address (subseq message 0 x))
(osc-decode-taged-data (subseq message x)))))
(cons (decode-address (subseq message 0 x))
(decode-taged-data (subseq message x)))))
(defun osc-decode-address (address)
(defun decode-address (address)
(coerce (map 'vector #'code-char address) 'string))
(defun osc-decode-taged-data (data)
(defun decode-taged-data (data)
"decodes data encoded with typetags...
NOTE: currently handles the following tags only
@ -159,7 +169,7 @@
result)
(setf acc (subseq acc 4)))
((eq x (char-code #\s))
(let ((pointer (+ (osc-padding-length (position 0 acc))
(let ((pointer (+ (padding-length (position 0 acc))
(position 0 acc))))
(push (decode-string
(subseq acc 0 pointer))
@ -170,7 +180,7 @@
tags)
(nreverse result)))
(defun osc-split-data (data)
(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)
@ -219,7 +229,7 @@
(defun encode-string (string)
"encodes a string as a vector of character-codes, padded to 4 byte boundary"
(cat (map 'vector #'char-code string)
(osc-string-padding string)))
(pad-string string)))
(defun decode-blob (b)
(error "cant decode blobs for now. .."))
@ -236,19 +246,18 @@
(defun osc-string-length (string)
"determines the length required for a padded osc string"
(let ((n (length string)))
(+ n (osc-padding-length n))))
(+ n (padding-length n))))
(defun osc-padding-length (s)
"returns the padding required for a given length of string"
(defun padding-length (s)
"returns the length of padding required for a given length of string"
(- 4 (mod s 4)))
(defun osc-string-padding (string)
(defun pad-string (string)
"returns the padding required for a given osc string"
(osc-pad (- 4 (mod (length string) 4))))
(pad (- 4 (mod (length string) 4))))
(defun osc-pad (n)
(defun pad (n)
"make a sequence of the required number of #\Nul characters"
(make-array n :initial-element 0 :fill-pointer n))
;; end