soundcodr

gistfile1.clj

(ns soundcodr.core
  (:use [overtone.live]
        [overtone.inst.synth]))

;;change these values to suit the environment:
;;------
(def NUM-SYNTHS 50)
(def LISTENING-PORT 57110)
;;------


(defonce s (osc-server LISTENING-PORT))
(defonce synths (atom []))

(defn slide-ctl
  "Slides synth s's ctl from start-val to end-val over time t with the
  supplied resolution in changes per second, defaulting to 60"
  ([s param-name id cur-val end-val time] (slide-ctl s param-name id cur-val end-val time 60))
  ([s param-name id cur-val end-val time resolution]
     (let [new-id      (uuid)
           start-val  (dosync (ref-set id new-id) @cur-val)
           slide-range (- end-val start-val)
           direction   (if (< slide-range 0) -1 1)
           slide-range (if (< slide-range 0) (* -1 slide-range) slide-range)
           num-msgs    (* resolution time)
           num-msgs    (if (< num-msgs 1) 1 num-msgs)
           step-size   (double (/ slide-range num-msgs))
           sleep-time  (/ 1000 resolution)]

       (loop []
         (let [inc-amount (* direction step-size)
               result     (dosync
                           (if (= @id new-id)
                             (if (case direction
                                       1 (>= @cur-val end-val)
                                       -1 (<= @cur-val end-val))
                               (do (ref-set cur-val end-val) nil)
                               (if (case direction
                                         1 (> (+ inc-amount @cur-val) end-val)
                                         -1 (< (+ inc-amount @cur-val) end-val))
                                 (ref-set cur-val end-val)
                                 (alter cur-val #(+ inc-amount %))))

                             nil))]
           (when (and result (not-empty @synths))
             (ctl s param-name result)
             (Thread/sleep sleep-time)
             (recur)))))))

(definst beep [note 60 vol 0]
  (let [src (sin-osc (midicps note))]
    (* vol src)))

(Thread/sleep 3000)

;;OSC Protocol
;;-------------
;;"/set-frequency", SynthID, Time, FrequencyString
;;"/set-volume", SynthID, Time, PercentageValue
;;"/set-frequency", 1, 0.5, "B5"
;;"/set-volume", 1, 0.5, 88
;;--------------

(defn ctl-note
  [synth-id target-note time]
  (let [synth-info  (nth @synths synth-id)
        synth       (:synth synth-info)
        note-id     (:note-id synth-info)
        cur-note    (:note synth-info)]
    (if synth-info
      (slide-ctl synth :note note-id cur-note target-note time)
      (println "ERROR: Attempted to control synth" synth-id "which doesn't exist"))))

(defn note-handler [msg]
  (let [synth-id    (nth (:args msg) 0)
        time        (nth (:args msg) 1)
        target-note (nth (:args msg) 2)
        target-note (resolve-note target-note)]
    (println "note msg" msg)
    (ctl-note synth-id target-note time)))

(defn ctl-vol
  [synth-id target-vol time]
  (let [synth-info (nth @synths synth-id)
        synth      (:synth synth-info)
        vol-id     (:vol-id synth-info)
        cur-vol    (:vol synth-info)]

    (if synth-info
      (slide-ctl synth :vol vol-id cur-vol target-vol time)
      (println "ERROR: Attempted to control synth" synth-id "which doesn't exist"))))

(defn vol-handler [msg]
  (let [synth-id   (nth (:args msg) 0)
        time       (nth (:args msg) 1)
        target-vol (nth (:args msg) 2)
        target-vol (/ target-vol 100)]
    (println "vol msg" msg)
    (ctl-vol synth-id target-vol time)))

(defn start-synths []
  (stop-synths)
  (dotimes [_ NUM-SYNTHS]
    (swap! synths conj {:synth (beep)
                         :note-id (ref nil)
                         :vol-id (ref nil)
                         :vol (ref 0)
                         :note (ref 60)})))

(defn stop-synths []
  (stop)
  (reset! synths []))

(defn stop-handler
  [msg]
  (stop-synths))

(defn start-handler
  [msg]
  (start-synths))

(osc-handle s "/set-frequency" #'note-handler)
(osc-handle s "/set-volume" #'vol-handler)
(osc-handle s "/stop" #'stop-handler)
(osc-handle s "/start" #'start-handler)

(start-synths)