module Sound.Tidal.Strategies where
import Data.Ratio
import Control.Applicative
import qualified Data.Map as Map
import qualified Data.Char as Char
import Data.Maybe
import Sound.Tidal.Dirt
import Sound.Tidal.Pattern
import Sound.Tidal.Stream
import Sound.Tidal.Time
import Sound.Tidal.Utils
import Sound.Tidal.Params
import Sound.Tidal.Parse
stutter n t p = stack $ map (\i -> (t * (fromIntegral i)) ~> p) [0 .. (n1)]
echo = stutter 2
triple = stutter 3
quad = stutter 4
double = echo
jux f p = stack [p # pan (pure 0), f $ p # pan (pure 1)]
juxcut f p = stack [p # pan (pure 0) # cut (pure (1)),
f $ p # pan (pure 1) # cut (pure (2))
]
jux' fs p = stack $ map (\n -> ((fs !! n) p) # pan (pure $ fromIntegral n / fromIntegral l)) [0 .. l1]
where l = length fs
jux4 f p = stack [p # pan (pure (5/8)), f $ p # pan (pure (1/8))]
juxBy n f p = stack [p # pan (pure $ 0.5 (n/2)), f $ p # pan (pure $ 0.5 + (n/2))]
smash n xs p = slowcat $ map (\n -> slow n p') xs
where p' = striate n p
smash' n xs p = slowcat $ map (\n -> slow n p') xs
where p' = chop n p
samples :: Applicative f => f String -> f Int -> f String
samples p p' = pick <$> p <*> p'
samples' :: Applicative f => f String -> f Int -> f String
samples' p p' = (flip pick) <$> p' <*> p
spreadf ts p = spread ($)
spin :: Int -> ParamPattern -> ParamPattern
spin copies p =
stack $ map (\n -> let offset = toInteger n % toInteger copies in
offset <~ p
# pan (pure $ fromRational offset)
)
[0 .. (copies 1)]
sawwave4 = ((*4) <$> sawwave1)
sinewave4 = ((*4) <$> sinewave1)
rand4 = ((*4) <$> rand)
stackwith p ps | null ps = silence
| otherwise = stack $ map (\(i, p') -> p' # (((fromIntegral i) % l) <~ p)) (zip [0 ..] ps)
where l = fromIntegral $ length ps
inside n f p = density n $ f (slow n p)
scale :: (Functor f, Num b) => b -> b -> f b -> f b
scale from to p = ((+ from) . (* (tofrom))) <$> p
chop :: Int -> ParamPattern -> ParamPattern
chop n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA
where f queryA a = concatMap (chopEvent queryA) (arc p a)
chopEvent (queryS, queryE) (a,a',v) = map (newEvent v) $ filter (\(_, (s,e)) -> not $ or [e < queryS, s >= queryE]) (enumerate $ chopArc a n)
newEvent :: ParamMap -> (Int, Arc) -> Event ParamMap
newEvent v (i, a) = (a,a,Map.insert (param dirt "end") (Just $ VF ((fromIntegral $ i+1)/(fromIntegral n))) $ Map.insert (param dirt "begin") (Just $ VF ((fromIntegral i)/(fromIntegral n))) v)
gap :: Int -> ParamPattern -> ParamPattern
gap n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA
where f queryA a = concatMap (chopEvent queryA) (arc p a)
chopEvent (queryS, queryE) (a,a',v) = map (newEvent v) $ filter (\(_, (s,e)) -> not $ or [e < queryS, s >= queryE]) (enumerate $ everyOther $ chopArc a n)
newEvent :: ParamMap -> (Int, Arc) -> Event ParamMap
newEvent v (i, a) = (a,a,Map.insert (param dirt "end") (Just $ VF ((fromIntegral $ i+1)/(fromIntegral n))) $ Map.insert (param dirt "begin") (Just $ VF ((fromIntegral i)/(fromIntegral n))) v)
everyOther (x:(y:xs)) = x:(everyOther xs)
everyOther xs = xs
chopArc :: Arc -> Int -> [Arc]
chopArc (s, e) n = map (\i -> ((s + (es)*(fromIntegral i/fromIntegral n)), s + (es)*((fromIntegral $ i+1)/fromIntegral n))) [0 .. n1]
en :: [(Int, Int)] -> Pattern String -> Pattern String
en ns p = stack $ map (\(i, (k, n)) -> e k n (samples p (pure i))) $ enumerate ns
weave :: Rational -> ParamPattern -> [ParamPattern] -> ParamPattern
weave t p ps = weave' t p (map (\x -> (x #)) ps)
weave' :: Rational -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weave' t p fs | l == 0 = silence
| otherwise = slow t $ stack $ map (\(i, f) -> (fromIntegral i % l) <~ (density t $ f (slow t p))) (zip [0 ..] fs)
where l = fromIntegral $ length fs
interlace :: ParamPattern -> ParamPattern -> ParamPattern
interlace a b = weave 16 (shape $ ((* 0.9) <$> sinewave1)) [a, b]
step :: String -> String -> Pattern String
step s steps = cat $ map f steps
where f c | c == 'x' = atom s
| c >= '0' && c <= '9' = atom $ s ++ ":" ++ [c]
| otherwise = silence
steps :: [(String, String)] -> Pattern String
steps = stack . map (\(a,b) -> step a b)
step' :: [String] -> String -> Pattern String
step' ss steps = cat $ map f steps
where f c | c == 'x' = atom $ ss!!0
| c >= '0' && c <= '9' = atom $ ss!!(Char.digitToInt c)
| otherwise = silence
off :: Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
off t f p = superimpose (f . (t ~>)) p
offadd :: Num a => Time -> a -> Pattern a -> Pattern a
offadd t n p = off t ((+n) <$>) p
up :: Pattern Double -> ParamPattern
up = speed . ((1.059466**) <$>)
ghost'' a f p = superimpose (((a*2.5) ~>) . f) $ superimpose (((a*1.5) ~>) . f) $ p
ghost' a p = ghost'' 0.125 ((|*| gain (pure 0.7)) . (|=| end (pure 0.2)) . (|*| speed (pure 1.25))) p
ghost p = ghost' 0.125 p
slice :: Int -> Int -> ParamPattern -> ParamPattern
slice i n p =
p
# begin (pure $ fromIntegral i / fromIntegral n)
# end (pure $ fromIntegral (i+1) / fromIntegral n)
randslice :: Int -> ParamPattern -> ParamPattern
randslice n p = unwrap $ (\i -> slice i n p) <$> irand n