Whilst you were

song.clj

(ns whilst.song
  (:require [overtone.live :refer :all]
            [leipzig.melody :refer :all]
            [leipzig.scale :as scale]
            [leipzig.live :as live]
            [leipzig.chord :as chord]
            [leipzig.temperament :as temperament]))

; Instruments
(definst bass [freq 110 dur 1 volume 1.0]
  (-> (saw freq)
      (+ (* (env-gen (perc 0.1 dur)) (sin-osc (* 2 freq))))
      (* (env-gen (adsr 0.01 0.4 0.1) (line:kr 1 0 dur) :action FREE))
      (rlpf (* 4 freq) 0.3)
      (* 1/3 volume)))

(definst organ [freq 440 dur 1 volume 1.0]
  (-> (saw freq)
      (* (+ 1 (sin-osc 3) (sin-osc 2)))
      (rlpf (* 3 (+ (* (saw 12) freq 2) (* freq 2))) 0.3)
      (rlpf (+ (* (saw 12) freq 3) (* freq 5)) 0.5)
      (rlpf (* 2 (+ (* (saw 3) freq 2) (* freq 2))) 0.9)
      (* (env-gen (adsr 0.6 0.9 0.3) (line:kr 1 0 dur) :action FREE))
      (* 1/6 volume)))

(definst plink [freq 440 dur 1 volume 1.0]
  (-> (saw freq)
      (rhpf freq)
      (* 3)
      (clip2 0.5)
      (* (env-gen (adsr 0.001 0.4 0.04) (line:kr 1 0 dur) :action FREE))
      (* 1/4 volume)))

; Arrangement
(defmethod live/play-note :bass [{hertz :pitch seconds :duration}] (when hertz (bass hertz seconds)))
(defmethod live/play-note :chirp [{hertz :pitch seconds :duration}] (when hertz (bass hertz seconds 1/2)))
(defmethod live/play-note :chink [{hertz :pitch seconds :duration}] (when hertz (plink hertz seconds)))
(defmethod live/play-note :melody [{hertz :pitch seconds :duration}] (when hertz (plink hertz seconds 2)))
(defmethod live/play-note :accompaniment [{hertz :pitch seconds :duration}] (organ hertz seconds 1/2))

; Composition
(def progression [0 -1 -2 -1])

(defn bassline [sharp root]
  (let [third (if sharp 2.5 2)]
    (->> (phrase (cycle [7/4 1/4 1/2 1/4 1/4 1]) [0 7 -3 third 1 0 0 7 -3 third 3 4])
       (where :pitch (scale/from root))
       (where :pitch (comp scale/lower scale/lower))
       (all :part :bass))))

(defn accompaniment [root]
  (->>
    (phrase [4] [(-> chord/triad (chord/root root))])
    (times 2)
    (all :part :accompaniment)))

(def lead
  (->>
    (phrase [8] [(-> chord/seventh (chord/root -3) (update :iii (partial + 1/2)))])
    (all :part :accompaniment)))

(defn chink [root]
  (->>
    (phrase (concat (repeat 7 1/4) (repeat 2 1/8) (repeat 6 1/4) (repeat 4 1/8))
            (repeat root))
    (times 2)
    (all :part :chink)))

(def flunk
  (->>
    (phrase (cycle [1/2 1/2 1/2 1/4 1/4]) [2 1 0 -3 nil 4 5 4 0 -1])
    (times 8)
    (all :part :melody)))

(def sneak
  (->>
    (phrase (repeat 1/4) [7 8 6])
    (times 8)
    (then (phrase [3/2 5/2 12/2] [10 11 nil]))
    (times 2)
    (all :part :chirp)))

(def sneak2
  (->>
    (phrase (repeat 1/4) [7 8 6.5])
    (times 8)
    (all :part :chirp)))

(def sneak3
  (->>
    (phrase (repeat 1/4) [2 3 4])
    (times 32)
    (all :part :chirp)))

(def ping (mapthen chink [6 6 7 10]))

(def norm
  (->>
    (mapthen (partial bassline false) progression)
    (with (mapthen accompaniment progression))))

(def alt
  (->>
    norm
    (take-while #(-> % :time (< 24)))
 ;   (take-while #(-> % :part (not= :accompaniment)))
    (then
      (with
        (bassline true -3)
        sneak2
        lead
        (chink 6.5)))))

(def descent
  (let [bass (->>
               (phrase (repeat 8 8) (range -4 -8 -1))
               (all :part :bass))
        chords (->> (phrase (repeat 8)
                       [(-> chord/triad (chord/root -4) (update :iii (partial + 1/2)))
                        chord/triad
                        (-> chord/triad (chord/root -3) (update :iii (partial + 1/2)))
                        chord/triad])
                    (all :part :accompaniment))
        spark (mapthen chink [5.5 6 6.5 7])]
    (->> alt
         (then (with bass spark chords sneak3)))))

(def fin
  (->>
    (with
      (chink -3)
      (chink -0.5)
      (chink 1)
      (chink 3))
    (then
      (with
        (chink -3)
        (chink 0)
        (chink 2)
        (chink 4)
        (chink 7)))
    (take-while #(-> % :time (<= 12)))))

; Track
(def track
  (->>
    norm
    (then (with norm ping))
    (then (times 2 (with norm sneak flunk ping)))
    (then descent)
    (then norm)
    (then (with norm ping))
    (then (times 2 (with norm sneak flunk ping)))
    (then fin)
    (where :pitch (comp temperament/equal scale/D scale/minor))
    (tempo (bpm 90))))

(defn -main []
  (live/play track))

(comment
  ; Loop the track, allowing live editing.
  (live/jam (var track))
  (recording-start "whilst.wav")
  (live/play track)
  (recording-stop)
)