tidal goodies ported to 1.0.x

init-1.0.0.hs

module Init where

-- import Sound.Tidal.SpectralTricks

-- import qualified Sound.Tidal.Scales as Scales

-- import qualified Sound.Tidal.Chords as Chords

import Sound.Tidal.Utils

import Sound.Tidal.Params

import Data.Maybe

import Control.Applicative

:def hoogle (\x -> return $ ":!/Users/jarm/Library/Haskell/bin/hoogle --info "++x)

-- FX groups
adsr = grp [mF "attack", mF "decay", mF "sustain", mF "release"]
del  = grp [mF "delay",   mF "delaytime", mF "delayfeedback"]
scc  = grp [mF "shape",   mF "coarse", mF "crush"]
lpf  = grp [mF "cutoff",  mF "resonance"]
bpf  = grp [mF "bandf",   mF "bandq"]
hpf  = grp [mF "hcutoff", mF "hresonance"]
spa  = grp [mF "speed",   mF "accelerate"]
rvb  = grp [mF "room",   mF "size"]
gco  = grp [mF "gain",    mF "cut", mF "orbit"]
go   = grp [mF "gain",    mF "orbit"]
io   = grp [mF "begin",   mF "end"]
eq   = grp [mF "cutoff", mF "resonance", mF "bandf", mF "bandq", mF "hcutoff", mF "hresonance"]
tremolo = grp [mF "tremolorate", mF "tremolodepth"]
phaser  = grp [mF "phaserrate", mF "phaserdepth"]
-- TODO: add SpectralTricks / SC FX groups
-- FX groups' function version
adsr' a d s r = attack a # decay d # sustain s # release r
del' l t f  = delay l # delaytime t # delayfeedback f
scc' s c c' = shape s # coarse c # crush c'
lpf' c r = cutoff c  # resonance r
bpf' f q = bandf f   # bandq q
hpf' c r = hcutoff c # hresonance r
spa' s a = speed s   # accelerate a
gco' g c o  = gain g # cut c # orbit o
go' g o  = gain g    # orbit o
rvb' r s = room r    # size s
io' i o  = begin i   # end o
eq h b l q = cutoff l # resonance q # bandf b # bandq q # hcutoff h # hresonance q
tremolo' r d = tremolorate r # tremolodepth d
phaser'  r d = phaserrate  r # phaserdepth  d

-- sequence generators
r = run
ri a = rev (r a) -- run inverted
-- rd a = (0 - (r a)) -- run down e.g. (10 - (r 10))
c = choose
cs i a = (segment i $ choose a)
odd    a = (((r a) + 1) * 2) - 1 -- run of odd numbers
even   a =  ((r a) + 1) * 2 -- run of even numbers
-- codd   a = c (patToList (odd   a)) -- choose odd
-- ceven  a = c (patToList (even  a)) -- choose even
oddi   a = rev (odd a) -- odd inverted
eveni  a = rev (even a) -- even inverted
-- coddi  a = rev (codd a) -- choose odd inverted
-- ceveni a = rev (ceven a) -- choose even inverted
-- TODO: primes ..?

-- transitions
j p n  = jumpIn' n
j2 p   = jumpIn' p 2
j4 p   = jumpIn' p 4
j8 p   = jumpIn' p 8
j16 p  = jumpIn' p 16
xf p n = xfadeIn  p n
xf2 p  = xfadeIn  p 2
xf4 p  = xfadeIn  p 4
xf8 p  = xfadeIn  p 8
xf16 p = xfadeIn  p 16
cl p n = clutchIn p n
cl2 p  = clutchIn p 2
cl4 p  = clutchIn p 4
cl8 p  = clutchIn p 8
cl16 p = clutchIn p 16
-- swash = superwash

-- continous function shorthands
sin = sine
cos = cosine
sq  = square
pulse w = sig $ \t -> if ((snd $ properFraction t) >= w) then 1.0 else 0.0
pulse' w = liftA2 (\a b -> if (a>=b) then 1.0 else 0.0) saw w
pw = pulse
pw' = pulse'

-- range shorthands
range' from to p = (p*to - p*from) + from
rg' = range'
rg  = range -- old: scale
rgx = rangex -- old: scalex

-- continuous at freq
sinf  f = fast f $ sin    -- sine at freq
cosf  f = fast f $ cos    -- cosine at freq
trif  f = fast f $ tri    -- triangle at freq
sawf  f = fast f $ saw   -- saw at freq
sqf   f = fast f $ sq     -- square at freq
pwf w f = fast f $ pw w -- pulse at freq
pwf' w f = fast f $ pw' w -- pulse' at freq
randf f = fast f $ rand   -- rand at freq

