module Sound.Tidal.Params where
import Sound.Tidal.Stream
import Sound.Tidal.Pattern
import qualified Data.Map as Map
import Sound.Tidal.Utils
import Control.Applicative
grp :: [Param] -> Pattern String -> ParamPattern
grp [] _ = silence
grp params p = (fmap lookupPattern p)
where lookupPattern :: String -> ParamMap
lookupPattern s = Map.fromList $ map (\(param,s') -> toPV param s') $ zip params $ (split s)
split s = wordsBy (==':') s
toPV :: Param -> String -> (Param, Value)
toPV param@(S _ _) s = (param, (VS s))
toPV param@(F _ _) s = (param, (VF $ read s))
toPV param@(I _ _) s = (param, (VI $ read s))
sound :: Pattern String -> ParamPattern
sound = grp [s_p, n_p]
s = sound
pF name defaultV = (make' VF param, param)
where param = F name defaultV
pI name defaultV = (make' VI param, param)
where param = I name defaultV
pS name defaultV = (make' VS param, param)
where param = S name defaultV
(accelerate, accelerate_p) = pF "accelerate" (Just 0)
(attack, attack_p) = pF "attack" (Just (1))
(bandf, bandf_p) = pF "bandf" (Just 0)
(bandq, bandq_p) = pF "bandq" (Just 0)
begin_p, channel_p, legato_p, clhatdecay_p, coarse_p, crush_p :: Param
begin, legato, clhatdecay, crush :: Pattern Double -> ParamPattern
channel, coarse :: Pattern Int -> ParamPattern
(begin, begin_p) = pF "begin" (Just 0)
(channel, channel_p) = pI "channel" Nothing
(legato, legato_p) = pF "legato" (Just 1)
(clhatdecay, clhatdecay_p) = pF "clhatdecay" (Just 0)
(coarse, coarse_p) = pI "coarse" (Just 0)
(crush, crush_p) = pF "crush" (Just 0)
(cut, cut_p) = pI "cut" (Just 0)
(cutoff, cutoff_p) = pF "cutoff" (Just 0)
(cutoffegint, cutoffegint_p) = pF "cutoffegint" (Just 0)
(decay, decay_p) = pF "decay" (Just 0)
(delay, delay_p) = pF "delay" (Just 0)
(delayfeedback, delayfeedback_p) = pF "delayfeedback" (Just (1))
(delaytime, delaytime_p) = pF "delaytime" (Just (1))
(detune, detune_p) = pF "detune" (Just 0)
(dry, dry_p) = pF "dry" (Just 0)
(end, end_p) = pF "end" (Just 1)
(gain, gain_p) = pF "gain" (Just 1)
(gate, gate_p) = pF "gate" (Just 0)
(hatgrain, hatgrain_p) = pF "hatgrain" (Just 0)
(hcutoff, hcutoff_p) = pF "hcutoff" (Just 0)
(hold, hold_p) = pF "hold" (Just 0)
(hresonance, hresonance_p) = pF "hresonance" (Just 0)
(kriole, kriole_p) = pI "kriole" (Just 0)
(lagogo, lagogo_p) = pF "lagogo" (Just 0)
(lclap, lclap_p) = pF "lclap" (Just 0)
(lclaves, lclaves_p) = pF "lclaves" (Just 0)
(lclhat, lclhat_p) = pF "lclhat" (Just 0)
(lcrash, lcrash_p) = pF "lcrash" (Just 0)
(lfo, lfo_p) = pF "lfo" (Just 0)
(lfocutoffint, lfocutoffint_p) = pF "lfocutoffint" (Just 0)
(lfodelay, lfodelay_p) = pF "lfodelay" (Just 0)
(lfoint, lfoint_p) = pF "lfoint" (Just 0)
(lfopitchint, lfopitchint_p) = pF "lfopitchint" (Just 0)
(lfoshape, lfoshape_p) = pF "lfoshape" (Just 0)
(lfosync, lfosync_p) = pF "lfosync" (Just 0)
(lhitom, lhitom_p) = pF "lhitom" (Just 0)
(lkick, lkick_p) = pF "lkick" (Just 0)
(llotom, llotom_p) = pF "llotom" (Just 0)
(lock, lock_p) = pF "lock" (Just 0)
(loop, loop_p) = pF "loop" (Just 1)
(lophat, lophat_p) = pF "lophat" (Just 0)
(lsnare, lsnare_p) = pF "lsnare" (Just 0)
(n, n_p) = pI "n" (Just 0)
degree, mtranspose, ctranspose, harmonic, stepsPerOctave, octaveRatio :: Pattern Double -> ParamPattern
degree_p, mtranspose_p, ctranspose_p, harmonic_p, stepsPerOctave_p, octaveRatio_p :: Param
(degree, degree_p) = pF "degree" Nothing
(mtranspose, mtranspose_p) = pF "mtranspose" Nothing
(ctranspose, ctranspose_p) = pF "ctranspose" Nothing
(harmonic, harmonic_p) = pF "ctranspose" Nothing
(stepsPerOctave, stepsPerOctave_p) = pF "stepsPerOctave" Nothing
(octaveRatio, octaveRatio_p) = pF "octaveRatio" Nothing
(nudge, nudge_p) = pF "nudge" (Just 0)
(octave, octave_p) = pI "octave" (Just 3)
(offset, offset_p) = pF "offset" (Just 0)
(ophatdecay, ophatdecay_p) = pF "ophatdecay" (Just 0)
(orbit, orbit_p) = pI "orbit" (Just 0)
(pan, pan_p) = pF "pan" (Just 0.5)
(panspan, panspan_p) = pF "span" (Just 1.0)
(pansplay, pansplay_p) = pF "splay" (Just 1.0)
(panwidth, panwidth_p) = pF "panwidth" (Just 2.0)
(panorient, panorient_p) = pF "orientation" (Just 0.5)
(pitch1, pitch1_p) = pF "pitch1" (Just 0)
(pitch2, pitch2_p) = pF "pitch2" (Just 0)
(pitch3, pitch3_p) = pF "pitch3" (Just 0)
(portamento, portamento_p) = pF "portamento" (Just 0)
(release, release_p) = pF "release" (Just (1))
(resonance, resonance_p) = pF "resonance" (Just 0)
(room, room_p) = pF "room" Nothing
(sagogo, sagogo_p) = pF "sagogo" (Just 0)
(sclap, sclap_p) = pF "sclap" (Just 0)
(sclaves, sclaves_p) = pF "sclaves" (Just 0)
(scrash, scrash_p) = pF "scrash" (Just 0)
(semitone, semitone_p) = pF "semitone" (Just 0)
(shape, shape_p) = pF "shape" (Just 0)
(size, size_p) = pF "size" Nothing
(slide, slide_p) = pF "slide" (Just 0)
(speed, speed_p) = pF "speed" (Just 1)
(s', s_p) = pS "s" Nothing
(stutterdepth, stutterdepth_p) = pF "stutterdepth" (Just 0)
(stuttertime, stuttertime_p) = pF "stuttertime" (Just 0)
(sustain, sustain_p) = pF "sustain" (Just 0)
(tomdecay, tomdecay_p) = pF "tomdecay" (Just 0)
(unit, unit_p) = pS "unit" (Just "rate")
(velocity, velocity_p) = pF "velocity" (Just 0.5)
(vcfegint, vcfegint_p) = pF "vcfegint" (Just 0)
(vcoegint, vcoegint_p) = pF "vcoegint" (Just 0)
(voice, voice_p) = pF "voice" (Just 0)
(vowel, vowel_p) = pS "vowel" (Just "")
(dur,dur_p) = pF "dur" (Just 0.05)
(modwheel,modwheel_p) = pF "modwheel" (Just 0)
(expression,expression_p) = pF "expression" (Just 1)
(sustainpedal,sustainpedal_p) = pF "sustainpedal" (Just 0)
tremolorate, tremolodepth :: Pattern Double -> ParamPattern
tremolorate_p, tremolodepth_p :: Param
(tremolorate,tremolorate_p) = pF "tremolorate" (Just 1)
(tremolodepth,tremolodepth_p) = pF "tremolodepth" (Just 0.5)
phaserrate, phaserdepth :: Pattern Double -> ParamPattern
phaserrate_p, phaserdepth_p :: Param
(phaserrate,phaserrate_p) = pF "phaserrate" (Just 1)
(phaserdepth,phaserdepth_p) = pF "phaserdepth" (Just 0.5)
att, chdecay, ctf, ctfg, delayfb, delayt, lbd, lch, lcl, lcp, lcr, lfoc, lfoi
, lfop, lht, llt, loh, lsn, ohdecay, pit1, pit2, pit3, por, sag, scl, scp
, scr, sld, std, stt, sus, tdecay, vcf, vco, voi
:: Pattern Double -> ParamPattern
att = attack
bpf = bandf
bpf_p = bandf_p
bpq = bandq
bpq_p = bandq_p
chdecay = clhatdecay
ctf = cutoff
ctfg = cutoffegint
delayfb = delayfeedback
delayt = delaytime
det = detune
gat = gate
hg = hatgrain
hpf = hcutoff
hpf_p = hcutoff_p
hpq = hresonance
hpq_p = hresonance_p
lag = lagogo
lbd = lkick
lch = lclhat
lcl = lclaves
lcp = lclap
lcr = lcrash
lfoc = lfocutoffint
lfoi = lfoint
lfop = lfopitchint
lht = lhitom
llt = llotom
loh = lophat
lpf = cutoff
lpf_p = cutoff_p
lpq = resonance
lpq_p = resonance_p
lsn = lsnare
ohdecay = ophatdecay
pit1 = pitch1
pit2 = pitch2
pit3 = pitch3
por = portamento
rel = release
sag = sagogo
scl = sclaves
scp = sclap
scr = scrash
sld = slide
std = stutterdepth
stt = stuttertime
sus = sustain
tdecay = tomdecay
vcf = vcfegint
vco = vcoegint
voi = voice
note, midinote :: Pattern Int -> ParamPattern
note = n
midinote = n . ((subtract 60) <$>)
drum :: Pattern String -> ParamPattern
drum = midinote . (drumN <$>)
drumN :: String -> Int
drumN "bd" = 36
drumN "sn" = 38
drumN "lt" = 43
drumN "ht" = 50
drumN "ch" = 42
drumN "oh" = 46
drumN "cp" = 39
drumN "cl" = 75
drumN "ag" = 67
drumN "cr" = 49
drumN _ = 0