Cdr Police

cdr_police.clj

(ns ture.cdr-police
  (:require [overtone.live :refer :all :exclude [stop]]
            [leipzig.melody :refer :all]
            [leipzig.scale :as scale]
            [leipzig.canon :as canon]
            [leipzig.live :as live]
            [leipzig.live :refer [stop]]
            [leipzig.chord :as chord]
            [leipzig.temperament :as temperament]))

; Instruments
(definst kick [freq 440 volume 1.0]
  (-> (saw freq)
      (+ (sin-osc freq))
      (* (pink-noise))
      (* (env-gen (perc 0.001 0.03) :action FREE))
      (* 10)
      (clip2 0.4)
      (rlpf (* 440 7) 0.3)
      (* volume 0.3)))

(definst sting [freq 440 volume 1.0 dur 1.0]
  (-> (saw freq)
      (+ (square (* 1.001 freq)))
      (* (env-gen (adsr 0.0001 0.03 0.8 0.05)
                  (line:kr 1 0 dur) :action FREE))
      (rlpf (line:kr 1000 100 dur) 0.3)
      (* 99)
      (clip2 0.2)
      (* volume 0.3)))

(definst bass [freq 110 dur 220 volume 1.0]
  (-> (saw freq)
      (rlpf (line:kr 220 27.5 0.3) 0.2)
      (* (env-gen (perc 0.01 0.3) (line:kr 1 0 dur)))
      (+ (-> (square (* 0.5 freq))
             (lpf 110)
             (* (env-gen (adsr 0.01 0.3 0.5 0.1) (line:kr 1 0 dur) :action FREE))))
      (* volume)))

(definst organ [freq 440 dur 1 volume 1.0]
  (-> (+ (white-noise))
      (lpf (line:kr 1000 30 dur))
      (+ (saw freq))
      (rlpf (* 2 440) (+ 0.2 (* 0.9 (sin-osc 9) (line:kr 1 0.5 dur))))
      (clip2 0.9)
      (* 0.6 (+ (square 0.75) (square 1.5) (square 3)))
      (* (env-gen (adsr 0.66 0.4 0.1) (line:kr 1 0 dur) :action FREE))
      (* 1/5 volume)))

; Arrangement
(defmethod live/play-note :bass
  [{hertz :pitch seconds :duration}]
  (some-> hertz (bass :dur seconds)))

; Arrangement
(defmethod live/play-note :beat
  [{hertz :pitch}]
  (some-> hertz kick))

(defmethod live/play-note :mechanical
  [{hertz :pitch seconds :duration}]
  (some-> hertz (sting :dur seconds)))

(defmethod live/play-note :accompaniment
  [{hertz :pitch seconds :duration}]
  (some-> hertz (organ seconds)))

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

(def accompaniment
  (let [root (-> chord/triad (chord/inversion 2))]
    (->> (phrase (repeat 4)
                 [root
                  root
                  (-> chord/triad (chord/root -3))
                  (-> chord/triad (chord/root -1))
                  root
                  (-> root
                      (update :v (scale/from 0.5))
                      (assoc :+ -1))
                  (-> chord/triad (chord/root -3))
                  (-> chord/triad (chord/root -1))])
         (all :part :accompaniment))))

(defn bassline [root lead]
  (->> (phrase [1/2 3 1/2] [root root lead])
       (where :pitch (comp scale/lower scale/lower))
       (all :part :bass)))

(def beat
  (->> (phrase (cycle [3 1]) [nil 7 nil 7 nil 7 nil 6])
       (times 2)
       (all :part :beat)))

(def beat2
  (->> (phrase (cycle [3 1]) [nil 7 nil 7 nil 7 nil 7.5])
       (times 2)
       (all :part :beat)))

(def intro
  (->> (mapthen bassline progression [nil nil -2 nil nil nil -2 nil])
       (with accompaniment beat)))

