Skip to content
This repository
Browse code

Reworking events to support faster, synchronous handling, and to add …

…a handler key so we can re-register a handler on reload without having to use defonce. Now with tests :-)
  • Loading branch information...
commit cff0fd9b91e45d37a393599101ecda893824d941 1 parent 670817c
Jeff Rose rosejn authored
6 script/java-env
@@ -10,12 +10,16 @@ for f in "$DEPS"/*.jar; do
10 10 CLASSPATH=$CLASSPATH:$f
11 11 done
12 12
  13 +for dir in "checkouts"; do
  14 + CLASSPATH=$CLASSPATH:$dir/src
  15 +done
  16 +
13 17 # Attempted Windows compatibility
14 18 if [[ "$OSTYPE" == 'cygwin' ]]; then
15 19 CLASSPATH=`cygpath -wp "$CLASSPATH"`
16 20 fi
17 21
18   -DEFINES=-Djava.library.path=native/linux/x86,sun.java2d.opengl=True
  22 +DEFINES=-Djava.library.path=native/linux/x86,sun.java2d.opengl=False
19 23
20 24 # TODO: Tryout these args to use the parallel GC
21 25 #-XX:+UnlockExperimentalVMOptions -XX:+UseG1GC
2  script/ng-server
@@ -5,4 +5,4 @@ pkill -9 java
5 5 SCRIPT_DIR=`dirname $0`
6 6 JAVA_ENV=`$SCRIPT_DIR/java-env`
7 7
8   -exec java $JAVA_ENV com.martiansoftware.nailgun.NGServer 127.0.0.1
  8 +exec java $JAVA_ENV vimclojure.nailgun.NGServer 127.0.0.1
74 src/overtone/core/event.clj
@@ -11,53 +11,77 @@
11 11 (def NUM-THREADS (cpu-count))
12 12 (defonce thread-pool (Executors/newFixedThreadPool NUM-THREADS))
13 13 (defonce event-handlers* (ref {}))
  14 +(defonce sync-event-handlers* (ref {}))
14 15
15   -(defn on
  16 +; * Need to add a handler key for events
  17 +
  18 +(log/level :debug)
  19 +
  20 +(defn- on-event*
  21 + [handler-ref* event-type key handler]
  22 + (log/debug "adding-handler for " event-type)
  23 + (dosync
  24 + (let [handlers (get @handler-ref* event-type {})]
  25 + (alter handler-ref* assoc event-type (assoc handlers key handler))
  26 + true)))
  27 +
  28 +(defn on-event
16 29 "Runs handler whenever events of type event-type are fired. The handler can
17 30 optionally except a single event argument, which is a map containing the
18 31 :event-type property and any other properties specified when it was fired.
19 32
20   - (on ::booted #(do-stuff))
21   - (on ::midi-note-down (fn [event] (funky-bass (:note event))))
  33 + (on-event ::booted #(do-stuff))
  34 + (on-event ::midi-note-down (fn [event] (funky-bass (:note event))))
22 35
23 36 Handlers can return :done to be removed from the handler list after execution."
24   - [event-type handler]
25   - (log/debug "adding-handler for " event-type)
26   - (dosync
27   - (let [handlers (get @event-handlers* event-type #{})]
28   - (alter event-handlers* assoc event-type (conj handlers handler))
29   - true)))
  37 + [event-type key handler]
  38 + (on-event* event-handlers* event-type key handler))
  39 +
  40 +(defn on-sync-event
  41 + "Synchronously runs handler whenever events of type event-type are fired. The handler can
  42 + optionally except a single event argument, which is a map containing the
  43 + :event-type property and any other properties specified when it was fired."
  44 + [event-type key handler]
  45 + (on-event* sync-event-handlers* event-type key handler))
30 46
31 47 (defn remove-handler
32 48 "Remove an event handler previously registered to handle events of event-type.
33 49
34 50 (defn my-foo-handler [event] (do-stuff (:val event)))
35 51
36   - (on ::foo my-foo-handler)
  52 + (on-event ::foo my-foo-handler)
37 53 (event ::foo :val 200) ; my-foo-handler gets called with {:event-type ::foo :val 200}
38 54 (remove-handler ::foo my-foo-handler)
39 55 (event ::foo :val 200) ; my-foo-handler no longer called
40 56 "
41   - [event-type handler]
  57 + [event-type key]
42 58 (dosync
43   - (let [handlers (get @event-handlers* event-type #{})]
44   - (alter event-handlers* assoc event-type (difference handlers #{handler})))))
  59 + (doseq [handler-ref* [event-handlers* sync-event-handlers*]]
  60 + (let [handlers (get @handler-ref* event-type {})]
  61 + (alter handler-ref* assoc event-type (dissoc handlers key))))))
45 62
46 63 (defn clear-handlers
47 64 "Remove all handlers for events of type event-type."
48 65 [event-type]
49   - (dosync (alter event-handlers* dissoc event-type))
  66 + (dosync
  67 + (alter event-handlers* dissoc event-type)
  68 + (alter sync-event-handlers* dissoc event-type))
50 69 nil)
51 70
52 71 (defn- handle-event
53 72 "Runs the event handlers for the given event, and removes any handler that returns :done."
54   - [event]
  73 + [handlers* event]
55 74 (log/debug "handling event: " event)
56 75 (let [event-type (:event-type event)
57   - handlers (get @event-handlers* event-type #{})
58   - keepers (set (doall (filter #(not (= :done (run-handler % event))) handlers)))]
59   - (dosync (alter event-handlers* assoc event-type
60   - (intersection keepers (get @event-handlers* event-type #{}))))))
  76 + handlers (get @handlers* event-type {})
  77 + _ (log/debug "handlers: " handlers)
  78 + drop-keys (doall (map first
  79 + (filter (fn [[k handler]]
  80 + (= :done (run-handler handler event)))
  81 + handlers)))]
  82 + (dosync
  83 + (alter handlers* assoc event-type
  84 + (dissoc (get @handlers* event-type) drop-keys)))))
61 85
62 86 (defn event
63 87 "Fire an event of type event-type with any number of additional properties.
@@ -69,12 +93,6 @@
69 93 [event-type & args]
70 94 {:pre [(even? (count args))]}
71 95 (log/debug "event: " event-type args)
72   - (.execute thread-pool #(handle-event (apply hash-map :event-type event-type args))))
73   -
74   -(defn sync-event
75   - "Experimental synchronous event send."
76   - [event-type & args]
77   - {:pre [(even? (count args))]}
78   - (log/debug "synchronous event: " event-type args)
79   - (handle-event (apply hash-map :event-type event-type args)))
80   -
  96 + (let [event (apply hash-map :event-type event-type args)]
  97 + (handle-event sync-event-handlers* event)
  98 + (.execute thread-pool #(handle-event event-handlers* event))))
4 src/overtone/core/sample.clj
@@ -5,7 +5,7 @@
5 5 (:use (overtone.core synth ugen sc event util)))
6 6
7 7 ; Define a default wav player synth
8   -(defsynth mono-player
  8 +(defsynth mono-player
9 9 "Plays a single channel audio buffer."
10 10 [buf 0 rate 1.0 start-pos 0.0 loop? 0]
11 11 (out 0 (pan2
@@ -55,7 +55,7 @@
55 55 ;(println "loading sample: " path args)
56 56 (apply load-sample* path args)))
57 57
58   -(defonce _sample-handler_ (on :connected load-all-samples))
  58 +(on-event :connected :sample-loader load-all-samples)
59 59
60 60 (defn sample?
61 61 [s]
47 src/overtone/core/sc.clj
@@ -107,8 +107,9 @@
107 107
108 108 ; The base handler for receiving osc messages just forwards the message on
109 109 ; as an event using the osc path as the event key.
110   -(on ::osc-msg-received (fn [{{path :path args :args} :msg}]
111   - (event path :path path :args args)))
  110 +(on-sync-event ::osc-msg-received :osc-receiver
  111 + (fn [{{path :path args :args} :msg}]
  112 + (event path :path path :args args)))
112 113
113 114 (defn snd
114 115 "Sends an OSC message."
@@ -190,8 +191,8 @@
190 191 (log/debug (format "node-created: %d" id)))
191 192
192 193 ; Setup the feedback handlers with the audio server.
193   -(on "/n_end" #(node-destroyed (first (:args %))))
194   -(on "/n_go" #(node-created (first (:args %))))
  194 +(on-event "/n_end" :node-destroyer #(node-destroyed (first (:args %))))
  195 +(on-event "/n_go" :node-creator #(node-created (first (:args %))))
195 196
196 197 (def N-RETRIES 20)
197 198
@@ -225,7 +226,7 @@
225 226 (ref-set status* :connecting))
226 227
227 228 ; Runs once when we receive the first status.reply message
228   - (on "status.reply"
  229 + (on-event "status.reply" :connected-handler
229 230 #(do
230 231 (dosync (ref-set status* :connected))
231 232 (notify true) ; turn on notifications now that we can communicate
@@ -280,7 +281,7 @@
280 281 "Register your intent to wait for a message associated with given path to be received from the server. Returns a promise that will contain the message once it has been received. Does not block current thread (this only happens once you try and look inside the promise and the reply has not yet been received)."
281 282 [path]
282 283 (let [p (promise)]
283   - (on path #(do (deliver p %) :done))
  284 + (on-sync-event path (uuid) #(do (deliver p %) :done))
284 285 p))
285 286
286 287 (defn read-reply
@@ -318,9 +319,10 @@
318 319 []
319 320 (if (= :connected @status*)
320 321 (let [p (promise)]
321   - (on "/status.reply" #(do
322   - (deliver p (parse-status (:args %)))
323   - :done))
  322 + (on-event "/status.reply" :status-check
  323 + #(do
  324 + (deliver p (parse-status (:args %)))
  325 + :done))
324 326 (snd "/status")
325 327 (try
326 328 (.get (future @p) STATUS-TIMEOUT TimeUnit/MILLISECONDS)
@@ -367,11 +369,11 @@
367 369 :windows []
368 370 :mac ["-U" "/Applications/SuperCollider/plugins"] })
369 371
370   -(defonce _jack_connector_
371   - (if (= :linux (@config* :os))
372   - (on :connected #(connect-jack-ports))))
  372 +(if (= :linux (@config* :os))
  373 + (on-event :connected :jack-connector
  374 + #(connect-jack-ports)))
373 375
374   -(defonce scsynth-server* (ref nil))
  376 +(defonce scsynth-server* (ref nil))
375 377
376 378 (defn internal-booter [port]
377 379 (reset! running?* true)
@@ -392,7 +394,7 @@
392 394 (log/debug "Booting SuperCollider internal server (scsynth)...")
393 395 (.start sc-thread)
394 396 (dosync (ref-set server-thread* sc-thread))
395   - (on :booted connect)
  397 + (on-event :booted :on-boot-connector connect)
396 398 :booting))))
397 399
398 400 (defn- sc-log
@@ -448,7 +450,7 @@
448 450 "Quit the SuperCollider synth process."
449 451 []
450 452 (log/info "quiting supercollider")
451   - (sync-event :quit)
  453 + (event :quit)
452 454 (when (connected?)
453 455 (snd "/quit")
454 456 (log/debug "SERVER: " @server*)
@@ -680,10 +682,11 @@
680 682 for an example of usage.
681 683 "
682 684 [path handler]
683   - (on "/done" #(if (= path (first (:args %)))
684   - (do
685   - (handler)
686   - :done))))
  685 + (on-event "/done" :done-handler
  686 + #(if (= path (first (:args %)))
  687 + (do
  688 + (handler)
  689 + :done))))
687 690
688 691 ; TODO: Look into multi-channel buffers. Probably requires adding multi-id allocation
689 692 ; support to the bit allocator too...
@@ -808,7 +811,7 @@
808 811 (println "loading synthdef: " sname)
809 812 (snd "/d_recv" (synthdef-bytes sdef))))
810 813
811   -(defonce _synthdef-handler_ (on :connected load-all-synthdefs))
  814 +(on-event :connected :synthdef-loader load-all-synthdefs)
812 815
813 816 (defn load-synth-file
814 817 "Load a synth definition file onto the audio server."
@@ -824,9 +827,9 @@
824 827 []
825 828 (clear-msg-queue)
826 829 (group-clear SYNTH-GROUP) ; clear the synth group
827   - (sync-event :reset))
  830 + (event :reset))
828 831
829   -(defonce _connect-handler_ (on :connected #(group :tail ROOT-GROUP)))
  832 +(on-event :connected :root-group-creator #(group :tail ROOT-GROUP))
830 833
831 834 (defn restart
832 835 "Reset everything and restart the SuperCollider process."
4 src/overtone/studio.clj
@@ -14,14 +14,14 @@
14 14 (let [g (group :tail ROOT-GROUP)]
15 15 (dosync (ref-set inst-group* g))))
16 16
17   -(defonce _on-connect_ (on :connected create-inst-group))
  17 +(on-sync-event :connected :create-instruments create-inst-group)
18 18
19 19 ; Clear and re-create the instrument groups after a reset
20 20 (defn reset-inst-groups []
21 21 (doseq [inst @instruments*]
22 22 (group-clear (:group inst))))
23 23
24   -(defonce _reset_inst (on :reset #'reset-inst-groups))
  24 +(on-sync-event :reset :reset-instruments reset-inst-groups)
25 25
26 26 ; Add instruments to the session when defined
27 27 (defn add-instrument [inst]
0  test/config_test.clj → test/overtone/core/config_test.clj
File renamed without changes
35 test/overtone/core/event_test.clj
... ... @@ -0,0 +1,35 @@
  1 +(ns overtone.core.event-test
  2 + (:require [overtone.core.log :as log])
  3 + (:use overtone.core.event
  4 + clojure.test))
  5 +
  6 +(log/level :debug)
  7 +
  8 +(deftest handler-test
  9 + (let [counter (atom 0)]
  10 + (on-sync-event :test-event :a #(swap! counter inc))
  11 + (on-event :test-event :b #(swap! counter inc))
  12 + (event :test-event)
  13 + (Thread/sleep 100)
  14 + (is (= 2 @counter))
  15 +
  16 + (remove-handler :test-event :b)
  17 + (event :test-event)
  18 + (Thread/sleep 100)
  19 + (is (= 3 @counter))
  20 +
  21 + (on-event :test-event :x #(swap! counter inc))
  22 + (on-event :test-event :y #(swap! counter inc))
  23 + (on-event :test-event :z #(swap! counter inc))
  24 + (event :test-event)
  25 + (Thread/sleep 100)
  26 + (is (= 7 @counter))
  27 +
  28 + (clear-handlers :test-event)
  29 + (event :test-event)
  30 + (Thread/sleep 100)
  31 + (is (= 7 @counter))))
  32 +
  33 +(defn event-tests []
  34 + (binding [*test-out* *out*]
  35 + (run-tests 'overtone.core.event-test)))
0  test/sc_test.clj → test/overtone/core/sc_test.clj
File renamed without changes
0  test/synthdef_test.clj → test/overtone/core/synthdef_test.clj
File renamed without changes
0  test/util_test.clj → test/overtone/core/util_test.clj
File renamed without changes
0  test/studio_test.clj → test/overtone/studio_test.clj
File renamed without changes

0 comments on commit cff0fd9

Please sign in to comment.
Something went wrong with that request. Please try again.