BootTidalCustom.hs

module BootTidalCustom 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)

bps b = setcps (b/2)
bpm b = setcps (b/2/120)

-- 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"] -- deprecated
-- bpf  = grp [mF "bandf",   mF "bandq"] -- deprecated
-- hpf  = grp [mF "hcutoff", mF "hresonance"] -- deprecated
spa  = grp [mF "speed",   mF "accelerate"]
rvb  = grp [mF "room",    mF "size"]
gco  = grp [mF "gain",    mF "cut", mF "orbit"]
glo  = grp [mF "gain",    mF "legato", 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
glo' g l o = gain g # legato l # 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

-- custom synth / param groups
-- ring' f r = ringf f # ring r
-- wah' f r = wahf f # wah r
-- superfmbass l f a = lfo l # modFreq f # modAmount a
-- bkfm a b c d e f = carPartial a # modPartial b # mul c # detune d # index e # nharm f
-- fmB a b c d e f = carPartial a # modPartial b # mul c # detune d # index e # nharm f

-- runs of numbers
r = run
ri a = rev (r a) -- run inverted
rodd a = (((r a) + 1) * 2) - 1 -- run of odd numbers
reven a = ((r a) + 1) * 2 -- run of even numbers
roddi a = rev (rodd a) -- run of odd numbers inverted
reveni a = rev (reven a) -- run of even numbers inverted

c = choose
codd a = c $ take a [1,3..] -- choose an odd number
ceven a = c $ take a [0,2..] -- choose an even number

-- TODO: primes ..?

-- transitions
j p n  = jumpIn' p 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
isawf f = fast f $ isaw -- inverted 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
risaw i o = rg' i o isaw -- ranged' inverted 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
rxisaw i o = rgx i o isaw -- ranged' exponential inverted 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
risawf i o f = fast f $ risaw i o  -- ranged' inverted 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
rxisawf i o f = fast f $ rxisaw i o -- ranged' exponential inverted 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

-- prime functions (not needed?)
-- ssin'  i o = sc'  i o sin  -- scaled' sine
-- scos'  i o = sc'  i o cos  -- scaled' cosine
-- stri'  i o = sc'  i o tri  -- scaled' triangle
-- ssaw' i o = sc'  i o saw  -- scaled' saw
-- ssq'   i o = sc'  i o sq   -- scaled' square
-- srand' i o = sc' i o rand  -- scaled' rand
-- ssinf' i o f = fast f $ ssin'   i o -- scaled' sine at freq
-- scosf' i o f = fast f $ scos'   i o -- scaled' cosine at freq
-- strif' i o f = fast f $ stri'   i o -- scaled' triangle at freq
-- ssawf' i o f = fast f $ ssaw'  i o -- scaled' saw at freq
-- ssqf'   i o f = fast f $ ssq'   i o -- scaled' square at freq
-- srandf' i o f = fast f $ srand' i o -- scaled' rand 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

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

-- shorthands
str = striate
str' = striate'
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
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))

-- convert continuous functions to floats, ints, melodies x / x' (struct version)
c2f  t p = seg t $ p -- continuous to floats
c2f' t p = struct t $ p -- continuous to structured floats
c2i  t p = quantise' 1 $ c2f t p -- continuous to ints
c2i' t p = quantise' 1 $ c2f' t p -- continuous to structured ints
c2m  s t p = scale s $ round <$> (c2f t p) -- continuous to melodic scale
c2m' s t p = scale s $ round <$> (c2f' t p) -- continuous to structured melodic scale

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

-- midi 
-- cc = grp [mF "ccn", mF "ccv"]
-- ccn :: Pattern Double -> ControlPattern
-- ccn = pF "ccn"
-- ccv :: Pattern Double -> ControlPattern
-- ccv = pF "ccv"
-- m val = range 0 127 $ val
toM val = rg 0 127 val
cc' p n = ccv (toM p) # ccn n

oldm p = (const $ sound "~") p

-- mute/solo
mutePatterns g = mapM (streamMute tidal) g
muteIntPatterns g = mutePatterns (map show g)
mutePatterns' s g = mutePatterns (fromJust $ lookup g s)
unmutePatterns g = mapM (streamUnmute tidal) g
unmuteIntPatterns g = unmutePatterns (map show g)
unmutePatterns' s g = unmutePatterns (fromJust $ lookup g s)
soloPatterns g = mapM (streamSolo tidal) g
soloPatterns' s g = soloPatterns (fromJust $ lookup g s)
unsoloPatterns g = mapM (streamUnsolo tidal) g
unsoloPatterns' s g = unsoloPatterns (fromJust $ lookup g s)
muteTrackPatterns t g = mapM (streamMute tidal) (map ((t ++ "-") ++) g)
muteTrackIntPatterns t g = muteTrackPatterns t (map show g)
muteTrackPatterns' t s g = muteTrackPatterns (fromJust $ lookup (map ((t ++ "-") ++) g) s)
unmuteTrackPatterns t g = mapM (streamUnmute tidal) (map ((t ++ "-") ++) g)
unmuteTrackIntPatterns t g = unmuteTrackPatterns t (map show g)
unmuteTrackPatterns' t s g = unmuteTrackPatterns (fromJust $ lookup (map ((t ++ "-") ++) g) s)
soloTrackPatterns t g = mapM (streamSolo tidal) (map ((t ++ "-") ++) g)
soloTrackPatterns' t s g = soloTrackPatterns (fromJust $ lookup (map ((t ++ "-") ++) g) s)
unsoloTrackPatterns t g = mapM (streamUnsolo tidal) (map ((t ++ "-") ++) g)
unsoloTrackPatterns' t s g = unsoloTrackPatterns (fromJust $ lookup (map ((t ++ "-") ++) g) s)
mp  = mutePatterns
md  = muteIntPatterns
mp' = mutePatterns'
ump = unmutePatterns
umd = unmuteIntPatterns
ump' = unmutePatterns'
-- sp = soloPatterns
-- sp' = soloPatterns'
usp = unsoloPatterns
usp' = unsoloPatterns'
mtp = muteTrackPatterns
mtd = muteTrackIntPatterns
mtp' = muteTrackPatterns'
umtp = unmuteTrackPatterns
umtd = unmuteTrackIntPatterns
umtp' = unmuteTrackPatterns'
stp = soloTrackPatterns
stp' = soloTrackPatterns'
ustp = unsoloTrackPatterns
ustp' = unsoloTrackPatterns'