(def accompaniment2
  (let [root (-> chord/triad (chord/inversion 2))]
    (->> (phrase [4 4 2 2 2 2 8 4 4]
                 [root
                  (-> chord/triad (chord/root -4))
                  (-> chord/triad (chord/root -1))
                  (-> chord/triad (chord/root -4))
                  (-> chord/triad (chord/root -5))
                  (-> chord/triad (chord/root -5) (update :i dec))
                  (-> root (chord/root -7))
                  (-> root (chord/root -6))
                  (-> root (chord/root -4))])
         (all :part :accompaniment))))

(def bassline2
  (->> (phrase [1/2 7/2 1/2 7/2 2 2 2 2 8 4 4]
               [0 0 -4 -4 -1 -4 -5 -6 -7 -6 -4])
       (where :pitch (comp scale/lower scale/lower))
       (all :part :bass)))

(def descent
  (->> accompaniment2
       (with bassline2)))

(def alt
  (let [accompaniment
        (phrase (repeat 4)
                     [(-> chord/triad (chord/root 2))
                      (-> chord/triad (chord/root 3))
                      (-> chord/triad (chord/root 6))
                      (-> chord/triad
                          (chord/root 5)
                          (chord/inversion 2)
                          (update :v (scale/from 0.5))
                          (update :iii (scale/from 0.5)))])
        finish (phrase [4 4 8 4 4]
                     [(-> chord/triad (chord/root 2))
                      (-> chord/triad (chord/root 3))
                      (-> chord/triad (chord/root 6))
                      (-> chord/triad (chord/root 1))
                      (-> chord/triad (chord/root 3))])]
    (->> accompaniment
         (times 2)
         (then finish)
         (all :part :accompaniment)
         (canon/canon #(->> % (all :part :bass))))))

(def finale
 (->> (phrase (repeat 1/2) (cycle [0 0 0 1]))
      (take 40)
      (all :part :mechanical)))

(def withdrawal
  (->> (phrase (repeat 1/2) (range 69 0 -1))
      (all :part :mechanical)))

(def melody
  (->> (phrase [1/2 1 1 1 5/2] [nil 2 3 2 1])
       (then (phrase [1/2 1 1 1 9/2] [3 1 2 0]))
       (then (phrase [1 1 5/2] [3 2 1]))
       (then (phrase [1/2 1 1 1 5/2] [3 1 2 0]))
       (then (phrase [1 1 1 1 1 1 5/2] [3 2 1 -1 2 1 0]))
       (tempo (partial * 2))
       (where :pitch (comp scale/lower scale/lower))
      (all :part :mechanical)))

(def phew
  (->> (phrase [4 4 4 4 4 4 4 8]
               [(-> chord/triad (chord/root 1))
                (-> chord/triad (chord/root 3) (chord/inversion 2))
                (-> chord/triad (chord/root 6) (chord/inversion 1))
                (-> chord/triad (chord/root 3))
                (-> chord/triad (chord/root 6) (chord/inversion 1))
                (-> chord/triad (chord/root 3) (chord/inversion 2))
                (-> chord/triad (chord/root 2)) ])
       (all :part :bass)))

(def phew-bass
  (->> (phrase (repeat 4) [-6 -4 -1 3 -1 -4 -5 -5])
       (where :pitch (comp scale/lower scale/lower))
       (all :part :bass)))

(def phew-melody
  (->> (phrase [2 2 3 1] [nil 6 5 4])
       (then (phrase [2 2 1 1 1 1] [7 6 3 4 3]))
       (times 2)
       (all :part :accompaniment)))

; Track
(def track
  (->>
    (->> intro (filter #(-> % :part (not= :bass))))
    (then (with (->> intro (then descent)) melody))
    (then (with alt beat2))
    (then (with (->> intro (then descent))
            (where :pitch scale/raise melody)))
    (then (with phew phew-bass phew-melody))
    (then (with phew phew-bass phew-melody (times 2 finale)))
    (where :pitch (comp scale/A scale/dorian))
    (then withdrawal)
    (where :pitch temperament/equal)
    (tempo (bpm 90))))

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

(comment
  ; Loop the track, allowing live editing.
  (live/jam (var track))
  (map fx-chorus [0 1])
  (live/play track)
  (recording-start "karma-police.wav")
  (recording-stop)
)