palpitations

gistfile1.r

#    Palpitations
#    Copyright (C) 2012 <andreas@jansson.me.uk>
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.

# To play this song you need rmidi (https://github.com/andreasjansson/rmidi).
# General info and installation instructions here:
# https://github.com/andreasjansson/rmidi
# Once you have your environment set up with R, rmidi and a MIDI device,
# from the R command line, execute the play() function.

library(rmidi)

ppq <- midi.get.ppq()

midi.attach.notes()

get.real.durs <- function(durs) {
  (durs / 8) * ppq
}
get.starts <- function(durs) {
  real.durs <- get.real.durs(durs)
  cumsum(c(0, real.durs[1:(length(real.durs) - 1)]))
}
get.real.pitches <- function(pitches) {
  pitches + 63
}
steep.slope <- function(n) {
  n ^ .1
}

make.sparkle <- function(scale1, scale2) {
  notes <- c()
  starts <- c()
  channels <- c()

  n <- 5 * spark.amount
  distr <- dnorm((0:n - (n / 2)) / (n / spark.belliness))
  distr <- distr * (1 / max(distr)) / 1.3 + .05
  i8 <- 0:9 * (n / 10) + 1
  distr[i8] <- distr[i8] + .6
  distr <- pmin(distr, 1)

  pan.d <- dnorm((0:n - (n / 2)) / (n / 10))
  pan.d <- pan.d * (1 / max(pan.d))

  for(i in 0:(n - 1)) {
    rnd <- runif(1, 0, 1)
    d <- distr[i + 1]
    if(rnd < d) {
      octave <- floor(rnd * spark.octaves) - floor(spark.octaves / 2)
      if(i / n <= 3/5)
        scale <- scale1
      else
        scale <- scale2
      scale.ps <- 1 - (1 - d) * 1:length(scale) / length(scale)
      scale.ps <- scale.ps / sum(scale.ps)
      note <- sample(scale, 1, FALSE, scale.ps) + octave * 12
      notes <- c(notes, note)
      starts <- c(starts, floor((i / n) * 5 * ppq / 4))

      if(spark.max.channel > 1) {
        channel.ps <- 1 - (1 - pan.d[i + 1]) * steep.slope(0:(spark.max.channel - 1) / (spark.max.channel - 1))
        channel.ps <- channel.ps / sum(channel.ps)
        channels <- c(channels, sample(1:spark.max.channel, 1, FALSE, channel.ps))
      }
      else {
        channels <- c(channels, 1)
      }
    }
  }

  midi.note(starts, ppq / 8, get.real.pitches(notes), runif(length(starts), 100, 127), channels)
}

delay <- function(m, notes) {
  m[,1] <- m[,1] + ppq / 4 * notes
  m
}

repf <- function(f, times) {
  if(times == 0)
    c()
  else
    c(f(), repf(f, times - 1))
}

pitch1 <- c(Cs,E,Fs,E,Ds, Fs,Cs, Bs-12,A,Gs, E,Cs, B-12,Fs,Gs,Fs,Ds, E,  Fs,  Gs,B, A,Gs,Fs, Gs)
dur1   <- c(1, 1,1, 1,2,  2, 4,  2, 2,2,  2,4,  1,   1, 1, 1, 2/3,2/3,2/3, 4, 2,    3,1, 2,  6 )

root1 <- c(Fs, E, D, Cs, B-12, As-12, A-12, Gs-12)
mode1 <- c(0,  0, 1, 0,  1,    1,     0,    1    )

pitch2 <- c(A,Fs,E,Ds,E, Fs,Gs,E,Ds,Cs, D,A,D,Gs,Fs, E,Fs,Gs,E,Cs)
dur2   <- c(2,2, 2,2, 2, 1, 1, 2,2, 4,  2,2,2,2, 2,  1,1, 2, 2,4 )

scales2 <- list(c(Fs, A, E, Cs, Gs), c(B, Ds, A, Fs, Gs), c(E, Gs, Ds, B, Fs), c(A, Cs, Gs, E, Fs),
                c(A, C, G, E), c(Gs, B, Fs, Ds), c(Cs, B, Fs), c(G, B, F))

mel1 <- midi.note(get.starts(dur1), get.real.durs(dur1), get.real.pitches(pitch1), 127, 0)

bass1.1.pch <- c(0, 3, 2, 1) * 12 + Fs - 12
bass1.1 <- midi.note(get.real.durs(0:15 * 3), get.real.durs(3), get.real.pitches(bass1.1.pch), 127, 1)