-- naming patterns based on tracks
trackPatternName track patternName = p (track ++ "-" ++ patternName)
trackIntPattern track patternName = p (track ++ "-" ++ (show patternName))
tp = trackPatternName
td = trackIntPattern

-- named patterns or numbered patterns
track t mx dn ps p f = td t dn $ f $ (fromJust $ lookup p ps) # g (mx!!(dn-1)) # o (fromList [dn] -1)
track' t mx ps dn f = td t dn $ f $ (fromJust $ lookup dn ps) # g (mx!!(dn-1)) # o (fromList [dn] -1)
track'' t mx ps dn f = td t dn $ f $ (ps!!(dn-1)) # g (mx!!(dn-1)) # o (fromList [dn] -1)
tr = track
tr' = track'
tr'' = track''

-- apply function from map
f fs n = fromJust $ lookup n fs

-- custom instrument params
bowforce = pF "force" -- gil.fuser bow superbow
bowrate = pF "tremrate" -- gil.fuser bow superbow
bowdepth = pF "tremdepth" -- gil.fuser bow superbow

modind = pF "modind" -- gil.fuser rhodes superrhodes
-- mix = pF "mix" -- gil.fuser rhodes superrhodes
lfospeed = pF "lfospeed" -- gil.fuser rhodes superrhodes
lfodepth = pF "lfodepth" -- gil.fuser rhodes superrhodes

losslo = pF "losslo" -- gil.fuser stiff string superstring
losshi = pF "losshi" -- gil.fuser stiff string superstring
inharm = pF "inharm" -- gil.fuser stiff string superstring

-- getters and setters
setI = streamSetI tidal
setF = streamSetF tidal
setS = streamSetS tidal
setR = streamSetI tidal
setB = streamSetB tidal

-- ableton link
-- https://tidalcycles.org/index.php/Link_synchronisation
-- link = do sock <- carabiner tidal 4 (-0.1) . putStrLn "Starting Link synchronisation..."

-- old custom params to convert

-- custom param names
-- (accel,_)      = pF "accel"      (Just 0)
-- (bits,_)       = pI "bits"       (Just 0)
-- (carPartial,_) = pF "carPartial" (Just 0)
-- (detune,_)     = pF "detune"     (Just 0)
-- (fm,_)         = pF "fm"         (Just 0)
-- (fmf,_)        = pF "fmf"        (Just 0)
-- (fmod,_)       = pF "fmod"       (Just 0)
-- (freq,_)       = pI "freq"       (Just 80)
-- (index,_)      = pI "index"      (Just 0)
-- (kcutoff,_)    = pF "kcutoff"    (Just 0)
-- (krush,_)      = pF "krush"      (Just 0)
-- (modPartial,_) = pF "modPartial" (Just 0)
-- (modFreq,_)    = pF "modFreq"    (Just 100) -- bassfm
-- (modAmount,_)  = pF "modAmount"  (Just 100) -- bassfm
-- (mul,_)        = pF "mul"        (Just 0)
-- (nharm,_)      = pI "nharm"      (Just 0)
-- (noisy,_)      = pF "noisy"      (Just 0)
-- (rate,_)       = pI "rate"       (Just 1)
-- (ring,_)       = pF "ring"       (Just 0)
-- (ringf,_)      = pF "ringf"      (Just 0)
-- (slide,_)      = pI "slide"      (Just 0)
-- (slidefrom,_)  = pI "slidefrom"  (Just 1)
-- (vib,_)        = pI "vib"        (Just 0)
-- (wah,_)        = pF "wah"        (Just 0)
-- (wahf,_)       = pF "wahf"       (Just 0)
-- TODO: turn ^ intro groups

-- GlobalDirtEffect(\dirt_hall, [\hall, \hallfb, \hallpredelay, \hallcutoff, \halltail, \hallshift, \halldelay, \halldelayt, \halldelayfb]),
-- (hall, hall_p)                 = pF "hall"         (Nothing)
-- (hallfb, hallfb_p)             = pF "hallfb"       (Nothing)
-- (hallpredelay, hallpredelay_p) = pF "hallpredelay" (Nothing)
-- (hallcutoff, hallcutoff_p)     = pF "hallcutoff"   (Nothing)
-- (halltail, halltail_p)         = pF "halltail"     (Nothing)
-- (hallshift, hallshift_p)       = pF "hallshift"    (Nothing)
-- (halldelay, halldelay_p)       = pF "halldelay"    (Nothing)
-- (halldelayt, halldelayt_p)     = pF "halldelayt"   (Nothing)
-- (halldelayfb, halldelayfb_p)   = pF "halldelayfb"  (Nothing)
--
-- hallgrp h f c t s = hall h # hallfb f # hallcutoff c # halltail t # hallshift s
-- halldel p d t f   = hallpredelay p # halldelay d # halldelayt t # halldelayfb f

-- laurel
-- (string, string_p) = pF "string" (Nothing)