Piano freak

song.clj

(ns piano-freak.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)
      (rlpf (line:kr 2000 freq dur) 0.5)
      (* (env-gen (perc 0.1 dur) :action FREE))
      (* volume)))

(definst organ [freq 440 dur 1 land 0.9 volume 1.0]
  (-> (square freq)
      (+ (sin-osc (* 3 freq) (sin-osc 6)))
      (+ (sin-osc (* 1/2 freq) (sin-osc 3)))
      (* (env-gen (adsr 0.03 0.3 0.4) (line:kr 1 0 dur) :action FREE))
      (* (sin-osc (* freq 2)))
      (clip2 (line:kr 1 land 16))
      (* volume)))

(definst drum [freq 220 volume 1.0]
  (-> (line:kr freq (* freq 1/2) 0.5)
      sin-osc 
      (+ (sin-osc freq))
      (+ (sin-osc (/ freq 2) (sin-osc 1)))
      (* (env-gen (perc 0.01 0.1) :action FREE))
      (* volume)))

(definst plink [freq 440 dur 1 volume 1.0]
  (-> (sin-osc freq) 
      (+ (* 1/3 (sin-osc (* freq 3))))
      (+ (* 1/5 (sin-osc (* freq 5.1))))
      (+ (* 1/6 (sin-osc (* freq 6.1))))
      (+ (* 1/8 (sin-osc (* freq 7.1))))
      (+ (* 1/8 (sin-osc (* freq 8))))
      (* (env-gen (perc 0.01 0.4) :action FREE))
      (* volume)))

; Arrangement
(defmethod live/play-note :bass [{hertz :pitch seconds :duration}]
  (bass hertz seconds))
(defmethod live/play-note :accompaniment [{hertz :pitch seconds :duration}]
  (organ hertz seconds 0.1 1/4))
(defmethod live/play-note :melody [{hertz :pitch seconds :duration volume :volume}]
  (plink hertz seconds (or volume 1)))
(defmethod live/play-note :vocal [{hertz :pitch seconds :duration volume :volume}]
  (organ hertz seconds 0.9 (or volume 1.0)))
(defmethod live/play-note :beat [{hertz :pitch volume :volume}]
  (drum hertz (or volume 1.0)))

; Composition
(def beat1
  (->>
    (phrase [1 1 1 1/3 1/3 1/3] [-7 -7 -7 -14 -14 -14])
    (having :volume [0.9 0.7 0.5 1 1 1])
    (times 4)
    (where :part (is :beat))))

(def beat2
  (->>
    (phrase [2/3 1/3 2/3 1/3 1 1] [-7 -7 -7 -7 -7 -7])
    (having :volume [1 1 1 1 0.8 0.7])
    (times 4)
    (where :part (is :beat))))

(def beat3
  (->>
    (phrase (repeat 1/3) [-7 -7 -7 -14 -14 -14])
    (times 2)
    (then (phrase [1 1 1 2/3 1/3] [-14 -14 -14 -14 -14]))
    (having :volume [1 1 1 1 1 1
                     1 1 1 1 1 1
                     0.8 0.6 0.5 0.4 0.4])
    (times 4)
    (where :part (is :beat))))

(def bassline
  (->> (phrase (repeat 4) [3 4 0 0])
       (where :pitch (comp scale/lower scale/lower))
       (where :part (is :bass))))

(def accompaniment
  (->>
    (phrase [16] [chord/seventh])
    (where :part (is :accompaniment))))

(def melody
  (->>
    (phrase [1/3 1/3 1/3 2/3 1/3] [0 1 0 -3 -3])
    (having :volume [1 0.5 0.4 0.3 0.3])
    (times 2)
    (where :part (is :melody))))