bass1.2.pch <- c(0, 3, 2, 1) * 12 - 24 + rep(root1, each = 2)
bass1.2 <- midi.note(get.real.durs(0:15 * 3), get.real.durs(3), get.real.pitches(bass1.2.pch), 127, 1)
bass1.2.end <- midi.note(get.real.durs(0:14 * 3), get.real.durs(3), get.real.pitches(c(bass1.2.pch[1:14], Gs)), 127, 1)

bass1.3.pch <- c(0, 3, 2, 1, 2, 1) * 12 - 24 + rep(root1, each = 3)
bass1.3.dur <- rep(c(1, 2, 3), times = 8)
bass1.3 <- midi.note(get.starts(bass1.3.dur), get.real.durs(bass1.3.dur), get.real.pitches(bass1.3.pch), 127, 1)

third1.1.pch <- rep(0:2 * 12, length.out = 16) + rep(root1 + mode1 + 3, each = 2) - 24
third1.1.durs <- rep(c(2, 4), times = 8)
third1.1 <- midi.note(get.starts(third1.1.durs) + ppq / 8 + runif(16, -5, 5), get.real.durs(1), get.real.pitches(third1.1.pch), 127, 1)

third1.2.pch <- rep(0:3 * 12, length.out = 24) + rep(root1 + mode1 + 3, each = 3) - 24
third1.2.durs <- rep(c(2, 2, 2), times = 8)
third1.2 <- midi.note(get.starts(third1.2.durs) + ppq / 8 + runif(24, -5, 5), get.real.durs(1), get.real.pitches(third1.2.pch), 127, 1)
third1.3.pch <- rep(0:3 * 12, length.out = 24) + rep(root1 + mode1 + 3, each = 3) - 24
third1.3.durs <- rep(c(1, 3, 2), times = 8)
third1.3 <- midi.note(get.starts(third1.3.durs) + ppq / 8 + runif(24, -5, 5), get.real.durs(1), get.real.pitches(third1.3.pch), 127, 1)
mel2 <- midi.note(get.starts(dur2), get.real.durs(dur2), get.real.pitches(pitch2), 127, 0)

over2 <- midi.note(get.starts(dur2), get.real.durs(dur2), get.real.pitches(pitch2) + 12, 127, 6)

make.sparkles <- function(amount = 16, octaves = 7, max.channel = 5, bell = 6) {
  spark.amount <<- amount
  spark.octaves <<- octaves
  spark.max.channel <<- max.channel
  spark.belliness <<- bell

  rbind(
        make.sparkle(scales2[[1]], scales2[[2]]),
        delay(make.sparkle(scales2[[3]], scales2[[4]]), 5),
        delay(make.sparkle(scales2[[5]], scales2[[6]]), 10),
        delay(make.sparkle(scales2[[7]], scales2[[8]]), 15)
        )
}

arr1 <- rbind(mel1, bass1.1)
arr2 <- rbind(mel1, bass1.2)
arr3 <- rbind(mel2, make.sparkles(4, 3, 1, 7))
arr4 <- rbind(mel2, make.sparkles(8, 4, 3, 6))
arr5 <- rbind(mel1, bass1.2, third1.1)
arr6 <- rbind(mel1, bass1.2, third1.2)
arr7 <- rbind(mel2, over2, make.sparkles(12, 5, 5, 10))
arr8 <- rbind(mel2, over2, make.sparkles(16, 5, 5, 6))
arr9 <- rbind(mel1, bass1.3, third1.3)
arr10 <- rbind(mel1, bass1.2.end)

arr <- rbind(
             arr1,
             delay(arr2, 24),
             delay(arr3, 48),
             delay(arr4, 68),
             delay(arr5, 88),
             delay(arr6, 112),
             delay(arr7, 136),
             delay(arr8, 156),
             delay(arr9, 176),
             delay(arr10, 200))

play <- function() {
  midi.play(arr)
}

midi.detach.notes()


midi.attach.notes <- function()
{
  attach(list(Cb = midi.notes.cb,
              C = midi.notes.c,
              Cs = midi.notes.cs,
              Db = midi.notes.db,
              D = midi.notes.d,
              Ds = midi.notes.ds,
              Eb = midi.notes.eb,
              E = midi.notes.e,
              Es = midi.notes.es,
              Fb = midi.notes.fb,
              "F" =  midi.notes.f,
              Fs = midi.notes.fs,
              Gb = midi.notes.gb,
              G = midi.notes.g,
              Gs = midi.notes.gs,
              Ab = midi.notes.ab,
              A = midi.notes.a,
              As = midi.notes.as,
              Bb = midi.notes.bb,
              B = midi.notes.b,
              Bs = midi.notes.bs), name="midi.notes")

  # F = FALSE is in .GlobalEnv
  F <<- midi.notes.f
}

midi.detach.notes <- function()
{
  detach("midi.notes")
}