Orchestra: initial codebase

gistfile1.txt

;; This buffer is for notes you don't want to save, and for Lisp evaluation.
;; If you want to create a file, visit that file with C-x C-f,
;; then enter the text in that file's own buffer.

(ns overtone.studio.sequencer
  (:use [overtone.live]))

(defn- long?
  [val]
  (when (= Long (type val))
    val))

(defn- double?
  [val]
  (when (= Double (type val))
    val))

(defn- play-sample
  [samp time vol]
  (at time (stereo-player samp :vol vol)))

(defn determine-time
 [onset-time b-idx beat-dur num-beats]
 (+ onset-time (* b-idx beat-dur)))

(defn- extract-prob-and-vol
  [s]
  (let [prob (or (some double? s) 1.0)
        vol  (or (some long? s) 1)]
    [prob vol]))

(defn- schedule-all-beats
  [bar samp onset-time bar-dur]
  (let [num-beats (count bar)
        beat-dur (/ bar-dur num-beats)]
    (doall
     (map-indexed (fn [idx beat]
                    (cond
                     (= true beat)
                     (play-sample samp (determine-time onset-time idx beat-dur num-beats) 1)

                     (long? beat)
                     (play-sample samp (determine-time onset-time idx beat-dur num-beats) (/ beat 10))
                     (double? beat)
                     (when (< (rand) beat)
                       (play-sample samp (determine-time onset-time idx beat-dur num-beats) 1))

                     (set? beat)
                     (let [[prob vol] (extract-prob-and-vol beat)]
                       (when (< (rand) prob)
                         (play-sample samp (determine-time onset-time idx beat-dur num-beats) (/ vol 10))))

                     (sequential? beat)
                     (schedule-all-beats beat
                                         samp
                                         (determine-time onset-time idx beat-dur num-beats)
                                         beat-dur)))
                  bar))))

(defn play-rhythm
  ([patterns* bar-dur*] (play-rhythm patterns* bar-dur* (+ 500 (now)) 0))
  ([patterns* bar-dur* start-time beat-num]
     (let [patterns @patterns*
           bar-dur @bar-dur*]
       (doall
        (map (fn [[key [samp pat]]]
               (let [idx (mod beat-num (count pat))]
                 (schedule-all-beats (nth pat idx) samp start-time bar-dur)))
             patterns))
       (apply-at (+ start-time bar-dur) #'play-rhythm [patterns*
                                                       bar-dur*
                                                       (+ start-time bar-dur)
                                                       (inc beat-num)]))))



(def bar-dur (atom 1000))


(def _ false)
(def X true)

(defonce clients* (atom {}))
(defonce msg-log* (atom []))

(def hard-house (load-samples "~/Downloads/2618__ortaldj__100-poky-bumping-hardhouse/*.wav"))
(def ring-hat (load-sample "~/Downloads/12912__sweet-trip__mm-hat-op.wav"))
(def boom (load-sample "~/Downloads/33637__herbertboland__cinematicboomnorm.wav"))
(def wind (load-sample "~/Downloads/34338__erh__wind.wav"))
(def ambience (load-samples "~/Downloads/2122__yewbic__ambience/*.wav"))
(def snare (load-sample "~/Downloads/1655__vexst__amen-drum-kit/26901__vexst__snare-2.wav"))
(mono-player ring-hat)
(def bar-dur (atom 1000))


(def patterns* (atom   {:whizz [(nth hard-house 0) [[_]]]
                        :bop  [(nth hard-house 1) [[_]]]
                        :bum [(nth hard-house 2) [[_]]]
                        :bass-d [(nth hard-house 4) [[_]]]
                        :bup [(nth hard-house 6) [[_]]]
                        :boom [boom [[_]]]
                        :wind [wind [[_]]]
                        :amb1 [(nth ambience 0) [[_]]]
                        :amb2 [(nth ambience 1) [[_]]]
                        :amb3 [(nth ambience 2) [[_]]]
                        :amb4 [(nth ambience 3) [[_]]]
                        :amb5 [(nth ambience 4) [[_]]]
                        :amb6 [(nth ambience 5) [[_]]]
                        :amb7 [(nth ambience 6) [[_]]]
                        :amb8 [(nth ambience 7) [[_]]]
                        :snare [snare [[_]]]

                               }))

(play-rhythm patterns* bar-dur)

(defn update-pat!
  [key pat]
  (swap! patterns* (fn [patterns key new-pat]
                     (let [[samp pat] (get patterns key)]
                       (assoc patterns key [samp new-pat])))
         key pat))

(defn update-log!
  [log-msg]
  (swap! msg-log* conj log-msg)
  (dorun
   (for [[c-name c-info] @clients*]
     (do
       (osc-send (:osc-client c-info) "/log" (prn-str log-msg)))

)))

(defonce server (osc-server 7800))

(osc-handle server "/register-client"
            (fn [msg]
              (let [name (first (:args msg))
                    port (:src-port msg)
                    host (:src-host msg)
                    client (osc-client host port)]
                (swap! clients* assoc [host port] {:name name
                                                   :osc-client client}))))

(defn- get-client
  [host port]
  (let [clients @clients*]
    (get clients [host port])))

(defn- handle-msg
  [samp-name pat]
  (let [pat (read-string pat)]
    (update-pat! (keyword samp-name) pat)))

(osc-handle server "/new-pat" (fn [msg]
                                (let [samp-name (first (:args msg))
                                      pat       (second (:args msg))
                                      port      (:src-port msg)
                                      host      (:src-host msg)
                                      client    (get-client host port)
                                      log-msg   {(:name client) [:update-pat samp-name pat]}]
                                  (update-log! log-msg)
                                  (apply #'handle-msg [samp-name pat]))))

(def c (osc-client "localhost" 7800))

(osc-handle c "/log"
            (fn [msg]
              (println "Log: " (read-string (first (:args msg))))))

;;(osc-send c "/new-pat" "hi-piano" (prn-str [[2 5 7 1]]))

(defn pattern
  [c samp-name & pats]
  (osc-send c "/new-pat" (name samp-name) (prn-str pats))  )

;;(osc-send c "/register-client" "Sam")

(pattern c :whizz [_])
(pattern c :bup [0.4])

;;(Get @clients* ["localhost" 60597])

(stop)

;;(def client (:osc-client (first (vals @clients*))))




;; [*] Unify API - all OSC
;; [ ] Message log
;; [ ] Query state
;; [ ] Name patterns
;; [*] Randomness
;; [ ] Channel FX
;; [ ] Volume - per channel, global