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, phasdp, phasr, pit1, pit2, pit3, por, sag, scl, scp
   , scr, sld, std, stt, sus, tdecay, tremdp, tremr, 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
phasdp = phaserdepth
phasr = phaserrate
pit1 = pitch1
pit2 = pitch2
pit3 = pitch3
por = portamento
rel = release
sag = sagogo
scl = sclaves
scp = sclap
scr = scrash
sz  = size
sld = slide
std = stutterdepth
stt = stuttertime
sus  = sustain
tdecay = tomdecay
tremdp = tremolodepth
tremr = tremolorate
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