packages feed

tidal 0.4.10 → 0.4.11

raw patch · 5 files changed

+112/−51 lines, 5 filesdep ~mtl

Dependency ranges changed: mtl

Files

Sound/Tidal/Pattern.hs view
@@ -79,28 +79,28 @@ silence :: Pattern a silence = Pattern $ const [] --- | @mapQueryArc f p@ returns a new @Pattern@ with function @f@+-- | @withQueryArc f p@ returns a new @Pattern@ with function @f@ -- applied to the @Arc@ values passed to the original @Pattern@ @p@.-mapQueryArc :: (Arc -> Arc) -> Pattern a -> Pattern a-mapQueryArc f p = Pattern $ \a -> arc p (f a)+withQueryArc :: (Arc -> Arc) -> Pattern a -> Pattern a+withQueryArc f p = Pattern $ \a -> arc p (f a) --- | @mapQueryTime f p@ returns a new @Pattern@ with function @f@+-- | @withQueryTime f p@ returns a new @Pattern@ with function @f@ -- applied to the both the start and end @Time@ of the @Arc@ passed to -- @Pattern@ @p@.-mapQueryTime :: (Time -> Time) -> Pattern a -> Pattern a-mapQueryTime = mapQueryArc . mapArc+withQueryTime :: (Time -> Time) -> Pattern a -> Pattern a+withQueryTime = withQueryArc . mapArc --- | @mapResultArc f p@ returns a new @Pattern@ with function @f@+-- | @withResultArc f p@ returns a new @Pattern@ with function @f@ -- applied to the @Arc@ values in the events returned from the -- original @Pattern@ @p@.-mapResultArc :: (Arc -> Arc) -> Pattern a -> Pattern a-mapResultArc f p = Pattern $ \a -> mapArcs f $ arc p a+withResultArc :: (Arc -> Arc) -> Pattern a -> Pattern a+withResultArc f p = Pattern $ \a -> mapArcs f $ arc p a --- | @mapResultTime f p@ returns a new @Pattern@ with function @f@+-- | @withResultTime f p@ returns a new @Pattern@ with function @f@ -- applied to the both the start and end @Time@ of the @Arc@ values in -- the events returned from the original @Pattern@ @p@.-mapResultTime :: (Time -> Time) -> Pattern a -> Pattern a-mapResultTime = mapResultArc . mapArc+withResultTime :: (Time -> Time) -> Pattern a -> Pattern a+withResultTime = withResultArc . mapArc  -- | @overlay@ combines two @Pattern@s into a new pattern, so that -- their events are combined over time.@@ -134,7 +134,7 @@  splitAtSam :: Pattern a -> Pattern a splitAtSam p = -  Pattern $ \a -> concatMap (\(s,e) -> mapSnds' (trimArc (sam s)) $ arc p (s,e)) (arcCycles a)+  splitQueries $ Pattern $ \(s,e) -> mapSnds' (trimArc (sam s)) $ arc p (s,e)   where trimArc s' (s,e) = (max (s') s, min (s'+1) e)  -- | @slowcat@ does the same as @cat@, but maintaining the duration of@@ -143,10 +143,10 @@  slowcat :: [Pattern a] -> Pattern a slowcat [] = silence-slowcat ps = Pattern $ \a -> concatMap f (arcCycles a)+slowcat ps = splitQueries $ Pattern f   where ps' = map splitAtSam ps         l = length ps'-        f (s,e) = arc (mapResultTime (+offset) p) (s',e')+        f (s,e) = arc (withResultTime (+offset) p) (s',e')           where p = ps' !! n                 r = (floor s) :: Int                 n = (r `mod` l) :: Int@@ -169,14 +169,16 @@ -- | @run@ @n@ returns a pattern representing a cycle of numbers from @0@ to @n-1@. run n = listToPat [0 .. n-1] +scan n = cat $ map run [1 .. n]+ -- | @density@ returns the given pattern with density increased by the -- given @Time@ factor. Therefore @density 2 p@ will return a pattern -- that is twice as fast, and @density (1%3) p@ will return one three -- times as slow. density :: Time -> Pattern a -> Pattern a-density 0 p = p+density 0 p = silence density 1 p = p-density r p = mapResultTime (/ r) $ mapQueryTime (* r) p+density r p = withResultTime (/ r) $ withQueryTime (* r) p   -- | @densityGap@ is similar to @density@ but maintains its cyclic@@ -184,7 +186,8 @@ -- pattern @p@ into the first half of each cycle (and the second -- halves would be empty). densityGap :: Time -> Pattern a -> Pattern a-densityGap r p = mapResultTime (\t -> sam t + ((cyclePos t) / r)) $ Pattern (\a -> concatMap (\a' -> arc p $ mapArc (\t -> sam t + (min 1 (r * cyclePos t))) a') (arcCycles a))+densityGap 0 p = silence+densityGap r p = splitQueries $ withResultArc (\(s,e) -> (sam s + ((s - sam s)/r), (sam s + ((e - sam s)/r)))) $ Pattern (\a -> arc p $ mapArc (\t -> sam t + (min 1 (r * cyclePos t))) a)  -- | @slow@ does the opposite of @density@, i.e. @slow 2 p@ will -- return a pattern that is half the speed.@@ -198,7 +201,7 @@ -- @(1%16) <~ p@ will return a pattern with all the events moved  -- one 16th of a cycle to the left. (<~) :: Time -> Pattern a -> Pattern a-(<~) t p = mapResultTime (subtract t) $ mapQueryTime (+ t) p+(<~) t p = withResultTime (subtract t) $ withQueryTime (+ t) p  -- | The @~>@ operator does the same as @~>@ but shifts events to the -- right (or clockwise) rather than to the left.@@ -214,10 +217,7 @@ -- | @rev p@ returns @p@ with the event positions in each cycle -- reversed (or mirrored). rev :: Pattern a -> Pattern a-rev p = Pattern $ \a -> concatMap -                        (\a' -> mapArcs mirrorArc $ -                                (arc p (mirrorArc a')))-                        (arcCycles a)+rev p = splitQueries $ Pattern $ \a -> mapArcs mirrorArc (arc p (mirrorArc a))  -- | @palindrome p@ applies @rev@ to @p@ every other cycle, so that -- the pattern alternates between forwards and backwards.@@ -227,10 +227,24 @@ -- which only affects cycles where the @test@ function applied to the -- cycle number returns @True@. when :: (Int -> Bool) -> (Pattern a -> Pattern a) ->  Pattern a -> Pattern a-when test f p = Pattern $ \a -> concatMap apply (arcCycles a)+when test f p = splitQueries $ Pattern apply   where apply a | test (floor $ fst a) = (arc $ f p) a                 | otherwise = (arc p) a +whenT :: (Time -> Bool) -> (Pattern a -> Pattern a) ->  Pattern a -> Pattern a+whenT test f p = splitQueries $ Pattern apply+  where apply a | test (fst a) = (arc $ f p) a+                | otherwise = (arc p) a++playWhen :: (Time -> Bool) -> Pattern a -> Pattern a+playWhen test (Pattern f) = Pattern $ (filter (\e -> test (eventOnset e))) . f++playFor :: Time -> Time -> Pattern a -> Pattern a+playFor s e = playWhen (\t -> and [t >= s, t < e])++seqP :: [(Time, Time, Pattern a)] -> Pattern a+seqP = stack . (map (\(s, e, p) -> playFor s e ((sam s) ~> p)))+ -- | @every n f p@ applies the function @f@ to @p@, but only affects -- every @n@ cycles. every :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a@@ -321,6 +335,23 @@ envL :: Pattern Double envL = sig $ \t -> max 0 $ min (fromRational t) 1 +fadeOut :: Time -> Pattern a -> Pattern a+fadeOut n = spread' (degradeBy) (slow n $ envL)++fadeIn :: Time -> Pattern a -> Pattern a+fadeIn n = spread' (degradeBy) (slow n $ (1-) <$> envL)++spread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b+spread f xs p = cat $ map (\x -> f x p) xs++slowspread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b+slowspread f xs p = slowcat $ map (\x -> f x p) xs++spread' :: (a -> Pattern b -> Pattern c) -> Pattern a -> Pattern b -> Pattern c+spread' f timepat pat =+  Pattern $ \r -> concatMap (\(_,r', x) -> (arc (f x pat) r')) (rs r)+  where rs r = arc (filterOnsetsInRange timepat) r+ filterValues :: (a -> Bool) -> Pattern a -> Pattern a filterValues f (Pattern x) = Pattern $ (filter (f . thd')) . x @@ -360,7 +391,7 @@   where mrg es@((a, a', _):_) = (a, a', map thd' es)  ifp :: (Int -> Bool) -> (Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-ifp test f1 f2 p = Pattern $ \a -> concatMap apply (arcCycles a)+ifp test f1 f2 p = splitQueries $ Pattern apply   where apply a | test (floor $ fst a) = (arc $ f1 p) a                 | otherwise = (arc $ f2 p) a @@ -385,3 +416,48 @@ -- remainer of each cycle. wedge :: Time -> Pattern a -> Pattern a -> Pattern a wedge t p p' = overlay (densityGap (1/t) p) (t <~ densityGap (1/(1-t)) p')++whenmod :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+whenmod a b = Sound.Tidal.Pattern.when ((\t -> (t `mod` a) >= b ))++superimpose f p = stack [p, f p]++-- | @splitQueries p@ wraps `p` to ensure that it does not get+-- queries that | span arcs. For example `arc p (0.5, 1.5)` would be+-- turned into two queries, `(0.5,1)` and `(1,1.5)`, and the results+-- combined. Being able to assume queries don't span cycles often+-- makes transformations easier to specify.+splitQueries :: Pattern a -> Pattern a+splitQueries p = Pattern $ \a -> concatMap (arc p) $ arcCycles a++trunc :: Time -> Pattern a -> Pattern a+trunc t p = slow t $ splitQueries $ p'+  where p' = Pattern $ \a -> mapArcs (stretch . trunc') $ arc p (trunc' a)+        trunc' (s,e) = (min s ((sam s) + t), min e ((sam s) + t))+        stretch (s,e) = (sam s + ((s - sam s) / t), sam s + ((e - sam s) / t))++zoom :: Arc -> Pattern a -> Pattern a+zoom a@(s,e) p = splitQueries $ withResultArc (mapCycle ((/d) . (subtract s))) $ withQueryArc (mapCycle ((+s) . (*d))) p+     where d = e-s++compress :: Arc -> Pattern a -> Pattern a+compress a@(s,e) p | s >= e = silence+                   | otherwise = s ~> densityGap (1/(e-s)) p++sliceArc :: Arc -> Pattern a -> Pattern a+sliceArc a@(s,e) p | s >= e = silence+                   | otherwise = compress a $ zoom a p++-- @within@ uses @compress@ and @zoom to apply @f@ to only part of pattern @p@+-- for example, @within (1%2) (3%4) ((1%8) <~) "bd sn bd cp"@ would shift only+-- the second @bd@+withArc :: Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+withArc (s,e) f p = stack [sliceArc (0,s) p, +                           compress (s,e) $ f $ zoom (s,e) p, +                           sliceArc (e,1) p+                          ]++within = withArc++revArc a = withArc a rev+
Sound/Tidal/Strategies.hs view
@@ -26,7 +26,7 @@                    ] jux4 f p = stack [p |+| pan (pure 0), f $ p |+| pan (pure 2)] -superimpose f p = stack [p, f p]+juxBy n f p = stack [p |+| pan (pure $ 0.5 - (n/2)), f $ p |+| pan (pure $ 0.5 + (n/2))]  -- every 4 (smash 4 [1, 2, 3]) $ sound "[odx sn/2 [~ odx] sn/3, [~ hh]*4]" @@ -38,17 +38,6 @@ samples :: Applicative f => f String -> f Int -> f String samples p p' = pick <$> p <*> p' -spread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b-spread f xs p = cat $ map (\x -> f x p) xs--slowspread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b-slowspread f xs p = slowcat $ map (\x -> f x p) xs--spread' :: (a -> Pattern b -> Pattern c) -> Pattern a -> Pattern b -> Pattern c-spread' f timepat pat =-  Pattern $ \r -> concatMap (\(_,r', x) -> (arc (f x pat) r')) (rs r)-  where rs r = arc (filterOnsetsInRange timepat) r- {- scrumple :: Time -> Pattern a -> Pattern a -> Pattern a scrumple o p p' = p'' -- overlay p (o ~> p'')@@ -61,21 +50,12 @@                               ) (arc p a) -} -whenmod :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-whenmod a b = Sound.Tidal.Pattern.when ((\t -> (t `mod` a) >= b ))- --rev :: Pattern a -> Pattern a --rev p = Pattern $ \a -> concatMap  --                        (\a' -> mapFsts mirrorArc $  --                                (arc p (mirrorArc a'))) --                        (arcCycles a) -trunc :: Time -> Pattern a -> Pattern a-trunc t p = slow t $ Pattern $ \a -> concatMap f $ arcCycles a-  where f a = mapArcs (stretch . trunc') $ arc p (trunc' a)-        trunc' (s,e) = (min s ((sam s) + t), min e ((sam s) + t))-        stretch (s,e) = (sam s + ((s - sam s) / t), sam s + ((e - sam s) / t))- --spreadf :: [Pattern a -> Pattern b] -> Pattern a -> Pattern b spreadf ts p = spread ($) @@ -127,3 +107,4 @@  chopArc :: Arc -> Int -> [Arc] chopArc (s, e) n = map (\i -> ((s + (e-s)*(fromIntegral i/fromIntegral n)), s + (e-s)*((fromIntegral $ i+1)/fromIntegral n))) [0 .. n-1]+
Sound/Tidal/Time.hs view
@@ -1,6 +1,7 @@ module Sound.Tidal.Time where  import Sound.Tidal.Utils+import Data.Ratio  -- | Time is represented by a rational number. Each natural number -- represents both the start of the next rhythmic cycle, and the end@@ -58,6 +59,12 @@ -- of the given @Arc@. mapArc :: (Time -> Time) -> Arc -> Arc mapArc f (s,e) = (f s, f e)++-- | Similar to @mapArc@ but time is relative to the cycle (i.e. the+-- sam of the start of the arc)+mapCycle :: (Time -> Time) -> Arc -> Arc+mapCycle f (s,e) = (sam' + (f $ s - sam'), sam' + (f $ e - sam'))+         where sam' = sam s  -- | Returns the `mirror image' of an @Arc@, used by @Sound.Tidal.Pattern.rev@. mirrorArc :: Arc -> Arc
tidal.cabal view
@@ -1,5 +1,5 @@ name:                tidal-version:             0.4.10+version:             0.4.11 synopsis:            Pattern language for improvised music -- description:          homepage:            http://yaxu.org/tidal/@@ -28,4 +28,4 @@                        Sound.Tidal.Context                        Sound.Tidal.Utils -  Build-depends: base < 5, process, parsec, hosc > 0.13, hashable, colour, containers, time, websockets > 0.8, text, mtl, transformers, mersenne-random-pure64,binary, bytestring+  Build-depends: base < 5, process, parsec, hosc > 0.13, hashable, colour, containers, time, websockets > 0.8, text, mtl >=2.1, transformers, mersenne-random-pure64,binary, bytestring
tidal.el view
@@ -136,9 +136,6 @@   (tidal-send-string "now' <- getNow")   (tidal-send-string "let now = nextSam now'")   (tidal-send-string "let retrig = (now ~>)")-  (tidal-send-string "let fadeOut n = spread' (degradeBy) (retrig $ slow n $ envL)")-  (tidal-send-string "let fadeIn n = spread' (degradeBy) (retrig $ slow n $ (1-) <$> envL)")-   )  (defun tidal-run-line ()