zuse_z3

zuse_z3.R

## zuse_z3
## Copyright (C) 2011  Andreas Jansson <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/>.


# requires rmidi: https://github.com/andreasjansson/rmidi

# yamaha tg33
midi.tg33.bd_1 <- 36
midi.tg33.triangle_closed <- 37
midi.tg33.sd_1 <- 38
midi.tg33.triangle_open <- 39
midi.tg33.e_tom_1 <- 40
midi.tg33.e_tom_2 <- 41
midi.tg33.e_tom_3 <- 42
midi.tg33.e_tom_4 <- 43
midi.tg33.bd_2 <- 44
midi.tg33.bd_3 <- 45
midi.tg33.cross_sticks <- 46
midi.tg33.tom_1 <- 47
midi.tg33.tom_2 <- 48
midi.tg33.sd_2 <- 49
midi.tg33.tom_3 <- 50
midi.tg33.rim <- 51
midi.tg33.sd_3 <- 52
midi.tg33.tom_4 <- 53
midi.tg33.claps <- 54
midi.tg33.cowbell_1 <- 55
midi.tg33.shaker <- 56
midi.tg33.hh_closed <- 57
midi.tg33.crash_1 <- 58
midi.tg33.hh_open <- 59
midi.tg33.crash_2 <- 60
midi.tg33.splash <- 61
midi.tg33.cup <- 62
midi.tg33.ride <- 63
midi.tg33.low_conga <- 64
midi.tg33.high_conga <- 65
midi.tg33.mute_conga <- 66
midi.tg33.digiatack <- 67
midi.tg33.ooo <- 68
midi.tg33.low_timbales <- 69
midi.tg33.high_timbales <- 70
midi.tg33.tambourine <- 71
midi.tg33.finger_snaps <- 72
midi.tg33.claves <- 73
midi.tg33.low_agogo <- 74
midi.tg33.high_agogo <- 75
midi.tg33.low_cuica <- 76
midi.tg33.high_cuica <- 77
midi.tg33.low_whistle <- 78
midi.tg33.high_whistle <- 79
midi.tg33.bamboo <- 80
midi.tg33.bottle <- 81
midi.tg33.cowbell_2 <- 82
midi.tg33.crash <- 83
midi.tg33.sd_4 <- 84
midi.tg33.low_scratch <- 85
midi.tg33.sd_5 <- 86
midi.tg33.high_scratch <- 87
midi.tg33.reverse_cymbal <- 88
midi.tg33.slam_1 <- 89
midi.tg33.coin <- 90
midi.tg33.slam_2 <- 91
midi.tg33.water_drop <- 92
midi.tg33.low_timpani <- 93
midi.tg33.cracker <- 94
midi.tg33.high_timpani <- 95
midi.tg33.metal_hit <- 96


# midi note shortcuts
.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


midi.set.tempo(133)
ppq <- midi.get.ppq()

# in eight notes
riff.durations <- c(1, 2, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1) * ppq / 2
riff.ticks <- cumsum(c(0, riff.durations[1:(length(riff.durations) - 1)]))
riff.notes <- c(.e, .e, .e, .f, .f, .e, .e, .e, .e, .e, .f, .f)

riff1 <- midi.note(riff.ticks, ppq / 4, riff.notes + 12 * 3)
riff2 <- midi.note(rep(riff.ticks, each = 2) + c(0, ppq / 4), ppq / 4, rep(riff.notes + 12 * 3, each = 2) + c(12, 0))
riff.top <- midi.note(rep(riff.ticks, each=4), ppq / 4, rep(riff.notes, each=4) + 0:3 * 12 + 12 * 5, channel=3)

kick1 <- midi.note(riff.ticks, ppq / 2, midi.tg33.bd_1, channel = 1)
snare1 <- midi.note(0:6 * ppq * 2 + ppq, ppq, midi.tg33.sd_1, channel = 1)
clap1 <- midi.note(0:6 * ppq * 2 + ppq, ppq, midi.tg33.claps, channel = 5)
tom1 <- midi.note(0:6 * ppq * 2 + ppq, ppq, midi.tg33.tom_1, channel = 1)
hh1 <- midi.note(0:(7 * 4 - 1) * ppq / 4, ppq / 4, midi.tg33.hh_closed, channel = 1)
hh2 <- midi.note(0:(7 * 4 - 1) * ppq / 4, ppq / 6, midi.tg33.hh_open, channel = 1)

metal <- midi.note(c(0, 3, 4) * ppq, ppq, midi.tg33.metal_hit, channel = 1)

crash <- midi.note(0, ppq, midi.tg33.crash_1, channel = 5)
crash1 <- midi.note(0:13 * ppq, ppq, midi.tg33.crash_1, channel = 5)

snare2 <- midi.note(riff.ticks, ppq / 2, midi.tg33.sd_1, channel = 5)

scales <- list(c(.e, .b, .e + 12, .e + 24), 
               c(.d, .a, .f + 12, .f + 24),
               c(.c, .g, .g + 12, .g + 24),
               c(.c, .f, .a + 12, .a + 24),
               c(.b - 12, .e, .b + 12, .b + 24),
               c(.a - 12, .e, .cs + 24, .cs + 36))

arp.notes.indices <- function() runif(14 * 2, 1, 8)
arp.notes <- unlist(lapply(scales, function(x) { c(x, x + 36)[arp.notes.indices()] }))

arp1 <- midi.note(0:((14 * 6 * 2) - 1) * ppq / 4, ppq / 4, arp.notes + 12 * 5, channel=2)

scales2 <- list(c(.e, .f, .d, .b, .gs, .c), 
               c(.d, .c, .e, .b, .a, .f),
               c(.c, .g, .e, .b),
               c(.c, .f, .a, .b),
               c(.b, .e, .f, .gs, .d),
               c(.a, .e, .cs, .gs))

scales2.notes <- lapply(scales2, function(s) { unique(midi.scale(0:127, s)) })

i <- 70 + sample(0:12, 1)

mel.notes <- function() {
  unlist(lapply(scales2.notes, function(s) {
    first.index <- findInterval(i, s) + sample(c(-1, 1), 1)
    if(i < 60)
      prob.low <- .3
    else
      prob.low <- 1
    if(i > 80)
      prob.high <- .3
    else
      prob.high <- 1
    cs <- cumsum(c(first.index, sample(c(-2, -1, 1, 2), 7, replace=TRUE, prob=c(prob.low, prob.low, prob.high, prob.high))))
    i <<- s[cs[length(cs)]]
    c(s[cs])
  }))
}

mel1 <- function() { midi.note(rep((rep(c(0, 2, 3, 5), 12) + rep(0:11 * 7, each=4)) * ppq / 2, each=2), rep(c(2, 1, 2, 2) * ppq / 2, each=2), rep(mel.notes(), each = 2) + c(0, 12), channel=4)}

riff1.intro <- midi.seq(midi.rep.list(riff1, 2), ppq * 7)
kick1.intro <- midi.seq(midi.rep.list(kick1, 2), ppq * 7)
sn.intro <- midi.seq(midi.rep.list(snare1, 2), ppq * 14)
riff2.intro <- midi.seq(midi.rep.list(riff2, 4), ppq * 7)

metal <- midi.seq(midi.rep.list(metal, 6), ppq * 7)
kick1.short <- kick1
riff1.short <- riff1
riff1 <- midi.seq(midi.rep.list(riff1, 6), ppq * 7)
riff2 <- midi.seq(midi.rep.list(riff2, 6), ppq * 7)
kick1 <- midi.seq(midi.rep.list(kick1, 6), ppq * 7)
riff.top <- midi.seq(midi.rep.list(riff.top, 6), ppq * 7)
sn <- midi.seq(midi.rep.list(snare1, 3), ppq * 14)
crashes <- midi.seq(midi.rep.list(crash1, 3), ppq * 14)
cl <- midi.seq(midi.rep.list(clap1, 3), ppq * 14)
hh <- midi.seq(midi.rep.list(hh1, 6), ppq * 7)
hho <- midi.seq(midi.rep.list(hh2, 6), ppq * 7)
tom <- midi.seq(midi.rep.list(tom1, 3), ppq * 14)

p1 <- rbind(riff1.intro, kick1.intro)
p2 <- rbind(riff2.intro, kick1.intro, sn.intro)
p3 <- rbind(riff.top, kick1, arp1)
p4 <- rbind(riff2, sn, riff.top, kick1, arp1)
p5 <- rbind(crash, riff2, sn, riff.top, cl, hh, kick1, arp1)
p6 <- rbind(riff2, sn, riff.top, cl, hh, mel1(), kick1, arp1)
p7 <- rbind(crash, riff2, sn, riff.top, cl, hho, tom, mel1(), kick1, arp1)
p8 <- rbind(riff.top, hho, mel1(), arp1)
p9 <- rbind(riff2, sn, riff.top, hh, tom, kick1, arp1, metal)
p10 <- rbind(crashes, riff2, sn, riff.top, cl, hho, tom, kick1, arp1)
p11 <- rbind(crash, snare2, riff1.short, kick1.short)

arr.intro <- rbind(midi.seq(list(p1, p2), ppq * 7 * 2), metal)
arr <- midi.seq(list(arr.intro, p3, p4, p5, p6, p7, p8, p9, p10, p11), ppq * 7 * 6)

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



# helper framework attached below:

midi.transpose <- function(mat, steps)
{
  mat[,midi.cols.byte1] <- mat[,midi.cols.byte1] + steps
  return(mat)
}

midi.tick <- function(tick)
{
  return(midi.tick.at(1:length(tick), tick))
}

midi.tick.at <- function(position, tick)
{
  rows <- max(position)
  m <- midi.matrix(rows)
  m[position, midi.cols.tick] <- rep(tick, length.out = rows)
  return(m)
}

# returns a tick matrix
midi.tick.incremental <- function(iterations, events.count, increment)
{
  offset = 0
  ticks <- integer(0)
  for(i in 1:iterations) {
    ticks <- rbind(ticks, midi.tick(rep(offset,
      events.count[((i - 1) %% length(events.count)) + 1])))
    offset <- offset + increment[((i - 1) %% length(increment)) + 1]
  }
  return(ticks)
}

# takes a lists of matrices as its argument,
midi.seq <- function(matrices, increment)
{
  offset <- 0
  mat <- integer(0)
  i <- 1
  lapply(matrices, function(m) {
    mat <<- rbind(mat, midi.tick(rep(offset, nrow(m))) + m)
    offset <<- offset + increment[((i - 1) %% length(increment)) + 1]
    i <<- i + 1
  })
  return(mat)
}

# returns one matrix
midi.rep <- function(m, times)
{
  m.rep <- integer(0)
  for(i in (1:times))
    m.rep <- rbind(m, m.rep)
  return(m.rep)
}

midi.rep.function <- function(m, times)
{
  m.rep <- integer(0)
  for(i in (1:2))
    m.rep <- rbind(m(), m.rep)
  return(m.rep)
}

# returns a list of matrices
midi.rep.list <- function(m, times)
{
  l <- vector("list", times)
  l <- lapply(l, function(el) { m })
  return(l)
}

midi.rep.list.function <- function(m, times)
{
  l <- vector("list", times)
  l <- lapply(l, function(el) { m() })
  return(l)
}


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")
}

midi.split <- function(m, start, end)
{
  m <- m[m[,1] >= start & m[,1] < end,]
  m[,1] <- m[,1] - start
  return(m)
}