Euclidean Guitars

gistfile1.txt

(ns overtone-workshop.core
  (:require [overtone.algo.euclidean-rhythm :refer [euclidean-rhythm]])
  (:require [overtone.synth.stringed :refer :all])
  (:require [overtone.live :refer :all]))

(use 'overtone.live)
;; http://quod.lib.umich.edu/cgi/p/pod/dod-idx/synthesizing-a-javanese-gong-ageng.pdf
(definst bell [frequency 440 duration 1.0 volume 1.0 position 0 wet 0.5 room 0.5
               h0 1 h1 0.6 h2 0.4 h3 0.25 h4 0.2]
  (let [harmonics   [ 1  2  3  4.2  5.4]
        proportions [h0 h1 h2   h3   h4]
        proportional-partial
        (fn [harmonic proportion]
          (let [envelope (* 1/5 (env-gen (perc 0.01 (* proportion duration))))
                overtone (* harmonic frequency)]
            (* 1/2 proportion envelope (sin-osc overtone))))
        partials
        (map proportional-partial harmonics proportions)
        whole (* 10 (mix partials))]
    whole))

;; ======================================================================
;; make a guitar
(def g (guitar))

;; ======================================================================
;; try out a bit of rhythmic accompanyment
;; http://www.youtube.com/watch?v=DV1ANPOYuH8
;; http://www.guitar.gg/strumming.html
(defn pattern-to-beat-strum-seq
    "given a string describing a one-measure up/down strum pattern like
      'ud-udu-', return a sequence of vector [beats :up/:down] pairs"
    [cur-pattern]
    (let [strums-per-measure (count cur-pattern)
                  beats-per-measure 4.0
                  beats-per-strum (/ beats-per-measure strums-per-measure)
                  ud-keywords {\u :up, \d :down}]
          (for [[i s] (map-indexed vector cur-pattern)]
                  (when (contains? ud-keywords s)
                            [(* i beats-per-strum) (ud-keywords s)]))))
(defn strum-pattern [the-guitar metro cur-measure cur-chord cur-pattern]
    (let [cur-beat (* 4 cur-measure)]
          (doall
                 (doseq [[b d] (pattern-to-beat-strum-seq cur-pattern)]
                          (when-not (= b nil)
                                     (guitar-strum the-guitar cur-chord d 0.07 (metro (+ b cur-beat))))))))

;; play a variety of different rhythm patterns.
(ctl g :pre-amp 10.0 :amp 1.0 :distort 0.0)
;; ======================================================================
;; ac/dc's highway to hell intro.  turn it up!
(defn ddd0 []
    (let [t (now) dt 250]
          (guitar-strum g [-1  0  2  2  2 -1] :down 0.01 (+ t (* 0 dt)))
          (guitar-strum g [-1  0  2  2  2 -1] :up   0.01 (+ t (* 1 dt)))
          (guitar-strum g [-1  0  2  2  2 -1] :down 0.01 (+ t (* 2 dt) 50))
          (guitar-strum g [-1 -1 -1 -1 -1 -1] :down 0.01 (+ t (* 3.5 dt)))))
(defn ddd1 []
    (let [t (now) dt 250]
          (guitar-strum g [ 2 -1  0  2  3 -1] :down 0.01 (+ t (* 0 dt)))
          (guitar-strum g [ 2 -1  0  2  3 -1] :up   0.01 (+ t (* 1 dt)))
          (guitar-strum g [ 3 -1  0  0  3 -1] :down 0.01 (+ t (* 2 dt) 50))
          (guitar-strum g [-1 -1 -1 -1 -1 -1] :down 0.01 (+ t (* 3.5 dt)))))
(defn ddd2 []
    (let [t (now) dt 250]
          (guitar-strum g [ 2 -1  0  2  3 -1] :down 0.01 (+ t (* 0 dt)))
          (guitar-strum g [-1 -1 -1 -1 -1 -1] :down 0.01 (+ t (* 1.5 dt)))
          (guitar-strum g [-1  0  2  2  2 -1] :down 0.01 (+ t (* 2 dt)))
          (guitar-strum g [-1  0  2  2  2 -1] :up   0.01 (+ t (* 3 dt)))
          (guitar-strum g [-1 -1 -1 -1 -1 -1] :down 0.01 (+ t (* 4.5 dt)))))
;; give us a good, crunchy sound
(ctl g :pre-amp 5.0 :distort 0.96
          :lp-freq 5000 :lp-rq 0.25
          :rvb-mix 0.5 :rvb-room 0.7 :rvb-damp 0.4)

;; ======================================================================
;; play with the one chord progression to rule them all
;; The I - V - vi - IV
;; (or C - G - Am - F)
(ctl g :pre-amp 4.0 :distort 0.5 :noise-amp 1.0
          :lp-freq 4000 :lp-rq 2.0
          :rvb-mix 0.45 :rvb-room 0.4 :rvb-damp 0.9)
(defn play1 [metro k N chord-list]
     (dotimes [n N]
            (doseq [[i cur-chord] (map-indexed vector chord-list)]
                     (let [cur-dir (choose [:up :down])
                                        cur-pattern (choose ["d-du-ud-"
                                                                                               "d-du-udu"
                                                                                               "d-d--udu"])]
                                (strum-pattern g metro (+ k (* 4 n) i) cur-chord cur-pattern)))))

;(bell)

(defn player [m num r sound]
  (at (m num)
      (if (= 1 (first r))
        (sound)
        ))
  (apply-at (m (inc num)) #'player [m (inc num) (next r) sound]))

(def notes (vec (map (comp midi->hz note) [:c3 :g3 :d3])))
;(player metro (metro) (cycle (euclidean-rhythm 3 8)) (partial sine-blip (notes 0)))
;(player metro (metro) (cycle (euclidean-rhythm 4 4)) (partial sine-blip (notes 1)))
;(player metro (metro) (cycle (euclidean-rhythm 5 13)) (partial sine-blip (notes 2)))
(player metro (metro) (cycle (euclidean-rhythm 3 8)) (partial bell :frequency 880))
(player metro (metro) (cycle (euclidean-rhythm 4 4)) (partial bell))
(player metro (metro) (cycle (euclidean-rhythm 5 13)) (partial bell))

;(stop)