(def no-more-babies
  (let [rhyth [8/3 1/3 2/3 1/3 12/3]]
    (->>
    (phrase rhyth       [0 0 -1 0 -3])
    (then (phrase rhyth [-4 -5 -4 -3 -5]))
    (then (phrase rhyth [0 0 -1 0 -3]))
    (then (phrase rhyth [-4 -5 -4 -3 -5]))
    (having :volume (cycle [1 0.9 0.8 0.7 0.9]))
    (where :part (is :vocal)))))

(def no-more-maybes
  (->>
    (phrase [9/3 3/3 12/3] [0 -1 -3])
    (then (phrase [9/3 2/3 13/3] [-4 -5 -3]))
    (then (phrase [9/3 3/3 12/3] [0 -1 -3]))
    (then (phrase [9/3 2/3 13/3] [-4 -5 -7]))
    (having :volume (cycle [1 0.8 0.8 1 0.8 1]))
    (where :part (is :vocal))))

(def i-dont-really-know
  (->>
    (phrase (repeat 1/3) (mapcat #(list % 0 -3) [2 3 4 3 2 2 2 2]))
    (having :volume (cycle [1 0.4 0.4]))
    (times 2)
    (where :part (is :melody))))

(def tell-me-where
  (->>
    (phrase [1 1 1 1 4] [2 3 4 3 2])
    (then (phrase [1 1 1 1 4] [2 0 2 0 0]))
    (where :part (is :vocal))))

(def onlies [2 2 4 2 2 4 2 2 4 2 2 16])
(def lies [3 4 3 3 4 5 3 4 3 3 4 0])

(def if-only
  (->>
    (phrase onlies
            (map #(-> chord/triad (chord/root %)) lies))
    (where :part (is :accompaniment))))

(def i-could-be
  (->>
    (phrase onlies
            (map (partial + -3) lies))
    (having :volume (cycle [0.9 1 0.8
                            0.7 0.6 0.6]))
    (where :part (is :vocal))))

(def i-could-be-bass
  (->>
    (phrase onlies lies)
    (where :pitch (comp scale/lower scale/lower))
    (where :part (is :bass))))

(def finale 
  (->>
    (phrase (repeat 1/3)
            (interleave (repeat 4) [3 2 1 3 2 1
                                    3 2 1 2 1 0
                                    3 2 1 3 2 1]))
    (then (phrase [4] [0]))
    (having :volume (cycle [1 0.8 0.7 0.6 0.5 0.6]))
    (times 2)
    (where :part (is :melody))))

(def finalist
  (->>
    (phrase [1/3 3/3 3/3 2/3 3/3 1/6 1/6 8/3 1/3 3/3]
            [-3 0 2 3 2 1.5 1 0 chord/triad chord/triad])
    (after -1/3)
    (having :volume (cycle [0.8 1 0.9 0.8 0.8 0.7 0.6 0.7]))
    (times 2)
    (drop-last 7)
    (then (phrase [12/3] [0]))
    (times 2)
    (where :part (is :vocal))))

; Track
(def track
  (->>
    (times 2 (with bassline accompaniment melody beat1))
    (then (with no-more-babies (times 2 (with bassline accompaniment melody beat1))))
    (then (with no-more-maybes (times 2 (with bassline accompaniment melody beat1))))
    (then (times 2 (with bassline accompaniment i-dont-really-know tell-me-where beat2)))
    (then (with if-only i-could-be i-could-be-bass beat3))
    (then (with no-more-babies (times 2 (with bassline accompaniment melody beat1))))
    (then (with no-more-maybes (times 2 (with bassline accompaniment melody beat1))))
    (then (times 2 (with bassline accompaniment i-dont-really-know tell-me-where beat2)))
    (then (with if-only i-could-be i-could-be-bass beat3))
    (then (with finale (times 2 (with bassline accompaniment beat1))))
    (then (with finalist finale (times 2 (with bassline accompaniment beat1))))
    (where :pitch (comp temperament/equal scale/F scale/major))
    (where :time (bpm 90))
    (where :duration (bpm 90))))

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

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