-- ranged continuous
rsin  i o = rg'  i o sin   -- ranged' sine
rcos  i o = rg'  i o cos   -- ranged' cosine
rtri  i o = rg'  i o tri   -- ranged' triangle
rsaw i o = rg'  i o saw   -- ranged' saw
rsq   i o = rg'  i o sq    -- ranged' square
-- rpw i o w = rg i o pw w -- ranged' pulse
-- rpw' i o w = rg' i o pw' w -- ranged' pulse'
rrand i o = rg' i o rand  -- ranged' rand
rxsin i o = rgx i o sin   -- ranged' exponential sine
rxcos i o = rgx i o cos   -- ranged' exponential cosine
rxtri i o = rgx i o tri   -- ranged' exponential triangle
rxsaw i o = rgx i o saw  -- ranged' exponential saw
rxsq  i o = rgx i o sq    -- ranged' exponential sqaure
rxpw i o w = rgx i o pw w -- ranged' exponential pulse
rxpw' i o w = rgx i o pw' w -- ranged' exponential pulse'
rxrand i o = rgx i o rand -- ranged' exponential rand

-- ranged continuous at freq
rsinf   i o f = fast f $ rsin   i o  -- ranged' sine at freq
rcosf   i o f = fast f $ rcos   i o  -- ranged' cosine at freq
rtrif   i o f = fast f $ rtri   i o  -- ranged' triangle at freq
rsawf  i o f = fast f $ rsaw   i o  -- ranged' saw at freq
rsqf    i o f = fast f $ rsq    i o  -- ranged' square at freq
-- rpwf i o w f = fast f $ rpw i o w -- ranged' pulse at freq
rrandf  i o f = fast f $ rrand  i o  -- ranged' rand at freq
rxsinf  i o f = fast f $ rxsin  i o  -- ranged' exponential sine at freq
rxcosf  i o f = fast f $ rxcos  i o  -- ranged' exponential cosine at freq
rxtrif  i o f = fast f $ rxtri  i o  -- ranged' exponential triangle at freq
rxsawf  i o f = fast f $ rxsaw i o  -- ranged' exponential saw at freq
rxsqf   i o f = fast f $ rxsq   i o  -- ranged' exponential square at freq
rxpwf i o w f = fast f $ rxpw i o w -- ranged' exponential pulse at freq
rxpwf' i o w f = fast f $ rxpw' i o w -- ranged' exponential pulse' at freq
rxrandf i o f = fast f $ rxrand i o  -- ranged' exponential random at freq

-- random shit
screw l c p = loopAt l $ chop c $ p
mute p = (const $ sound "~") p
toggle t f p = if (1 == t) then f $ p else id $ p
tog = toggle
t = tog
-- p2l = patToList
-- l2p = listToPat

-- sound bank protoype https://github.com/tidalcycles/Tidal/issues/231
-- bank p = with s_p (liftA2 (++) (p::Pattern String))
-- b = bank

-- extreme mode
str = striate
-- strL = striateL
str' = striate'
-- strL' = striateL'
fE = foldEvery
ev = every
oa = offadd
sp = speed
ac = accelerate
sl = slow
fa = fast
m = mute
i = id
g = gain
o = orbit
u = up
(>) = (#)
deg = degrade
degBy = degradeBy
-- disc = discretise
seg = segment

-- limit values in a Pattern to n equally spaced divisions of 1.
-- quantise' :: (Functor f, RealFrac b) => b -> f b -> f b
quantise' n = fmap ((/n) . (fromIntegral :: RealFrac b => Int -> b) . round . (*n))

-- continuous to x / x' (struct version)
c2f  t p = seg t $ p -- continuous to floats
c2f' t p = struct t $ p -- continuous to floats using struct
c2n  t p = quantise' 1 $ c2f t p -- continuous to "notes" (rounded floats)
c2n' t p = quantise' 1 $ c2f' t p -- continuous to "notes" (rounded floats) using struct

-- https://github.com/tidalcycles/Tidal/issues/439
-- c2m  s t p = scale s $ c2n t p -- continuous to "harmonic notes"
-- c2m' s t p = scale s $ c2n' t p -- continuous to "harmonic notes" using struct

-- harmony
chordTable = Chords.chordTable
scaleList = Scales.scaleList
majork = ["major", "minor", "minor", "major", "major", "minor", "dim7"]
minork = ["minor", "minor", "major", "minor", "major", "major", "major"]
doriank = ["minor", "minor", "major", "major", "minor", "dim7", "major"]
phrygiank = ["minor", "major", "major", "minor", "dim7", "major", "minor"]
lydiank = ["major", "major", "minor", "dim7", "major", "minor", "minor"]
mixolydiank = ["major", "minor", "dim7", "major", "minor", "minor", "major"]
locriank = ["dim7", "major", "minor", "minor", "major", "major", "minor"]
keyTable = [("major", majork),("minor", minork),("dorian", doriank),("phrygian", phrygiank),("lydian", lydiank),("mixolydian", mixolydiank),("locrian", locriank),("ionian", majork),("aeolian", minork)]
keyL p = (\name -> fromMaybe [] $ lookup name keyTable) <$> p

-- | @chord p@ turns a pattern of chord names into a pattern of
-- numbers, representing note value offsets for the chords
-- chord :: Num a => Pattern String -> Pattern a
chord p = flatpat $ Chords.chordL p
harmonise ch p = scale ch p + chord (flip (!!!) <$> p <*> keyL ch)