├── .gitignore ├── CHANGELOG.md ├── README.md ├── project.clj ├── src └── overtone │ ├── osc.clj │ └── osc │ ├── decode.clj │ ├── dyn_vars.clj │ ├── encode.clj │ ├── pattern.clj │ ├── peer.clj │ └── util.clj └── test ├── bundle_test.clj └── osc_test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | lib 2 | \#*# 3 | \.\#* 4 | classes/* 5 | *.jar 6 | .cake 7 | pom.xml 8 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # OSC-clj Changelog 2 | 3 | ## 0.9.0 4 | _17th January 2013_ 5 | 6 | * Allow nesting of calls to `in-osc-bundle` to create nested bundles 7 | * Add `in-unested-osc-bundle` to allow for the creation of bundles which are sent immediately and aren't nested in any outer bundle 8 | * Teach peers to disable support for nesting bundles when sending OSC messages (some servers, such as the SuperCollider server don't support them) 9 | * Update dependency on JMDNS to 3.4.1 10 | * Update dependency on at-at to 1.1.1 11 | 12 | ## 0.8.1 13 | _21st Aug 2012_ 14 | 15 | * Fixed `osc-recv` to return the message, not the peer. 16 | * Added the ability to handle exceptions wrapped in RuntimeException 17 | which aren't correctly unwrapped in Clojure 1.3 (this may be removed 18 | in the future). 19 | 20 | ## 0.8.0 21 | _26th June 2012_ 22 | 23 | * Added `without-osc-bundle` to allow specific OSC messages generated 24 | within a call to `in-osc-bundle` to pass through unbundled. Likely to 25 | be rarely used. Prefer not using this unless explicitly required. 26 | * Type hint message sending aspects of code for faster performance 27 | * Wait for longer before timing out the send operation 28 | * Increase size of initial send queue 29 | * Updated dependency on `at-at` to 1.0.0 30 | * Add `osc-reply-msg` and `osc-reply` 31 | * Improve client print-method 32 | * Fix race condition between socket bind and receive 33 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ,~~~ 2 | +~~~~~ 3 | ?~~~~+~ 4 | 8~~~~~+~, 5 | O~~~~~=+== 6 | 8?~~~~=+=~~ 7 | NI=~~~~~~~~~ 8 | DO?~~=7I~~~~= 9 | Z8?~~~~~~:+~?$I, ,,,,, 10 | ZNOI~~~~~~~~~~~.~7$$Z7:~~ZZZOSCZZ+, 11 | ZDO7:~~~=~~~~~~~ $MZCSOZZ,~ 12 | ZDOOI~~?~~~~===== ~DZO7 13 | ~NDOO?~~~~~~~~~~~ ~7:$ 14 | :I OO$+~~~~==~~==~ ~? Z 15 | DDDD8D?~~~~~~~====~ ~: I$ 16 | D DDDN8Z=~~~~~===~~~~ + I` 17 | ? DDDDN8O7~~~~~~~~====.7 $$ 18 | N888DNMOO?~~~~~===~~~$? .? 19 | O88+DM ~NNN88OI~~~~~=~~~+~~?/$ 20 | D OVERTONE88I~~~~~===~~~,~ 21 | D ~ INC.NNN888I~~~~~=~~==, 22 | :I ND~ DDN888O~~~?======, 23 | 8 8DDD ~ M88887:I~~===== 24 | D 8DDDDND D 88$~~~===+z 25 | :D8MDDDNN DD87~~I~+= 26 | 88DDDDDN DD7?~~ 27 | $CLOJURE DD` 28 | $8DSDDDD 29 | DDDCDDDN 888 d8b 30 | ::7OLIBRARY$$$77I$IZ7 888 Y8P 31 | 888 32 | .d88b. .d8888b .d8888b .d8888b 888 8888 33 | d88""88b 88K d88P" d88P" 888 "888 34 | 888 888 "Y8888b. 888 888888 888 888 888 35 | Y88..88P X88 Y88b. Y88b. 888 888 36 | "y88p" 88888P' "Y8888P "Y8888P 888 888 37 | 888 38 | d88P 39 | 888P" 40 | 41 | 42 | 43 | # Open Sound Control Library for Clojure 44 | 45 | A full-featured UDP-based OSC communication library created for Project Overtone. It implements OSC 1.0 with some additional types from 1.1 also supported (long and double). Find OSC documentation here: 46 | 47 | http://opensoundcontrol.org/spec-1_0 48 | 49 | 50 | ## Quick Start 51 | 52 | (use 'overtone.osc) 53 | 54 | (def PORT 4242) 55 | 56 | ; start a server and create a client to talk with it 57 | (def server (osc-server PORT)) 58 | (def client (osc-client "localhost" PORT)) 59 | 60 | ; Register a handler function for the /test OSC address 61 | ; The handler takes a message map with the following keys: 62 | ; [:src-host, :src-port, :path, :type-tag, :args] 63 | (osc-handle server "/test" (fn [msg] (println "MSG: " msg))) 64 | 65 | ; send it some messages 66 | (doseq [val (range 10)] 67 | (osc-send client "/test" "i" val)) 68 | 69 | (Thread/sleep 1000) 70 | 71 | ;remove handler 72 | (osc-rm-handler server "/test") 73 | 74 | ; stop listening and deallocate resources 75 | (osc-close client) 76 | (osc-close server) 77 | 78 | ## Documentation 79 | 80 | ### OSC Client 81 | 82 | The `osc-clj` client allows you to send OSC messages to a server listening on a specific port on a specific host. 83 | 84 | #### OSC Messages 85 | 86 | OSC messages contain the following elements: 87 | 88 | * A path (i.e. `/foo/bar/baz`) 89 | * An arbitrary list of params (i.e. `2 "baz" 3.14159265 (byte-array 10)` 90 | 91 | The supported param types are: 92 | 93 | * Integers 94 | * Floats 95 | * Strings 96 | * Byte Arrays 97 | * Longs 98 | * Doubles 99 | 100 | You don't need to specify which type you are using, `osc-clj` will infer these with reflection. 101 | 102 | Each message may or may not trigger a method handler to be executed on the receiving server - this is dependent on whether the path sent matches a registered handler on the server. Multiple handlers can be called by using regexp-like patterns in your out going path which may be matched to multiple handlers (see the pattern matching section below for more info). 103 | 104 | #### Sending Messages 105 | 106 | In order to send messages, you must first create a client withi `osc-client`: 107 | 108 | (def client (osc-client "localhost" 9801)) 109 | 110 | Then you may send a message using `osc-send`: 111 | 112 | (osc-send client "/foo/bar/baz 1 2 "three") 113 | 114 | 115 | ### OSC Server 116 | 117 | The `osc-clj` server allows you to receive OSC messages by listening on a specific port. You may then register method handlers and/or listeners with the server which may be triggered by incoming messages. 118 | 119 | Create new server with `osc-server`: 120 | 121 | (def server (osc-server 9800)) 122 | 123 | #### OSC Listeners 124 | 125 | `osc-clj` servers support both listeners and handlers. Listeners are fns you register which will be triggered for each and every incoming message. The fn must accept one argument - the message to receive. Each listener may also be associated with a unique key which allows you to individually remove it at a later time. 126 | 127 | Here we use `osc-listen` to add a generic listener that will print *all* incoming OSC messages to std-out. We also specify the key `:debug`: 128 | 129 | (osc-listen server (fn [msg] (println "Listener: " msg)) :debug) 130 | 131 | To remove the listener simply call: 132 | 133 | (osc-rm-listener server :debug) 134 | 135 | `osc-clj` also supplies the fn `osc-rm-all-listeners` which will remove all listeners on the specified server. 136 | 137 | #### OSC Method Handlers 138 | 139 | Handlers are registered with an OSC path such as /foo/bar - they are only triggered if the path of the incoming OSC message matches the registered path. Only one handler may be registered with any given path. 140 | 141 | To register a handler for the path "/foo/bar" do the following: 142 | 143 | (osc-handle s "/foo/bar" (fn [msg] (println "Handler for /foo/bar: " msg))) 144 | 145 | This will only print out received messages that match the path "/foo/bar". To remove call: 146 | 147 | (osc-rm-handler s "/foo/bar") 148 | 149 | `osc-clj` also supplies the fn `osc-rm-all-handlers` which will remove all the servers handlers within the path and below in the hierarchy (i.e. `(osc-rm-all-handlers server "/foo")` will remove all handlers registered at /foo and any below i.e. /foo/bar /foo/bar/baz etc. Passing no path to `osc-rm-all-handlers` will remove *all* handlers on the server. 150 | 151 | ### OSC Bundles 152 | 153 | OSC bundles are groups of messages with a collective timestamp. This allows groups of messages to be scheduled to be handled at the same time which may be some arbitrary point in the future. 154 | 155 | #### Receiving Bundles 156 | 157 | When `osc-clj` receives a timestamped bundle it will schedule the bundle to be handled at the time of the timestamp. However, if the time is in the past, it will be handled immediately. 158 | 159 | Handling the bundle means unpacking it and handling each contained message in sequence. Therefore, if a bundle contains another, and the inner bundle's timestamp is earlier than the outer bundle, it will *not* be honoured - instead it will trigger at the outer bundle's timestamp. 160 | 161 | #### Sending Bundles 162 | 163 | The simplest way to construct and send a bundle is with the macro `in-osc-bundle`. All OSC messages and bundles sent within the scope of the macro call will get sent together in the parent bundle with the specified timestamp: 164 | 165 | Send the enclosing messages inside a bundle that is timestamped for 1 second from now: 166 | 167 | (in-osc-bundle client (+ (osc-now) 1000) 168 | (osc-send client "/foo" "bar" 42) 169 | 170 | ; Call functions that send more osc messages 171 | (do-stuff client)) 172 | 173 | You can also create bundles by hand with `osc-bundle` and send them with `osc-send-bundle`. OSC messages can also be created with `osc-msg` in order to populate your bundle. 174 | 175 | When constructing bundles, if you specify the timestamp with a Long, you can sample accurate messaging (with precision granularity around 200 picoseconds) for use with SuperCollider and other OSC servers. Bundles received with future timestamps are scheduled to be executed at that future time (with a precision granularity of around 10 milliseconds). 176 | 177 | 178 | ### Pattern Matching 179 | 180 | `osc-clj` has full support for OSC pattern matching. This allows incoming messages to specify regexp like matcher symbols such as `?` and `*` allowing the message to match more than one path. 181 | 182 | The basic matchers are: 183 | 184 | * `*` Matches 0 or more arbitrary chars (`osc-clj` implements this in a non-greedy way) 185 | * `?` Matches 1 arbitrary char 186 | * `[abc]` Matches 1 char: either a, b or c 187 | * `[!abc]` Matches 1 char: not a,b or c 188 | * `[a-d]` Matches 1 char: in the range a-d inclusive `[!a-d]` is also recognised. 189 | * `{foo,bar}` Matches 1 word - either foo or bar 190 | 191 | 192 | The matchers may also be combined: 193 | 194 | /foo/{bar,baz}/*/*quux?/[abc]def[!h]/phasor[0-9]/ 195 | 196 | There is no guarantee on the order of fn triggering. 197 | 198 | For example, `/foo/{bar,baz}/quux` will trigger fns in both `/foo/bar/quux/` and `/foo/baz/quux` but with no specific order. 199 | 200 | ### Zeroconf 201 | 202 | `osc-clj` has support for broadcasting the presence of your OSC servers to the local network using zerconf. This is disabled by default. 203 | 204 | On creation of a server, you may specify an option tag: 205 | 206 | (def server (osc-server 9800 "My OSC Server")) 207 | 208 | The string `My OSC Server` is then used to register your server with zeroconf. In order to use zeroconf you must turn it on: 209 | 210 | (zero-conf-on) 211 | 212 | You should now see your server with clients that speak zeroconf. It is known that zero-conf can eat up a lot of cpu time - especially on chatty networks. It is therefore recommended to switch it off once you have configured and connected your client: 213 | 214 | (zero-conf-off) 215 | 216 | ## Project Info: 217 | 218 | Include in your `project.clj like so: 219 | 220 | [overtone/osc-clj "0.8.1"] 221 | 222 | ### Source Repository 223 | Downloads and the source repository can be found on GitHub: 224 | 225 | http://github.com/overtone/osc-clj 226 | 227 | 228 | ### Example Usage 229 | 230 | For an example of this library in use within the check out Overtone, located here: 231 | 232 | http://github.com/overtone/overtone 233 | 234 | 235 | ### Mailing List 236 | 237 | For any questions, comments or patches, use the Overtone google group: 238 | 239 | http://groups.google.com/group/overtone 240 | 241 | ## Authors 242 | 243 | * Jeff Rose 244 | * Sam Aaron 245 | 246 | ### Contributors 247 | * mw10013 248 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject overtone/osc-clj "0.9.0" 2 | :description "An Open Sound Control library for Clojure." 3 | :dependencies [[org.clojure/clojure "1.3.0"] 4 | [javax.jmdns/jmdns "3.4.1"] 5 | [commons-net "3.0.1"] 6 | [overtone/at-at "1.1.1"]]) 7 | -------------------------------------------------------------------------------- /src/overtone/osc.clj: -------------------------------------------------------------------------------- 1 | (ns overtone.osc 2 | (:use [overtone.osc.util] 3 | [overtone.osc.peer] 4 | [overtone.osc.dyn-vars])) 5 | 6 | (defn osc-send-msg 7 | "Send OSC msg to peer. 8 | 9 | (osc-send-msg client {:path \"foo\" :type-tag \"i\" :args [42]}) 10 | " 11 | [peer msg] 12 | (let [msg (with-meta msg {:type :osc-msg})] 13 | (if *osc-msg-bundle* 14 | (swap! *osc-msg-bundle* #(conj %1 msg)) 15 | (peer-send-msg peer msg)))) 16 | 17 | (defn osc-reply-msg 18 | "Send OSC msg to peer as a reply. 19 | 20 | (osc-reply-msg client {:path \"foo\" :type-tag \"i\" :args [42]} prev-msg) 21 | " 22 | [peer msg msg-to-reply-to] 23 | (peer-reply-msg peer (with-meta msg {:type :osc-msg}) msg-to-reply-to)) 24 | 25 | (defn osc-listen 26 | "Attach a generic listener function that will be called with every incoming 27 | osc message. An optional key allows you to specifically refer to this listener 28 | at a later point in time. If no key is passed, the listener itself will also 29 | serve as the key. 30 | 31 | (osc-listen s (fn [msg] (println \"listener: \" msg)) :foo)." 32 | ([peer listener] (osc-listen peer listener listener)) 33 | ([peer listener key] 34 | (dosync 35 | (alter (:listeners peer) assoc key listener)) 36 | peer)) 37 | 38 | (defn osc-listeners 39 | "Return a seq of the keys of all registered listeners. This may be the 40 | listener fns themselves if no key was explicitly specified when the listener 41 | was registered." 42 | [peer] 43 | (keys @(:listeners peer))) 44 | 45 | (defn osc-rm-listener 46 | "Remove the generic listener associated with the specific key 47 | (osc-rm-listener s :foo)" 48 | [peer key] 49 | (dosync 50 | (alter (:listeners peer) dissoc key)) 51 | peer) 52 | 53 | (defn osc-rm-all-listeners 54 | "Remove all generic listeners associated with server" 55 | [peer] 56 | (dosync 57 | (ref-set (:listeners peer) {})) 58 | peer) 59 | 60 | (defn osc-handle 61 | "Add a handle fn (a method in OSC parlance) to the specified OSC path 62 | (container). This handle will be called when an incoming OSC message matches 63 | the supplied path. This may either be a direct match, or a pattern match if 64 | the incoming OSC message uses wild card chars in its path. The path you 65 | specify may not contain any of the OSC reserved chars: 66 | # * , ? [ ] { } and whitespace 67 | 68 | Will override and remove any handler already associated with the supplied 69 | path. If the handler-fn returns :done it will automatically remove itself." 70 | [peer path handler] 71 | (peer-handle peer path handler) 72 | peer) 73 | 74 | (defn osc-handlers 75 | "Returns a seq of all the paths containing a handler for the server. If a 76 | path is specified, the result will be scoped within that subtree." 77 | ([peer] (osc-handlers peer "/")) 78 | ([peer path] 79 | (peer-handler-paths peer path))) 80 | 81 | (defn osc-rm-handler 82 | "Remove the handler at the specified path. 83 | specific handler (if found)" 84 | [peer path] 85 | (peer-rm-handler peer path) 86 | peer) 87 | 88 | (defn osc-rm-all-handlers 89 | "Remove all registered handlers for the supplied path (defaulting to /) 90 | This not only removes the handler associated with the specified path 91 | but also all handlers further down in the path tree. i.e. if handlers 92 | have been registered for both /foo/bar and /foo/bar/baz and 93 | osc-rm-all-handlers is called with /foo/bar, then the handlers associated 94 | with both /foo/bar and /foo/bar/baz will be removed." 95 | ([peer] (osc-rm-all-handlers peer "/")) 96 | ([peer path] 97 | (peer-rm-all-handlers peer path) 98 | peer)) 99 | 100 | (defn osc-recv 101 | "Register a one-shot handler which will remove itself once called. If a 102 | timeout is specified, it will return nil if a message matching the path 103 | is not received within timeout milliseconds. Otherwise, it will block 104 | the current thread until a message has been received. 105 | 106 | Will override and remove any handler already associated with the supplied 107 | path." 108 | [peer path handler & [timeout]] 109 | (peer-recv peer path handler timeout)) 110 | 111 | (defn osc-reply 112 | "Similar to osc-send except ignores the peer's target address and instead 113 | sends the OSC message to the sender of msg-to-reply-to. It is not currently 114 | possible to implicitly build OSC bundles as a reply to an OSC msg." 115 | [peer msg-to-reply-to path & args] 116 | (osc-reply-msg peer (apply mk-osc-msg path (osc-type-tag args) args) msg-to-reply-to)) 117 | 118 | (defn osc-send 119 | "Creates an OSC message and either sends it to the server immediately 120 | or if a bundle is currently being formed it adds it to the list of messages." 121 | [client path & args] 122 | (osc-send-msg client (apply mk-osc-msg path (osc-type-tag args) args))) 123 | 124 | (defn osc-msg 125 | "Returns a map representing an OSC message with the specified path and args." 126 | [path & args] 127 | (apply mk-osc-msg path (osc-type-tag args) args)) 128 | 129 | (defn osc-bundle 130 | "Returns an OSC bundle, which is a timestamped set of OSC messages and/or bundles." 131 | [timestamp & items] 132 | (mk-osc-bundle timestamp items)) 133 | 134 | (defn osc-send-bundle 135 | "Send OSC bundle to client." 136 | [client bundle] 137 | (peer-send-bundle client bundle)) 138 | 139 | (defmacro in-osc-bundle 140 | "Runs body and intercepts any inner calls to osc-send-msg and instead 141 | of sending the OSC message, aggregates them and wraps them in an OSC 142 | bundle. When the body has finished, the bundle is then sent with the 143 | associated timestamp to the client. Handles nested calls to 144 | in-osc-bundle - resulting in a nested set of bundles." 145 | [client timestamp & body] 146 | `(let [[bundle# body-res#] (binding [*osc-msg-bundle* (atom [])] 147 | (let [res# (do ~@body)] 148 | [(mk-osc-bundle ~timestamp @*osc-msg-bundle*) res#]))] 149 | (if *osc-msg-bundle* 150 | (swap! *osc-msg-bundle* conj bundle#) 151 | (osc-send-bundle ~client bundle#)) 152 | body-res#)) 153 | 154 | (defmacro in-unested-osc-bundle 155 | "Runs body and intercepts any inner calls to osc-send-msg and instead 156 | of sending the OSC message, aggregates them and wraps them in an OSC 157 | bundle. When the body has finished, the bundle is then sent with the 158 | associated timestamp to the client. 159 | 160 | Does not nest OSC bundles, it sends all completed OSC bundles 161 | immediately." 162 | [client timestamp & body] 163 | `(let [[bundle# body-res#] (binding [*osc-msg-bundle* (atom [])] 164 | (let [res# (do ~@body)] 165 | [(mk-osc-bundle ~timestamp @*osc-msg-bundle*) res#]))] 166 | (osc-send-bundle ~client bundle#) 167 | body-res#)) 168 | 169 | (defmacro without-osc-bundle 170 | "Runs body and ensures that any inner calls to osc-send-msg are sent 171 | immediately. This is useful in the rare case you need to bypass the 172 | bundling of OSC messages when code may be wrapped within 173 | in-osc-bundle." 174 | [& body] 175 | `(binding [*osc-msg-bundle* nil] 176 | ~@body)) 177 | 178 | (defn osc-client 179 | "Returns an OSC client ready to communicate with a host on a given port via UDP" 180 | ([host port] (osc-client host port true)) 181 | ([host port send-nested-osc-bundles?] 182 | (client-peer host port send-nested-osc-bundles?))) 183 | 184 | (defn osc-peer 185 | "Returns a generic OSC peer. You will need to configure it to make 186 | it act either as a server or client." 187 | ([] (peer)) 188 | ([listen? send-nested-osc-bundles?] (peer listen? send-nested-osc-bundles?))) 189 | 190 | (defn osc-target 191 | "Update the target address of an OSC client so future calls to osc-send 192 | will go to a new destination. Automatically updates zeroconf if necessary." 193 | [client host port] 194 | (update-peer-target client host port) 195 | client) 196 | 197 | (defn osc-server 198 | "Returns a live OSC server ready to register handler functions. By default 199 | this also registers the server with zeroconf. The name used to register 200 | can be passed as an optional param. If the zero-conf-name is set to nil 201 | zeroconf wont' be used." 202 | ([port] (osc-server port "osc-clj")) 203 | ([port zero-conf-name] (osc-server port zero-conf-name true)) 204 | ([port zero-conf-name send-nested-osc-bundles?] 205 | (server-peer port zero-conf-name send-nested-osc-bundles?))) 206 | 207 | (defn osc-close 208 | "Close an osc-peer, works for both clients and servers. If peer has been 209 | registered with zeroconf, it will automatically remove it." 210 | [peer & wait] 211 | (apply close-peer peer wait) 212 | peer) 213 | 214 | (defn osc-debug 215 | [& [on-off]] 216 | (let [on-off (if (= on-off false) false true)] 217 | (dosync (ref-set osc-debug* on-off)))) 218 | 219 | (defn zero-conf-on 220 | "Turn zeroconf on. Will automatically register all running servers with their 221 | specified service names (defaulting to \"osc-clj\" if none was specified). 222 | Asynchronous." 223 | [] 224 | (turn-zero-conf-on)) 225 | 226 | (defn zero-conf-off 227 | "Turn zeroconf off. Will unregister all registered services and close zeroconf 228 | down. Asynchronous." 229 | [] 230 | (turn-zero-conf-off)) 231 | 232 | (defn zero-conf? 233 | "Returns true if zeroconf is running, false otherwise." 234 | [] 235 | (zero-conf-running?)) 236 | 237 | (defn osc-now 238 | "Return the current time in milliseconds" 239 | [] 240 | (System/currentTimeMillis)) 241 | -------------------------------------------------------------------------------- /src/overtone/osc/decode.clj: -------------------------------------------------------------------------------- 1 | (ns overtone.osc.decode 2 | (:import [org.apache.commons.net.ntp TimeStamp]) 3 | (:use [overtone.osc.util])) 4 | 5 | (defn osc-align 6 | "Jump the current position to a 4 byte boundary for OSC compatible alignment." 7 | [buf] 8 | (.position buf (bit-and (bit-not 3) (+ 3 (.position buf))))) 9 | 10 | (defn- decode-string 11 | "Decode string from current pos in buf. OSC strings are terminated by a null 12 | char." 13 | [buf] 14 | (let [start (.position buf)] 15 | (while (not (zero? (.get buf))) nil) 16 | (let [end (.position buf) 17 | len (- end start) 18 | str-buf (byte-array len)] 19 | (.position buf start) 20 | (.get buf str-buf 0 len) 21 | (osc-align buf) 22 | (String. str-buf 0 (dec len))))) 23 | 24 | (defn- decode-blob 25 | "Decode binary blob from current pos in buf. Size of blob is determined by the 26 | first int found in buffer." 27 | [buf] 28 | (let [size (.getInt buf) 29 | blob (byte-array size)] 30 | (.get buf blob 0 size) 31 | (osc-align buf) 32 | blob)) 33 | 34 | (defn- decode-msg 35 | "Pull data out of the message according to the type tag." 36 | [buf] 37 | (let [path (decode-string buf) 38 | type-tag (decode-string buf) 39 | args (reduce (fn [mem t] 40 | (conj mem 41 | (case t 42 | \i (.getInt buf) 43 | \h (.getLong buf) 44 | \f (.getFloat buf) 45 | \d (.getDouble buf) 46 | \b (decode-blob buf) 47 | \s (decode-string buf)))) 48 | [] 49 | (rest type-tag))] 50 | (apply mk-osc-msg path type-tag args))) 51 | 52 | (defn- decode-timetag 53 | "Decode OSC timetag from current pos in buf." 54 | [buf] 55 | (let [tag (.getLong buf)] 56 | (if (= tag OSC-TIMETAG-NOW) 57 | OSC-TIMETAG-NOW 58 | (TimeStamp/getTime tag)))) 59 | 60 | (defn- osc-bundle-buf? 61 | "Check whether there is an osc bundle at the current position in buf." 62 | [buf] 63 | (let [start-char (char (.get buf))] 64 | (.position buf (- (.position buf) 1)) 65 | (= \# start-char))) 66 | 67 | (declare osc-decode-packet) 68 | 69 | (defn- decode-bundle-items 70 | "Pull out all the message packets within bundle from current buf position." 71 | [buf] 72 | (loop [items []] 73 | (if (.hasRemaining buf) 74 | (let [item-size (.getInt buf) 75 | original-limit (.limit buf) 76 | item (do (.limit buf (+ (.position buf) item-size)) (osc-decode-packet buf))] 77 | (.limit buf original-limit) 78 | (recur (conj items item))) 79 | items))) 80 | 81 | (defn- decode-bundle 82 | "Decode a bundle - ignore the first string as it simply identifies the bundle." 83 | [buf] 84 | (decode-string buf) ; #bundle 85 | (mk-osc-bundle (decode-timetag buf) (decode-bundle-items buf))) 86 | 87 | (defn osc-decode-packet 88 | "Decode an OSC packet buffer into a bundle or message map." 89 | [buf] 90 | (if (osc-bundle-buf? buf) 91 | (decode-bundle buf) 92 | (decode-msg buf))) 93 | -------------------------------------------------------------------------------- /src/overtone/osc/dyn_vars.clj: -------------------------------------------------------------------------------- 1 | (ns overtone.osc.dyn-vars) 2 | 3 | ;; We use binding to *osc-msg-bundle* to bundle messages 4 | ;; and send combined with an OSC timestamp. 5 | (defonce ^{:dynamic true} *osc-msg-bundle* nil) 6 | -------------------------------------------------------------------------------- /src/overtone/osc/encode.clj: -------------------------------------------------------------------------------- 1 | (ns overtone.osc.encode 2 | (:import [org.apache.commons.net.ntp TimeStamp]) 3 | (:use [overtone.osc.util])) 4 | 5 | (defn osc-pad 6 | "Add 0-3 null bytes to make buf position 32-bit aligned." 7 | [buf] 8 | (let [extra (mod (.position buf) 4)] 9 | (if (pos? extra) 10 | (.put buf PAD 0 (- 4 extra))))) 11 | 12 | (defn encode-string 13 | "Encode string s into buf. Ensures buffer is correctly padded." 14 | [buf s] 15 | (.put buf (.getBytes s)) 16 | (.put buf (byte 0)) 17 | (osc-pad buf)) 18 | 19 | (defn encode-blob 20 | "Encode binary blob b into buf. Ensures buffer is correctly padded." 21 | [buf b] 22 | (.putInt buf (count b)) 23 | (.put buf b) 24 | (osc-pad buf)) 25 | 26 | (defn encode-timetag 27 | "Encode timetag into buf. Timestamp defaults to (now) if not specifically 28 | passed. Throws exception if timestamp isn't a number." 29 | ([buf] (encode-timetag buf OSC-TIMETAG-NOW)) 30 | ([buf timestamp] 31 | (when-not (number? timestamp) 32 | (throw (IllegalArgumentException. (str "OSC bundle timestamp needs to be a number. Got: " (type timestamp) " - " timestamp)))) 33 | (if (= timestamp OSC-TIMETAG-NOW) 34 | (doto buf (.putInt 0) (.putInt 1)) 35 | (let [ntp-timestamp (TimeStamp/getNtpTime (long timestamp)) 36 | ntp-long (.ntpValue ntp-timestamp)] 37 | (.putLong buf ntp-long))))) 38 | 39 | (defn osc-encode-msg 40 | "Encode OSC message msg into buf." 41 | [buf msg] 42 | (let [{:keys [path type-tag args]} msg] 43 | (encode-string buf path) 44 | (encode-string buf (str "," type-tag)) 45 | (doseq [[t arg] (map vector type-tag args)] 46 | (case t 47 | \i (.putInt buf (int arg)) 48 | \h (.putLong buf (long arg)) 49 | \f (.putFloat buf (float arg)) 50 | \d (.putDouble buf (double arg)) 51 | \b (encode-blob buf arg) 52 | \s (encode-string buf arg)) 53 | )) 54 | buf) 55 | 56 | (declare osc-encode-packet) 57 | 58 | (defn osc-encode-bundle 59 | "Encode bundle into buf." 60 | [buf bundle send-nested-osc-bundles?] 61 | (encode-string buf "#bundle") 62 | (encode-timetag buf (:timestamp bundle)) 63 | (doseq [item (:items bundle)] 64 | ; A bit of a hack... 65 | ; Write an empty bundle element size into the buffer, then encode 66 | ; the actual bundle element, and then go back and write the correct 67 | ; size based on the new buffer position. 68 | (let [start-pos (.position buf)] 69 | (.putInt buf (int 0)) 70 | (if (osc-msg? item) 71 | (osc-encode-msg buf item) 72 | (if send-nested-osc-bundles? 73 | (osc-encode-bundle buf item) 74 | (throw (Exception. "Error - nesting OSC bundles has been disabled. This is functionality is typically disabled to ensure compatibility with some OSC servers (such as SuperCollider) that don't have support for nested OSC bundles")))) 75 | (let [end-pos (.position buf)] 76 | (.position buf start-pos) 77 | (.putInt buf (- end-pos start-pos 4)) 78 | (.position buf end-pos)))) 79 | buf) 80 | 81 | (defn osc-encode-packet 82 | "Encode OSC packet into buf. Handles both OSC messages and bundles." 83 | [buf packet] 84 | (if (osc-msg? packet) (osc-encode-msg buf packet) (osc-encode-bundle buf packet))) 85 | -------------------------------------------------------------------------------- /src/overtone/osc/pattern.clj: -------------------------------------------------------------------------------- 1 | (ns overtone.osc.pattern 2 | (:use [overtone.osc.util]) 3 | (:require [clojure.string :as string])) 4 | 5 | ;; Pattern-matched retrievel of handlers. Implements the following pattern 6 | ;; matching rules from the Open Sound Control Spec 1.0: 7 | ;; http://opensoundcontrol.org/spec-1_0 8 | ;; 9 | ;; When an OSC server receives an OSC Message, it must invoke the appropriate OSC 10 | ;; Methods in its OSC Address Space based on the OSC Message's OSC Address 11 | ;; Pattern. This process is called dispatching the OSC Message to the OSC Methods 12 | ;; that match its OSC Address Pattern. All the matching OSC Methods are invoked 13 | ;; with the same argument data, namely, the OSC Arguments in the OSC Message. 14 | ;; 15 | ;; The parts of an OSC Address or an OSC Address Pattern are the substrings 16 | ;; between adjacent pairs of forward slash characters and the substring after the 17 | ;; last forward slash character. 18 | ;; 19 | ;; A received OSC Message must be disptched to every OSC method in the current 20 | ;; OSC Address Space whose OSC Address matches the OSC Message's OSC Address 21 | ;; Pattern. An OSC Address Pattern matches an OSC Address if: 22 | ;; 23 | ;; 1. The OSC Address and the OSC Address Pattern contain the same number of 24 | ;; parts; and 25 | ;; 2. Each part of the OSC Address Pattern matches the corresponding part of the 26 | ;; OSC Address. 27 | ;; 28 | ;; A part of an OSC Address Pattern matches a part of an OSC Address if every 29 | ;; consecutive character in the OSC Address Pattern matches the next consecutive 30 | ;; substring of the OSC Address and every character in the OSC Address is matched 31 | ;; by something in the OSC Address Pattern. These are the matching rules for 32 | ;; characters in the OSC Address Pattern: 33 | ;; 34 | ;; 1. '?' in the OSC Address Pattern matches any single character 35 | ;; 2. '*' in the OSC Address Pattern matches any sequence of zero or more characters 36 | ;; 3. A string of characters in square brackets (e.g., \"[string]\") in the OSC 37 | ;; Address Pattern matches any character in the string. Inside square 38 | ;; brackets, the minus sign (-) and exclamation point (!) have special meanings: 39 | ;; * two characters separated by a minus sign indicate the range of 40 | ;; characters between the given two in ASCII collating sequence. (A minus 41 | ;; sign at the end of the string has no special meaning.) 42 | ;; * An exclamation point at the beginning of a bracketed string negates the 43 | ;; sense of the list, meaning that the list matches any character not in 44 | ;; the list. (An exclamation point anywhere besides the first character 45 | ;; after the open bracket has no special meaning.) 46 | ;; 4. A comma-separated list of strings enclosed in curly braces (e.g., 47 | ;; \"{foo,bar}\") in the OSC Address Pattern matches any of the strings in the 48 | ;; list. 49 | ;; 5. Any other character in an OSC Address Pattern can match only the same 50 | ;; character. 51 | 52 | (def MATCHER-CHARS [ \[ \{ \? \* ]) 53 | 54 | (defn- matcher-char? 55 | "Returns true if char is one of the MATCHER-CHARS" 56 | [char] 57 | (some #{char} MATCHER-CHARS)) 58 | 59 | (defn- match-question-mark 60 | "Match just one char from part" 61 | [pattern part] 62 | [(rest pattern) (rest part) (not (empty? part))]) 63 | 64 | (defn- expand-char-matcher 65 | "expand internal sequences within char matcher. Returns a list of chars 66 | a-d => abcd" 67 | [char-matcher] 68 | (string/replace char-matcher #"(.)-(.)" 69 | (fn [m] (let [f (int (first (nth m 1))) 70 | l (int (first (nth m 2)))] 71 | (map char (range f (inc l))))))) 72 | 73 | (defn- extract-neg-char-matcher 74 | "Pull out sequence of chars within a negative char matcher" 75 | [pattern] 76 | (let [pattern (drop 2 pattern) 77 | matcher (take-while #(not= % \]) pattern)] 78 | (seq (expand-char-matcher (apply str matcher))))) 79 | 80 | (defn- extract-pos-char-matcher 81 | "Pull out sequence of chars within a positive char matcher" 82 | [pattern] 83 | (let [pattern (drop 1 pattern) 84 | matcher (take-while #(not= % \]) pattern)] 85 | (seq (expand-char-matcher (apply str matcher))))) 86 | 87 | (defn- extract-match-strings 88 | "Pull out seq of char seqs representing possible string matches" 89 | [pattern] 90 | (let [pattern (drop 1 pattern) 91 | match-strings (take-while #(not= % \}) pattern) 92 | partitioned (partition-by #(= % \,) match-strings)] 93 | (remove #(= % (list \,)) partitioned))) 94 | 95 | (defn- string-matches? 96 | "returns string if it matches part, else false" 97 | [str part] 98 | (if (= str (take (count str) part)) 99 | str 100 | false)) 101 | 102 | (defn- valid-next-char-match-chars 103 | [pattern] 104 | (extract-pos-char-matcher pattern)) 105 | 106 | (defn- valid-next-string-match-chars 107 | [pattern] 108 | (let [pos-matches (extract-match-strings pattern)] 109 | (map first pos-matches))) 110 | 111 | (defn- valid-next-chars 112 | "return a list of possible chars" 113 | [pattern] 114 | (case (first pattern) 115 | \[ (valid-next-char-match-chars pattern) 116 | \{ (valid-next-string-match-chars pattern) 117 | [(first pattern)])) 118 | 119 | (defn- drop-word 120 | "drop one of the words from part. Returns empty list if no match found" 121 | [words part] 122 | (if-let [match (some #(string-matches? % part) words)] 123 | (drop (count match) part) 124 | [])) 125 | 126 | (defn- until-word-match 127 | "returns the number of chars up to the first char of the first word match. If 128 | more than one word matches - choose the smallest number to drop (non-greedy)" 129 | [pattern part] 130 | (let [word-matches (extract-match-strings pattern) 131 | str-matches (map #(apply str %) word-matches) 132 | str-part (apply str part) 133 | sliced (map #(string/split str-part (re-pattern %)) str-matches) 134 | counted (map #(count (first %)) sliced)] 135 | (first (sort counted)))) 136 | 137 | (defn- until-neg-char-match 138 | "returns the number of chars up to the first neg char match" 139 | [pattern part] 140 | (let [char-matches (extract-neg-char-matcher pattern)] 141 | (count (take-while #(some #{%} char-matches) part)))) 142 | 143 | (defn- until-pos-char-match 144 | "returns the number of chars up to the first pos char match" 145 | [pattern part] 146 | (let [char-matches (extract-pos-char-matcher pattern)] 147 | (count (take-while #(not (some #{%} char-matches)) part)))) 148 | 149 | (defn- drop-matched-star-chars 150 | "Drops chars in part up to the next known match in pattern. Returns remaining 151 | chars in part. If remaining chars list is empty then there's no match. 152 | Special cases when next known match is ? [ or {" 153 | [pattern part] 154 | (cond 155 | (and (= \[ (first pattern)) 156 | 157 | (= \! (second pattern))) (drop (until-neg-char-match pattern part) part) 158 | 159 | (and (= \[ (first pattern)) 160 | (not= \! (second pattern))) (drop (until-pos-char-match pattern part) part) 161 | 162 | (= \{ (first pattern)) (drop (until-word-match pattern part) part) 163 | :else (drop-while #(not (some #{%} (valid-next-chars pattern))) part))) 164 | 165 | (defn- match-star 166 | "Match zero or more chars. Not being greedy. 167 | foo*bar matches fooddddbar 168 | foo*[b] ;;;eeeeeeek!!! 169 | " 170 | [pattern part] 171 | (let [next-in-pattern (second pattern)] 172 | (if (nil? next-in-pattern) 173 | [[] [] true] 174 | (let [remaining (drop-matched-star-chars (rest pattern) part)] 175 | (if (empty? remaining) 176 | [[] [] false] 177 | [(rest pattern) remaining true]))))) 178 | 179 | (defn- match-basic-chars 180 | "match all basic non matcher chars in pattern and part" 181 | [pattern part] 182 | (loop [pattern pattern 183 | part part] 184 | (if (matcher-char? (first pattern)) 185 | [pattern part true] 186 | (if (and (empty? pattern) 187 | (empty? part)) 188 | [[] [] true] 189 | (if (= (first pattern) (first part)) 190 | (recur (rest pattern) (rest part)) 191 | [[] [] false]))))) 192 | 193 | (defn- negative-bracket-matcher? 194 | "Returns true if a negative bracket matcher is at front of pattern" 195 | [pattern] 196 | (= \! (second pattern))) 197 | 198 | (defn- match-positive-bracket 199 | "Match first postive bracket in pattern against part" 200 | [pattern part] 201 | (let [matcher (seq (extract-pos-char-matcher pattern))] 202 | (if (some #{(first part)} matcher) 203 | [(drop 1 (drop-while #(not= % \]) pattern)) (rest part) true] 204 | [[] [] false]))) 205 | 206 | (defn- match-negative-bracket 207 | "Match first negative bracket in pattern against part" 208 | [pattern part] 209 | (let [matcher (extract-neg-char-matcher pattern)] 210 | (if-not (some #{(first part)} matcher) 211 | [(drop 1 (drop-while #(not= % \]) pattern)) (rest part) true] 212 | [[] [] false]))) 213 | 214 | (defn- match-bracket 215 | "match one of the chars in the bracket. If the first char is a ! then 216 | negatively match." 217 | [pattern part] 218 | (if (negative-bracket-matcher? pattern) 219 | (match-negative-bracket pattern part) 220 | (match-positive-bracket pattern part))) 221 | 222 | (defn- match-brace 223 | "match one of the strings in brace" 224 | [pattern part] 225 | (let [pos-matches (extract-match-strings pattern)] 226 | (if-let [match (some #(string-matches? % part) pos-matches)] 227 | [(drop 1 (drop-while #(not= % \}) pattern)) (drop (count match) part) true] 228 | [[] [] false]))) 229 | 230 | (defn- match-next-section 231 | "Examines the next section from pattern and attempts to match it against part." 232 | [pattern part] 233 | (case (first pattern) 234 | \? (match-question-mark pattern part) 235 | \* (match-star pattern part) 236 | \[ (match-bracket pattern part) 237 | \{ (match-brace pattern part) 238 | (match-basic-chars pattern part))) 239 | 240 | (defn- normalize-pattern 241 | "manipulate pattern to simplify strange match-char sequences 242 | ab*******c => ab*c 243 | ab*??*?*c => \"ab???*c" 244 | [pattern-str] 245 | (let [pattern-str (string/replace pattern-str #"\*+" "*") 246 | pattern-str (string/replace pattern-str #"\*[*?]+" (fn [m] 247 | (let [str-a (seq m) 248 | num (count (filter #(= \? %) str-a))] 249 | (apply str (conj (vec (repeat num "?")) "*") ))))] 250 | pattern-str)) 251 | 252 | (defn- path-part-matches? 253 | "Match a path part with a pattern" 254 | [pattern part] 255 | (let [pattern (normalize-pattern pattern)] 256 | (if (empty? pattern) 257 | false ;;don't match an empty pattern 258 | (loop [pattern (seq pattern) 259 | part (seq part) 260 | matching? true] 261 | (if (not matching?) 262 | false ;;short-circuit if there's no match 263 | (if (and (empty? pattern) 264 | (empty? part) 265 | true) 266 | true 267 | (let [[pattern part matching?] (match-next-section pattern part)] 268 | (recur pattern part matching?)))))))) 269 | 270 | 271 | (defn- sub-container-names 272 | "Return a list of sub-containers names in the current handler (sub)tree. These 273 | are all the keys which are strings." 274 | [handler-tree] 275 | (filter #(string? %) (keys handler-tree))) 276 | 277 | (defn- children 278 | "Returns a seq of handler-tree's child [name sub-tree] pairs" 279 | [handler-tree] 280 | (map (fn [container-name] 281 | [container-name (get handler-tree container-name)]) 282 | (sub-container-names handler-tree))) 283 | 284 | (defn- find-all-pattern-matches 285 | [pattern-parts sub-tree path] 286 | (if (empty? pattern-parts) 287 | {path (:handler sub-tree)} 288 | (if (and (empty? pattern-parts) 289 | (not (empty? (sub-container-names sub-tree)))) 290 | nil 291 | (map (fn [[child-name child]] 292 | (if (path-part-matches? (first pattern-parts) child-name) 293 | (find-all-pattern-matches (rest pattern-parts) 294 | child 295 | (str path "/" child-name)))) 296 | (children sub-tree))))) 297 | 298 | (defn- unfold-matches 299 | "takes matches in the form ({\"/foo\" {:key h1 :key2 h2}}) and converts to 300 | [[\"/foo\" :key h1] [\"/foo\" :key2 h2]]" 301 | [matches] 302 | (let [result (map (fn [match] 303 | (map (fn [[path handlers]] 304 | (map (fn [[key handler]] [path key handler]) handlers)) 305 | match)) 306 | matches)] 307 | (partition 3 (flatten result)))) 308 | 309 | (defn- pattern-match-handlers 310 | "pattern match the path and return a list of [path key handler] matches." 311 | [path handler-tree] 312 | (let [path-parts (split-path path) 313 | matches (find-all-pattern-matches path-parts handler-tree "") 314 | matches (remove nil? (flatten [matches]))] 315 | (unfold-matches matches))) 316 | 317 | (defn- basic-match-handler 318 | "Basic non-pattern-matching retrieval of handler. Simply look up handler 319 | based on direct match with path. Returns a list of [path handler] match (or 320 | the empty list if no match found)." 321 | [path handlers] 322 | (let [path-parts (split-path path) 323 | handler-map (:handler (get-in handlers path-parts {}))] 324 | (if-let [method handler-map] 325 | [[path method]] 326 | []))) 327 | 328 | (defn matching-handlers 329 | "Returns a seq of matching handlers in the form [path key handler] " 330 | [path handlers] 331 | (if (contains-pattern-match-chars? path) 332 | (pattern-match-handlers path handlers) 333 | (basic-match-handler path handlers))) 334 | -------------------------------------------------------------------------------- /src/overtone/osc/peer.clj: -------------------------------------------------------------------------------- 1 | (ns overtone.osc.peer 2 | (:import [java.net InetSocketAddress DatagramSocket DatagramPacket] 3 | [java.util.concurrent TimeUnit TimeoutException PriorityBlockingQueue] 4 | [java.nio.channels DatagramChannel AsynchronousCloseException ClosedChannelException] 5 | [java.nio ByteBuffer] 6 | [javax.jmdns JmDNS ServiceListener ServiceInfo]) 7 | (:use [clojure.set :as set] 8 | [overtone.osc.util] 9 | [overtone.osc.decode :only [osc-decode-packet]] 10 | [overtone.osc.encode :only [osc-encode-msg osc-encode-bundle]] 11 | [overtone.osc.pattern :only [matching-handlers]]) 12 | (:require [overtone.at-at :as at-at] 13 | [clojure.string :as string])) 14 | 15 | (def zero-conf* (agent nil)) 16 | (def zero-conf-services* (atom {})) 17 | (defonce dispatch-pool (at-at/mk-pool)) 18 | 19 | (defn turn-zero-conf-on 20 | "Turn zeroconf on and register all services in zero-conf-services* if any." 21 | [] 22 | (send zero-conf* (fn [zero-conf] 23 | (if zero-conf 24 | zero-conf 25 | (let [zero-conf (JmDNS/create)] 26 | (doseq [service (vals @zero-conf-services*)] 27 | (.registerService zero-conf service)) 28 | zero-conf)))) 29 | :zero-conf-on) 30 | 31 | (defn turn-zero-conf-off 32 | "Unregister all zeroconf services and close zeroconf down." 33 | [] 34 | (send zero-conf* (fn [zero-conf] 35 | (when zero-conf 36 | (.unregisterAllServices zero-conf) 37 | (.close zero-conf)) 38 | nil)) 39 | :zero-conf-off) 40 | 41 | (defn unregister-zero-conf-service 42 | "Unregister zeroconf service registered with port." 43 | [port] 44 | (send zero-conf* (fn [zero-conf port] 45 | (swap! zero-conf-services* dissoc port) 46 | (let [service (get @zero-conf-services* port)] 47 | (when (and zero-conf zero-conf) 48 | (.unregisterService zero-conf service))) 49 | zero-conf) 50 | port)) 51 | 52 | (defn register-zero-conf-service 53 | "Register zeroconf service with name service-name and port." 54 | [service-name port] 55 | (send zero-conf* (fn [zero-conf service-name port] 56 | (let [service-name (str service-name " : " port) 57 | service (ServiceInfo/create "_osc._udp.local" 58 | service-name port 59 | (str "Clojure OSC Server"))] 60 | (swap! zero-conf-services* assoc port service) 61 | (when zero-conf 62 | (.registerService zero-conf service)) 63 | zero-conf)) 64 | service-name 65 | port)) 66 | 67 | (defn zero-conf-running? 68 | [] 69 | (if @zero-conf* 70 | true 71 | false)) 72 | 73 | (defn- recv-next-packet 74 | "Fills buf with the contents of the next packet and then decodes it into an 75 | OSC message map. Returns a vec of the source address of the packet and the 76 | message map itself. Blocks current thread if nothing to receive." 77 | [^DatagramChannel chan ^ByteBuffer buf] 78 | (.clear buf) 79 | (let [src-addr (.receive chan buf)] 80 | (when (pos? (.position buf)) 81 | (.flip buf) 82 | [src-addr (osc-decode-packet buf)]))) 83 | 84 | (defn- send-loop 85 | "Loop for the send thread to execute in order to send OSC messages externally. 86 | Reads messages from send-q, encodes them using send-buf and sends them out 87 | using the peer's send-fn extracted from send-q (send-q is expected to contain a 88 | sequence of [peer message]). If msg contains the key :override-destination it 89 | overrides the :addr key of peer to the new address for the delivery of the 90 | specific message." 91 | [running? ^PriorityBlockingQueue send-q ^ByteBuffer send-buf send-nested-osc-bundles?] 92 | (while @running? 93 | (if-let [res (.poll send-q 94 | SEND-LOOP-TIMEOUT 95 | TimeUnit/MILLISECONDS)] 96 | (let [[peer m] res 97 | new-dest (:override-destination m) 98 | peer (if new-dest 99 | (assoc peer :addr (atom new-dest)) 100 | peer)] 101 | 102 | (try 103 | (cond 104 | (osc-msg? m) (osc-encode-msg send-buf m) 105 | (osc-bundle? m) (osc-encode-bundle send-buf m send-nested-osc-bundles?)) 106 | (.flip send-buf) 107 | ((:send-fn peer) peer send-buf) 108 | (catch Exception e 109 | (print-debug "Exception in send-loop: " e "\nstacktrace: " 110 | (.printStackTrace e)))) 111 | ;; clear resets everything 112 | (.clear send-buf))))) 113 | 114 | (defn- dispatch-msg 115 | "Send msg to all listeners. all-listeners is a map containing the keys 116 | :listeners (a ref of all user-registered listeners which may resolve to the 117 | empty list) and :default (the default listener). Each listener is then 118 | extracted and called with the message as a param. Before invoking the 119 | listeners the source host and port are added to the message map." 120 | [all-listeners src msg] 121 | (let [msg (assoc msg 122 | :src-host (.getHostName src) 123 | :src-port (.getPort src)) 124 | listeners (vals @(:listeners all-listeners)) 125 | default-listener (:default all-listeners)] 126 | (doseq [listener (conj listeners default-listener)] 127 | (try 128 | (listener msg) 129 | (catch Exception e 130 | (print-debug "Listener Exception. Got msg - " msg "\n" 131 | (with-out-str (.printStackTrace e)))))))) 132 | 133 | (defn- dispatch-bundle 134 | "Extract all :items in the bundle and either handle the message if a normal 135 | OSC message, or handle bundle recursively. Schedule the bundle to be handled 136 | according to its timestamp." 137 | [all-listeners src bundle] 138 | (at-at/at (:timestamp bundle) 139 | #(doseq [item (:items bundle)] 140 | (if (osc-msg? item) 141 | (dispatch-msg all-listeners src item) 142 | (dispatch-bundle all-listeners src item))) 143 | dispatch-pool 144 | :desc "Dispatch OSC bundle")) 145 | 146 | (defn- listen-loop 147 | "Loop for the listen thread to execute in order to receive and handle OSC 148 | messages. Recieves packets from chan using buf and then handles them either 149 | as messages or bundles - passing the source information and message itself." 150 | [chan buf running? all-listeners] 151 | (while (not (.isBound (.socket chan))) 152 | (Thread/sleep 1)) 153 | (try 154 | (while @running? 155 | (try 156 | (let [[src pkt] (recv-next-packet chan buf)] 157 | (cond 158 | (osc-bundle? pkt) (dispatch-bundle all-listeners src pkt) 159 | (osc-msg? pkt) (dispatch-msg all-listeners src pkt))) 160 | (catch AsynchronousCloseException e 161 | (if @running? 162 | (do 163 | (print-debug "AsynchronousCloseException in OSC listen-loop...") 164 | (print-debug (.printStackTrace e))))) 165 | (catch ClosedChannelException e 166 | (if @running? 167 | (do 168 | (print-debug "ClosedChannelException in OSC listen-loop...") 169 | (print-debug (.printStackTrace e))))) 170 | (catch Exception e 171 | (print-debug "Exception in listen-loop: " e " \nstacktrace: " 172 | (.printStackTrace e))))) 173 | (finally 174 | (if (.isOpen chan) 175 | (.close chan))))) 176 | 177 | (defn- remove-handler 178 | "Remove the handler associated with the specified path within the ref 179 | handlers." 180 | [handlers path] 181 | (dosync 182 | (let [path-parts (split-path path) 183 | subtree (get-in @handlers path-parts)] 184 | (alter handlers assoc-in path-parts (dissoc subtree :handler))))) 185 | 186 | (defn- mk-default-listener 187 | "Return a fn which dispatches the passed in message to all specified handlers with 188 | a matching path." 189 | [handlers] 190 | (fn [msg] 191 | (let [path (:path msg) 192 | hs (matching-handlers path @handlers)] 193 | (doseq [[path handler] hs] 194 | (let [res (try 195 | ((:method handler) msg) 196 | (catch Exception e 197 | (print-debug "Handler Exception. Got msg - " msg "\n" 198 | (with-out-str (.printStackTrace e)))))] 199 | (when (= :done res) 200 | (remove-handler handlers path))))))) 201 | 202 | (defn- listener-thread 203 | "Thread which runs the listen-loop" 204 | [chan buf running? all-listeners] 205 | (let [t (Thread. #(listen-loop chan buf running? all-listeners))] 206 | (.start t) 207 | t)) 208 | 209 | (defn- sender-thread 210 | "Thread which runs the send-loop" 211 | [& args] 212 | (let [t (Thread. #(apply send-loop args))] 213 | (.start t) 214 | t)) 215 | 216 | (defn- chan-send 217 | "Standard :send-fn for a peer. Sends contents of send-buf out to the peer's 218 | :chan to the the address associated with the peer's ref :addr. :addr is typically 219 | added to a peer on creation. See client-peer and server-peer." 220 | [peer ^ByteBuffer send-buf] 221 | (let [{:keys [chan addr]} peer] 222 | (when-not @addr 223 | (throw (Exception. (str "No address to send message to.")))) 224 | (.send ^DatagramChannel chan send-buf @addr))) 225 | 226 | (defn bind-chan! 227 | "Bind a channel's datagram socket to its local port or the specified one if 228 | explicitly passed in." 229 | ([chan] 230 | (let [sock (.socket chan) 231 | local-port (.getLocalPort sock)] 232 | (.bind sock (InetSocketAddress. local-port)))) 233 | ([chan port] 234 | (let [sock (.socket chan)] 235 | (.bind sock (InetSocketAddress. port))))) 236 | 237 | (defn peer 238 | "Create a generic peer which is capable of both sending and receiving/handling 239 | OSC messages via a DatagramChannel (UDP). 240 | 241 | Sending: 242 | Creates a thread for sending packets out which which will pull OSC message 243 | maps from the :send-q, encode them to binary and send them using the fn in 244 | :send-fn (defaults to chan-send). Allowing the :send-fn 245 | to be modified allows for libraries such as Overtone to not actually transmit 246 | OSC packets out over the channel, but to send them via a different transport 247 | mechanism. 248 | 249 | Receiving/Handling: 250 | If passed an optional param listen? will also start a thread listening for 251 | incoming packets. Peers may have listeners and/or handlers registered to 252 | recieve incoming messages. A listener is sent every message received, and 253 | handlers are dispatched by OSC node (a.k.a. path). 254 | 255 | You must explicitly bind the peer's :chan to receive incoming messages." 256 | ([] (peer false true)) 257 | ([listen? send-nested-osc-bundles?] 258 | (let [chan (DatagramChannel/open) 259 | rcv-buf (ByteBuffer/allocate BUFFER-SIZE) 260 | send-buf (ByteBuffer/allocate BUFFER-SIZE) 261 | send-q (PriorityBlockingQueue. OSC-SEND-Q-SIZE 262 | (comparator (fn [a b] 263 | (< (:timestamp (second a)) 264 | (:timestamp (second b)))))) 265 | running? (ref true) 266 | handlers (ref {}) 267 | default-listener (mk-default-listener handlers) 268 | listeners (ref {}) 269 | send-thread (sender-thread running? send-q send-buf send-nested-osc-bundles?) 270 | listen-thread (when listen? 271 | (listener-thread chan rcv-buf running? {:listeners listeners 272 | :default default-listener}))] 273 | (.configureBlocking chan true) 274 | (with-meta 275 | {:chan chan 276 | :rcv-buf rcv-buf 277 | :send-q send-q 278 | :running? running? 279 | :send-thread send-thread 280 | :listen-thread listen-thread 281 | :default-listener default-listener 282 | :listeners listeners 283 | :handlers handlers 284 | :send-fn chan-send} 285 | {:type ::peer})))) 286 | 287 | (defn- num-listeners 288 | "Returns the number of listeners in a peer" 289 | [peer] 290 | (count (keys @(:listeners peer)))) 291 | 292 | (defn- peer-handler-paths* 293 | "Returns the number of handlers in a peer" 294 | [sub-tree path] 295 | (let [sub-names (filter #(string? %) (keys sub-tree)) 296 | curr (if (:method (:handler sub-tree)) [path] [])] 297 | (conj curr (reduce (fn [sum sub-name] 298 | (conj sum (peer-handler-paths* (get sub-tree sub-name) (str path "/" sub-name)))) 299 | [] 300 | sub-names)))) 301 | 302 | (defn peer-handler-paths 303 | "Returns the number of handlers in a peer" 304 | ([peer] (peer-handler-paths peer "/")) 305 | ([peer path] 306 | (let [path (split-path path) 307 | handlers @(:handlers peer) 308 | handlers (get-in handlers path)] 309 | (flatten (peer-handler-paths* handlers (apply str (interpose "/" path))))))) 310 | 311 | (defn- num-handlers 312 | "Returns the number of handlers in a peer" 313 | ([peer] (num-handlers peer "/")) 314 | ([peer path] 315 | (count (peer-handler-paths peer path)))) 316 | 317 | (defmethod print-method ::peer [peer w] 318 | (.write w (format "#" @(:running? peer) (if (:listen-thread peer) true false) (num-listeners peer) (num-handlers peer)))) 319 | 320 | (defn client-peer 321 | "Returns an OSC client ready to communicate with a host on a given port. 322 | Clients also listen for incoming messages (such as responses from the server 323 | it communicates with." 324 | ([host port] (client-peer host port true)) 325 | ([host port send-nested-osc-bundles?] 326 | (when-not (integer? port) 327 | (throw (Exception. (str "port should be an integer - got: " port)))) 328 | (when-not (string? host) 329 | (throw (Exception. (str "host should be a string - got:" host)))) 330 | (let [host (string/trim host) 331 | peer (peer :with-listener send-nested-osc-bundles?) 332 | chan (:chan peer)] 333 | (bind-chan! chan) 334 | (with-meta 335 | (assoc peer 336 | :host (ref host) 337 | :port (ref port) 338 | :addr (ref (InetSocketAddress. host port)) 339 | :send-nested-osc-bundles? send-nested-osc-bundles?) 340 | {:type ::client})))) 341 | 342 | (defmethod print-method ::client [peer w] 343 | (.write w (format "#" @(:host peer) @(:port peer) @(:running? peer) (num-listeners peer) (num-handlers peer)))) 344 | 345 | (defn update-peer-target 346 | "Update the target address of an OSC client so future calls to osc-send 347 | will go to a new destination. Also updates zeroconf registration." 348 | [peer host port] 349 | (when-not (integer? port) 350 | (throw (Exception. (str "port should be an integer - got: " port)))) 351 | (when-not (string? host) 352 | (throw (Exception. (str "host should be a string - got:" host)))) 353 | (let [host (string/trim host)] 354 | (when (:zero-conf-name peer) 355 | (unregister-zero-conf-service (:port peer))) 356 | 357 | (dosync 358 | (ref-set (:host peer) host) 359 | (ref-set (:port peer) port) 360 | (ref-set (:addr peer) (InetSocketAddress. host port))) 361 | 362 | (when (:zero-conf-name peer) 363 | (register-zero-conf-service (:zero-conf-name peer) port)))) 364 | 365 | (defn server-peer 366 | "Returns a live OSC server ready to register handler functions." 367 | ([port zero-conf-name] (server-peer port zero-conf-name true)) 368 | ([port zero-conf-name send-nested-osc-bundles?] 369 | (when-not (integer? port) 370 | (throw (Exception. (str "port should be an integer - got: " port)))) 371 | (when-not (string? zero-conf-name) 372 | (throw (Exception. (str "zero-conf-name should be a string - got:" zero-conf-name)))) 373 | (let [peer (peer :with-listener send-nested-osc-bundles?) 374 | chan (:chan peer)] 375 | (bind-chan! chan port) 376 | (register-zero-conf-service zero-conf-name port) 377 | (with-meta 378 | (assoc peer 379 | :send-nested-osc-bundles? send-nested-osc-bundles? 380 | :host (ref nil) 381 | :port (ref port) 382 | :addr (ref nil) 383 | :zero-conf-name zero-conf-name) 384 | {:type ::server})))) 385 | 386 | (defmethod print-method ::server [peer w] 387 | (.write w (format "#" (num-listeners peer) (num-handlers peer) @(:port peer) @(:running? peer)))) 388 | 389 | (defn close-peer 390 | "Close a peer, also works for clients and servers." 391 | [peer & wait] 392 | (when (:zero-conf-name peer) 393 | (unregister-zero-conf-service (:port peer))) 394 | (dosync (ref-set (:running? peer) false)) 395 | (.close (:chan peer)) 396 | (when wait 397 | (if (:listen-thread peer) 398 | (if (integer? wait) 399 | (.join (:listen-thread peer) wait) 400 | (.join (:listen-thread peer)))) 401 | (if (:send-thread peer) 402 | (if (integer? wait) 403 | (.join (:send-thread peer) wait) 404 | (.join (:send-thread peer)))))) 405 | 406 | (defn peer-send-bundle 407 | "Send OSC bundle to peer." 408 | [peer bundle] 409 | (when @osc-debug* 410 | (print-debug "osc-send-bundle: " bundle)) 411 | (.put ^PriorityBlockingQueue (:send-q peer) [peer bundle])) 412 | 413 | (defn peer-send-msg 414 | "Send OSC msg to peer" 415 | [peer msg] 416 | (when @osc-debug* 417 | (print-debug "osc-send-msg: " msg)) 418 | (.put ^PriorityBlockingQueue (:send-q peer) [peer (assoc msg :timestamp 0)])) 419 | 420 | (defn peer-reply-msg 421 | "Send OSC msg to peer" 422 | [peer msg msg-to-reply-to] 423 | (let [host (:src-host msg-to-reply-to) 424 | port (:src-port msg-to-reply-to) 425 | addr (InetSocketAddress. host port)] 426 | (when @osc-debug* 427 | (print-debug "osc-reply-msg: " msg " to: " host " : " port)) 428 | (.put ^PriorityBlockingQueue (:send-q peer) [peer (assoc msg :timestamp 0 :override-destination addr)]))) 429 | 430 | (defn- normalize-path 431 | "Clean up path. 432 | /foo//bar/baz -> /foo/bar/baz" 433 | [path] 434 | (let [path (string/trim path) 435 | path (string/replace path #"/{2,}" "/")] 436 | path)) 437 | 438 | (defn peer-handle 439 | "Register a new handler with peer on path. Replaces previous handler if one 440 | already exists." 441 | [peer path handler] 442 | (let [path (normalize-path path)] 443 | (when-not (string? path) 444 | (throw (IllegalArgumentException. (str "OSC handle path should be a string")))) 445 | (when (contains-pattern-match-chars? path) 446 | (throw (IllegalArgumentException. (str "OSC handle paths may not contain the following chars: " PATTERN-MATCH-CHARS)))) 447 | (when (.endsWith path "/") 448 | (throw (IllegalArgumentException. (str "OSC handle needs a method name (i.e. must not end with /)")))) 449 | (when-not (.startsWith path "/") 450 | (throw (IllegalArgumentException. (str "OSC handle needs to start with /")))) 451 | (let [handlers (:handlers peer) 452 | path-parts (split-path path) 453 | path-parts (concat path-parts [:handler])] 454 | (dosync (alter handlers assoc-in path-parts {:method handler}))))) 455 | 456 | (defn peer-recv 457 | "Register a one-shot handler with peer with specified timeout. If timeout is 458 | nil then timeout is ignored." 459 | [peer path handler timeout] 460 | (let [path (normalize-path path) 461 | p (promise)] 462 | (peer-handle peer path (fn [msg] 463 | (deliver p (handler msg)) 464 | :done)) 465 | (let [res (try 466 | (if timeout 467 | (.get (future @p) timeout TimeUnit/MILLISECONDS) ; Blocks until 468 | @p) 469 | (catch TimeoutException t 470 | nil) 471 | (catch RuntimeException rte 472 | (when-not (= TimeoutException (class (.getCause rte))) 473 | (throw rte))))] 474 | res))) 475 | 476 | 477 | (defn peer-rm-all-handlers 478 | "Remove all handlers from peer recursively down from path" 479 | [peer path] 480 | (let [path (normalize-path path) 481 | handlers (:handlers peer) 482 | path-parts (split-path path)] 483 | (dosync 484 | (if (empty? path-parts) 485 | (ref-set handlers {}) 486 | (alter handlers assoc-in path-parts {}))))) 487 | 488 | (defn peer-rm-handler 489 | "Remove handler from peer with specific key associated with path" 490 | [peer path] 491 | (let [path (normalize-path path) 492 | handlers (:handlers peer)] 493 | (remove-handler handlers path))) 494 | -------------------------------------------------------------------------------- /src/overtone/osc/util.clj: -------------------------------------------------------------------------------- 1 | (ns overtone.osc.util 2 | (:require [clojure.string :as str])) 3 | 4 | (defn print-debug [& msgs] 5 | (binding [*out* *err*] 6 | (apply println msgs))) 7 | 8 | (def osc-debug* (ref false)) 9 | 10 | (def SEND-LOOP-TIMEOUT 10000) ; ms 11 | (def OSC-SEND-Q-SIZE 512) ;;initial queue size 12 | (def OSC-TIMETAG-NOW 1) ; Timetag representing right now. 13 | (def BUFFER-SIZE 32768) 14 | (def PAD (byte-array 4)) 15 | (def PATTERN-MATCH-CHARS [" " "#" "*" "," "?" "[" "]" "{" "}"]) 16 | 17 | (defn contains-pattern-match-chars? 18 | "Returns true if str contains any pattern-match characters" 19 | [str] (some #(.contains str %) PATTERN-MATCH-CHARS)) 20 | 21 | ; TODO: Figure out how to detect a byte array correctly... 22 | (defn osc-type-tag 23 | "Generate a type tag for the argument list args. Each arg in args should be 24 | one of the following specific types and the type tag will consist of a series 25 | of consecutive chars representing the type of each arg in sequence. 26 | 27 | For example, an arg list of a string then three ints will generate a type tag 28 | of \"siii\" 29 | 30 | OSC Data Types: 31 | int => i 32 | * 32-bit big-endort an two's complement integer 33 | 34 | long => h 35 | * 64-bit big-endian two's complement integer 36 | 37 | float => f 38 | * 32-bit big-endian IEEE 754 floating point number 39 | 40 | string => s 41 | * A sequence of non-null ASCII characters followed by a null, followed by 0-3 42 | additional null characters to make the total number of bits a multiple of 43 | 32. 44 | 45 | blob => b 46 | * An int32 size count, followed by that many 8-bit bytes of arbitrary binary 47 | data, followed by 0-3 additional zero bytes to make the total number of 48 | bits a multiple of 32. 49 | 50 | OSC-timetag 51 | * 64-bit big-endian fixed-point timestamp" 52 | [args] 53 | (apply str 54 | (map (fn [arg] 55 | (condp = (type arg) 56 | Integer "i" 57 | Long "h" 58 | Float "f" 59 | Double "d" 60 | (type PAD) "b" ; This is lame... what is a byte array an instance of? 61 | String "s")) 62 | args))) 63 | 64 | 65 | (defn mk-osc-msg 66 | "Create an OSC message 67 | 68 | An OSC message consists of: 69 | * a path prefixed with / 70 | * a type tag prefixed with , (the , isn't stored in the map) 71 | * 0 or more args (where the number of args equals the number of types 72 | in the type tag" 73 | [path type-tag & args] 74 | (let [type-tag (if (and type-tag (.startsWith type-tag ",")) 75 | (.substring type-tag 1) 76 | type-tag)] 77 | (with-meta {:path path 78 | :type-tag type-tag 79 | :args args} 80 | {:type :osc-msg}))) 81 | 82 | (defn split-path 83 | "Takes an osc path and splits it to a seq of names 84 | (split-path \"/foo/bar/baz\") ;=> [\"foo\" \"bar\" \"baz\"]" 85 | [path] 86 | (rest (str/split path #"/"))) 87 | 88 | (defn mk-osc-bundle 89 | "Create an osc bundle. Throws exceptions if the timestamp and items aren't the 90 | correct types (number and list respectively)." 91 | [timestamp items] 92 | (when-not (number? timestamp) 93 | (throw (IllegalArgumentException. (str "OSC bundle timestamp param needs to be a number. Got: " (type timestamp) " - " timestamp)))) 94 | (when-not (sequential? items) 95 | (throw (IllegalArgumentException. (str "OSC bundle items param needs to be a list. Got: " (type items) " - " items)))) 96 | (with-meta {:timestamp timestamp 97 | :items items} 98 | {:type :osc-bundle})) 99 | 100 | (defn osc-msg? 101 | "Returns true if obj is an OSC message" 102 | [obj] 103 | (= :osc-msg (type obj))) 104 | 105 | (defn osc-bundle? 106 | "Returns true if obj is an OSC Bundle" 107 | [obj] 108 | (= :osc-bundle (type obj))) 109 | 110 | ; osc-type-tag defined in osc/internals 111 | (defn osc-msg-infer-types 112 | "Returns an OSC message. Infers the types of the args." 113 | [path & args] 114 | (apply mk-osc-msg path (osc-type-tag args) args)) 115 | -------------------------------------------------------------------------------- /test/bundle_test.clj: -------------------------------------------------------------------------------- 1 | (ns bundle-test 2 | (:use [osc] :reload) 3 | (:use [clojure.test]) 4 | (:import (java.nio ByteBuffer))) 5 | 6 | (def HOST "127.0.0.1") 7 | (def PORT 5432) 8 | 9 | (declare compare-packets) 10 | 11 | (defn compare-msgs [a b] 12 | (is (= (:path a) (:path b))) 13 | (is (= (count (:args a)) (count (:args b)))) 14 | (doseq [pair (map vector (:args a) (:args b))] 15 | (is (= (first pair) (second pair))))) 16 | 17 | (defn compare-bundles [a b] 18 | (is (= (:timestamp a) (:timestamp b))) 19 | (is (= (count (:items a)) (count (:items b)))) 20 | (doseq [packets (map vector (:items a) (:items b))] 21 | (apply compare-packets packets))) 22 | 23 | (defn compare-packets [a b] 24 | (if (osc-bundle? a) (compare-bundles a b) (compare-msgs a b))) 25 | 26 | (defn encode-decode-compare [packet] 27 | (let [buf (ByteBuffer/allocate 256) 28 | _ (osc-encode-packet buf packet) 29 | _ (.limit buf (.position buf)) 30 | _ (.position buf 0)] 31 | (compare-packets packet (osc-decode-packet buf)))) 32 | 33 | (deftest encode-decode-empty [] 34 | (encode-decode-compare (mk-osc-bundle OSC-TIMETAG-NOW []))) 35 | 36 | (deftest encode-decode-one [] 37 | (encode-decode-compare (mk-osc-bundle OSC-TIMETAG-NOW 38 | [(osc-msg-infer-types "/encode-decode-one" 39 | 1 (float 11.0) "encode-decode--one")]))) 40 | 41 | (deftest encode-decode-two [] 42 | (encode-decode-compare (mk-osc-bundle OSC-TIMETAG-NOW 43 | [(osc-msg-infer-types "/encode-decode-two" 44 | 1 (float 11.0) "encode-decode-two") 45 | (osc-msg-infer-types "/encode-decode-two" 46 | 2 (float 22.0) "encode-decode-two")]))) 47 | 48 | (deftest encode-decode-nested [] 49 | (encode-decode-compare (mk-osc-bundle OSC-TIMETAG-NOW 50 | [(osc-msg-infer-types "/encode-decode" 51 | 1 (float 11.0) "encode-decode") 52 | (mk-osc-bundle OSC-TIMETAG-NOW 53 | [(osc-msg-infer-types "/encode-decode-nested" 54 | 11 (float 111.0) "encode-decode-nested")]) 55 | (osc-msg-infer-types "/encode-decode" 56 | 2 (float 22.0) "encode-decode")]))) 57 | 58 | (deftest round-trip [] 59 | (let [server (osc-server PORT) 60 | client (osc-client HOST PORT) 61 | bundle (mk-osc-bundle OSC-TIMETAG-NOW 62 | [(osc-msg-infer-types "/round-trip/begin") 63 | (osc-msg-infer-types "/round-trip/data" 1 (float 11.0) "round-trip-data") 64 | (osc-msg-infer-types "/round-trip/end")]) 65 | recv-msg (atom nil)] 66 | (try 67 | (osc-handle server "/round-trip/data" (fn [msg] (reset! recv-msg msg))) 68 | (osc-send-bundle client bundle) 69 | (compare-packets (last (:items bundle)) (osc-recv server "/round-trip/end" 600)) 70 | (compare-packets (second (:items bundle)) @recv-msg) 71 | (finally 72 | (osc-close server true) 73 | (osc-close client true))))) 74 | 75 | (deftest round-trip-bundle-macro [] 76 | (let [server (osc-server PORT) 77 | client (osc-client HOST PORT) 78 | args [1 (float 11.0) "round-trip-data"] 79 | recv-msg (atom nil)] 80 | (try 81 | (osc-handle server "/round-trip/data" (fn [msg] (reset! recv-msg msg))) 82 | (in-osc-bundle client OSC-TIMETAG-NOW 83 | (osc-send client "/round-trip/begin") 84 | (apply osc-send client "/round-trip/data" args) 85 | (osc-send client "/round-trip/end")) 86 | (is (= "/round-trip/end" (:path (osc-recv server "/round-trip/end" 600)))) 87 | (is (= (count args) (count (:args @recv-msg)))) 88 | (doseq [pair (map vector args (:args @recv-msg))] 89 | (is (= (first pair) (second pair)))) 90 | (finally 91 | (osc-close server true) 92 | (osc-close client true))))) 93 | -------------------------------------------------------------------------------- /test/osc_test.clj: -------------------------------------------------------------------------------- 1 | (ns osc-test 2 | (:use osc 3 | clojure.test) 4 | (:import (java.nio ByteBuffer))) 5 | 6 | (def HOST "127.0.0.1") 7 | (def PORT (+ 1000 (rand-int 10000))) 8 | 9 | (def STR "test-string") 10 | 11 | (deftest osc-msg-test [] 12 | (let [buf (ByteBuffer/allocate 128) 13 | t-args [(make-array Byte/TYPE 20) 14 | 42 15 | (float 4.2) 16 | "qwerasdf" 17 | (double 123.23) 18 | (long 123412341234)] 19 | _ (osc-encode-msg buf (apply osc-msg "/asdf" "bifsdh" t-args)) 20 | _ (.position buf 0) 21 | {:keys [path args] :as msg} (osc-decode-packet buf) 22 | ] 23 | (is (= "/asdf" path)) 24 | (is (= (count t-args) (count args))) 25 | (is (= (ffirst t-args) (ffirst args))) 26 | (is (= (last (first t-args)) (last (first args)))) 27 | (is (= (next t-args) (next args))))) 28 | 29 | (deftest thread-lifetime-test [] 30 | (let [server (osc-server PORT) 31 | client (osc-client HOST PORT)] 32 | (osc-close client 100) 33 | (osc-close server 100) 34 | (is (= false (.isAlive (:send-thread server)))) 35 | (is (= false (.isAlive (:listen-thread server)))) 36 | (is (= false (.isAlive (:send-thread client)))) 37 | (is (= false (.isAlive (:listen-thread client)))))) 38 | 39 | (defn check-msg [msg path & args] 40 | (is (not (nil? msg))) 41 | (let [m-args (:args msg)] 42 | (is (= (:path msg) path)) 43 | (doseq [i (range (count args))] 44 | (is (= (nth m-args i) (nth args i)))))) 45 | 46 | (deftest osc-basic-test [] 47 | (is (= 1 1)) 48 | (let [server (osc-server PORT) 49 | client (osc-client HOST PORT) 50 | counter (atom 0)] 51 | (try 52 | (osc-handle server "/test" (fn [msg] (swap! counter + (first (:args msg))))) 53 | (dotimes [i 100] (osc-send client "/test" 1)) 54 | (Thread/sleep 400) 55 | (is (= 100 @counter)) 56 | 57 | (osc-send client "/foo" 42) 58 | (check-msg (osc-recv server "/foo" 600) "/foo" 42) 59 | (is (nil? (osc-recv server "/foo" 0))) 60 | (finally 61 | (osc-close server true) 62 | (osc-close client true))))) 63 | 64 | (defn osc-tests [] 65 | (binding [*test-out* *out*] 66 | (run-tests 'osc-test))) 67 | 68 | (defn test-ns-hook [] 69 | (osc-msg-test) 70 | (thread-lifetime-test) 71 | (osc-basic-test)) 72 | --------------------------------------------------------------------------------