Skip to content

Instantly share code, notes, and snippets.

@ctford
Created December 15, 2018 11:01
Show Gist options
  • Save ctford/918ea46893d6b9b41f786ca84165f75a to your computer and use it in GitHub Desktop.
Save ctford/918ea46893d6b9b41f786ca84165f75a to your computer and use it in GitHub Desktop.
Cdr Police
(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)
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment