startup-atom.hs

let (***) = foldl (|*|)
    (+++) = foldl (|+|)
    (###) = foldl (#)
    outside n f p = slow n $ f (density n p)
    every' n o f = when ((== o) . (`mod` n)) f
    withArc (s,e) f p = stack [sliceArc (0,s) p, f $ sliceArc (s,e) p, sliceArc (e,1) p]
    shiftArc (s,e) t = withArc (s,e) (t ~>)
    beginend bpat durpat = (begin bpat) # (end $ (+) <$> bpat <*> durpat)
    flange n t p = stack [ (toRational i*t) ~> p # begin (pure $ i/n) # end (pure $ (i+1)/n) | i <- [0..n-1] ]
    sometimesBy' x f p = (1024 ~>) $ sometimesBy x f p
    pingpongBy x fb tL tR cps f p = stack [ p,
                                 (tL ~> (f p)) # pan (pure $ (1-x)/2) |*| ddd,
                                 ((tL+tR) ~> (f p)) # pan (pure $ (x+1)/2) |*| ddd ]
              where ddd = delay (pure fb) |*| delaytime (pure $ fromRational $ (tL+tR)/cps) |*| delayfeedback (pure fb)
    pingpong = pingpongBy 1
    pingpong0 = pingpong 0
    padd = liftA2 (+)
    pfold op xs = foldl1 (liftA2 op) xs
    psum = pfold (+)
    rep = replicate
    juxp panpat f p = stack [p # pan panpat, f $ p # pan (fmap (1-) panpat)]
    take' n m xs = map (xs!!) [m..n+m-1]
    ngap n d = inside n (densityGap d)
    swing n = inside n (within (0.5,1) (0.3333 ~>))
    swingBy n x = inside n (within (0.5,1) (x ~>))
    swingEvery n e = inside n (every e $ within (0.5,1) (0.3333 ~>))
    necho x = echo $ negate x
    ntrip x = triple $ negate x
    somecyclesBy x = when (test x) -- cycle-by-cycle version of sometimesBy
      where test x c = (timeToRand $ fromIntegral c) < x
    somecycles = somecyclesBy 0.5
    creak n t p = stack [(x*(x+1)*t/2) ~> p | x <- take n [0..]]
    dropAfter x = within (x,1) (const silence)
    fractal3 = lindenmayer 30 "0:0-1-,1:22,2:-2--001-,-:-10-" "0"
    cyclerand n = Pattern $ \(s,e) -> [((s,e),(s,e),timeToRand $ fromIntegral $ (floor $ sam s) `mod` n)] -- a new random number each cycle, looping after n cycles
    cycleirand m n = Pattern $ \(s,e) -> [((s,e),(s,e), floor $ (*m) $ timeToRand $ fromIntegral $ (floor $ sam s) `mod` n)] -- a new random number each cycle, looping after n cycles
    doublejuxBy x fl fr p = stack[p, fl p # pan (pure $ 0.5-x/2), fr p # pan (pure $ 0.5+x/2)]
    doublejux = doublejuxBy 1
    decho t p = doublejux (t ~>) ((t+t/2) ~>) p
    nstep n sd str = Pattern $ \(s,e) -> arc (step sd $ take' n (floor (s+2048) * n) $ cycle str) (s,e) -- the 2048 is a workaround due to shifting from sometimesBy' or other sources
    scalex from to p = exp <$> scale (log from) (log to) p
    arp ns t p = stack $ map (tshift p) (zip (0:ns) (fmap (* t) [0.0 ..]))
      where tshift p (n,t) = t ~> (fmap (+n) p)
    arp' ns t p = stack $ map (tshift p) (zip ("0":ns) (fmap (* t) [0.0 ..]))
      where tshift p (n,t) = t ~> (padd p n)
    funrun m n = every 2 (fmap (+ m)) $ run n
    irand2 x y = fmap (+x) $ irand (y - x)
    rand' x = Pattern $ \a -> [(a, a, timeToRand $ (+ x/100) $ midPoint a)]
    quiet = const silence
    oct t = (echo (4*t)) . (quad t)
    pulsefunc::Double -> Time -> Double
    pulsefunc w t | (fromRational . snd $ properFraction t) < w = cos (2 * pi / w * fromRational t) * (negate 0.5) + 0.5
              | otherwise = 0
    pulse1 w = sig $ pulsefunc w
    randomPulse = Pattern $ \a@(s,e) -> arc (pulse1 $ timeToRand s) a
    skipslowspread n f xs = slowspread ($) (concatMap (\x -> (replicate (n-1) id) ++ [f x]) xs)
    mf x = fst $ pF x (Just 0)
    mi x = fst $ pI x (Just 0)
    fm = mf "fm"
    fmf = mf "fmf"
    modamp = mf "modamp"
    modfreq = mf "modfreq"
    feedback = mf "feedback"
    wub = mf "wub"
    wubn = mf "wubn"
    wubf = mf "wubf"
    wubw = mf "wubw"
    wubd = mf "wubd"
    wubt = mf "wubt"
    wubp = mf "wubp"
    wubv = mf "wubv"
    wrap = mf "wrap"
    wrapoff = mf "wrapoff"
    rect = mf "rect"
    rectoff = mf "rectoff"
    envsaw = mf "envsaw"
    envsawf = mf "envsawf"
    comp = mf "comp"
    compa = mf "compa"
    compr = mf "compr"
    distort = mf "distort"
    boom = mf "boom"
    gboom = mf "gboom"
    tape = mf "tape"
    taped = mf "taped"
    tapefb = mf "tapefb"
    tapec = mf "tapec"
    vibrato = mf "vibrato"
    vrate = mf "vrate"
    leslie = mf "leslie"
    lrate = mf "lrate"
    lsize = mf "lsize"
    perc = mf "perc"
    percf = mf "percf"
    gcutoff = mf "gcutoff"
    gresonance = mf "gresonance"
    wall = mf "wall"
    walllev = mf "walllev"
    krush = mf "krush"
    kcutoff = mf "kcutoff"
    ring = mf "ring"
    ringf = mf "ringf"
    octer = mf "octer"
    octersub = mf "octersub"
    octersubsub = mf "octersubsub"
    (fattack, fattack_p) = pF "fattack" (Just 0)
    (fhold, fhold_p) = pF "fhold" (Just 1)
    (frelease, frelease_p) = pF "frelease" (Just 0)
    (fenv, fenv_p) = pF "fenv" (Just 0)
    fmod = grp [fenv_p, fattack_p, fhold_p, frelease_p]
    flfo = mf "flfo"
    flfof = mf "flfof"
    (sfcutoff, sfcutoff_p) = pF "sfcutoff" (Just 1000)
    (sfresonance, sfresonance_p) = pF "sfresonance" (Just 0)
    (sfattack, sfattack_p) = pF "sfattack" (Just 0)
    (sfrelease, sfrelease_p) = pF "sfrelease" (Just 0)
    (sfenv, sfenv_p) = pF "sfenv" (Just 0)
    sfmod = grp [sfcutoff_p, sfresonance_p, sfenv_p, sfattack_p, sfrelease_p]
    minPent = [0,3,5,7,10]
    majPent = [0,2,4,7,9]
    ritusen = [0,2,5,7,9] --  another mode of major pentatonic
    egyptian = [0,2,5,7,10] -- another mode of major pentatonic
    kumai = [0,2,3,7,9]
    hirajoshi = [0,2,3,7,8]
    iwato = [0,1,5,6,10]
    chinese = [0,4,6,7,11]
    indian = [0,4,5,7,10]
    pelog = [0,1,3,7,8]
    prometheus = [0,2,4,6,11]
    scriabin = [0,1,4,7,9]
    gong = [0,2,4,7,9] -- han chinese pentatonic scales
    shang = [0,2,5,7,10]
    jiao = [0,3,5,8,10]
    zhi = [0,2,5,7,9]
    yu = [0,3,5,7,10]
    whole = [0,2..10] -- 6 note scales
    augmented = [0,3,4,7,8,11]
    augmented2 = [0,1,4,5,8,9]
    hexMajor7 = [0,2,4,7,9,11] -- hexatonic modes with no tritone
    hexDorian = [0,2,3,5,7,10]
    hexPhrygian = [0,1,3,5,8,10]
    hexSus = [0,2,5,7,9,10]
    hexMajor6 = [0,2,4,5,7,9]
    hexAeolian = [0,3,5,7,8,10]
    major = [0,2,4,5,7,9,11] -- 7 note scales
    ionian = [0,2,4,5,7,9,11]
    dorian = [0,2,3,5,7,9,10]
    phrygian = [0,1,3,5,7,8,10]
    lydian = [0,2,4,6,7,9,11]
    mixolydian = [0,2,4,5,7,9,10]
    aeolian = [0,2,3,5,7,8,10]
    minor = [0,2,3,5,7,8,10]
    locrian = [0,1,3,5,6,8,10]
    harmonicMinor = [0,2,3,5,7,8,11]
    harmonicMajor = [0,2,4,5,7,8,11]
    melodicMinor = [0,2,3,5,7,9,11]
    melodicMinorDesc = [0,2,3,5,7,8,10]
    melodicMajor = [0,2,4,5,7,8,10]
    bartok = [0,2,4,5,7,8,10]
    hindu = [0,2,4,5,7,8,10]
    todi = [0,1,3,6,7,8,11] -- raga modes
    purvi = [0,1,4,6,7,8,11]
    marva = [0,1,4,6,7,9,11]
    bhairav = [0,1,4,5,7,8,11]
    ahirbhairav = [0,1,4,5,7,9,10]
    superLocrian = [0,1,3,4,6,8,10] --
    romanianMinor = [0,2,3,6,7,9,10]
    hungarianMinor = [0,2,3,6,7,8,11]
    neapolitanMinor = [0,1,3,5,7,8,11]
    enigmatic = [0,1,4,6,8,10,11]
    spanish = [0,1,4,5,7,8,10]
    leadingWhole = [0,2,4,6,8,10,11] -- modes of whole tones with added note ->
    lydianMinor = [0,2,4,6,7,8,10]
    neapolitanMajor = [0,1,3,5,7,9,11]
    locrianMajor = [0,2,4,5,6,8,10]
    diminished = [0,1,3,4,6,7,9,10] -- 8 note scales
    diminished2 = [0,2,3,5,6,8,9,11]
    chromatic = [0..11] -- 12 note scales
    maj = [0,4,7] -- CHORDS
    min = [0,3,7]
    major7 = [0,4,7,11]
    dom7 = [0,4,7,10]
    minor7 = [0,3,7,10]
    aug = [0,4,8]
    dim = [0,3,6]
    dim7 = [0,3,6,9]
    one = [0]
    five = [0,7]
    plus = [0,4,8]
    sharp5 = [0,4,8]
    msharp5 = [0,3,8]
    sus2 = [0,2,7]
    sus4 = [0,5,7]
    six = [0,4,7,9]
    m6 = [0,3,7,9]
    sevenSus2 = [0,2,7,10]
    sevenSus4 = [0,5,7,10]
    sevenFlat5 = [0,4,6,10]
    m7flat5 = [0,3,6,10]
    sevenSharp5 = [0,4,8,10]
    m7sharp5 = [0,3,8,10]
    nine = [0,4,7,10,14]
    m9 = [0,3,7,10,14]
    m7sharp9 = [0,3,7,10,14]
    maj9 = [0,4,7,11,14]
    nineSus4 = [0,5,7,10,14]
    sixby9 = [0,4,7,9,14]
    m6by9 = [0,3,9,7,14]
    sevenFlat9 = [0,4,7,10,13]
    m7flat9 = [0,3,7,10,13]
    sevenFlat10 = [0,4,7,10,15]
    nineSharp5 = [0,1,13]
    m9sharp5 = [0,1,14]
    sevenSharp5flat9 = [0,4,8,10,13]
    m7sharp5flat9 = [0,3,8,10,13]
    eleven = [0,4,7,10,14,17]
    m11 = [0,3,7,10,14,17]
    maj11 = [0,4,7,11,14,17]
    evelenSharp = [0,4,7,10,14,18]
    m11sharp = [0,3,7,10,14,18]
    thirteen = [0,4,7,10,14,17,21]
    m13 = [0,3,7,10,14,17,21]
    toScale::[Int] -> Pattern Int -> Pattern Int
    toScale s p = (+) <$> fmap (s!!) notep <*> fmap (12*) octp
      where notep = fmap (`mod` (length s)) p
            octp  = fmap (`div` (length s)) p