packages feed

tidal-core 1.10.1 → 1.10.2

raw patch · 7 files changed

+83/−22 lines, 7 files

Files

src/Sound/Tidal/ParseBP.hs view
@@ -685,7 +685,10 @@         ]  fromNote :: (Num a) => Pattern String -> Pattern a-fromNote pat = fromRight 0 . runParser parseNote 0 "" <$> pat+fromNote pat = _fromNote <$> pat++_fromNote :: (Num a) => String -> a+_fromNote str = fromRight 0 . runParser parseNote 0 "" $ str  pColour :: MyParser (TPat ColourD) pColour = wrapPos $ do
src/Sound/Tidal/Pattern.hs view
@@ -31,7 +31,10 @@   ) where -import Control.Applicative (liftA2)+-- Backward compatibility for liftA2+--- https://github.com/haskell/core-libraries-committee/blob/main/guides/export-lifta2-prelude.md++import Control.Applicative (Applicative (..)) import Control.DeepSeq (NFData) import Control.Monad ((>=>)) import Data.Data (Data)@@ -43,7 +46,7 @@ import Data.Word (Word8) import GHC.Generics (Generic) import Sound.Tidal.Time-import Prelude hiding ((*>), (<*))+import Prelude hiding (Applicative (..), (*>), (<*))  ------------------------------------------------------------------------ @@ -56,7 +59,7 @@   }  -- | A datatype representing events taking place over time-data Pattern a = Pattern {query :: State -> [Event a], steps :: Maybe (Rational), pureValue :: Maybe a}+data Pattern a = Pattern {query :: State -> [Event a], steps :: Maybe Rational, pureValue :: Maybe a}   deriving (Generic, Functor)  instance (NFData a) => NFData (Pattern a)@@ -73,6 +76,9 @@ withSteps :: (Rational -> Rational) -> Pattern a -> Pattern a withSteps f p = p {steps = fmap f $ steps p} +hasSteps :: Pattern a -> Bool+hasSteps = isJust . steps+ pace :: Rational -> Pattern a -> Pattern a pace target p@(Pattern _ (Just t) _) = setSteps (Just target) $ _fast (target / t) p -- raise error?@@ -613,6 +619,9 @@ withEvent :: (Event a -> Event b) -> Pattern a -> Pattern b withEvent f p = p {query = map f . query p, pureValue = Nothing} +withEventArc :: (Arc -> Arc) -> Pattern a -> Pattern a+withEventArc f pat = withEvent (\(Event c w p v) -> Event c (f <$> w) (f p) v) pat+ -- | @withEvent f p@ returns a new @Pattern@ with each value mapped over -- function @f@. withValue :: (a -> b) -> Pattern a -> Pattern b@@ -850,6 +859,12 @@             as' = as $ start $ wholeOrPart ex         as s = query pa $ fQuery s         fQuery s = st {arc = Arc s s}++-- Like `rev`, but reverses the whole pattern, rather than every cycle in the pattern.+revv :: Pattern a -> Pattern a+revv pat = withEventArc negateArc $ withQueryArc negateArc pat+  where+    negateArc (Arc s e) = Arc (negate e) (negate s)  -- ** Event filters
src/Sound/Tidal/Stepwise.hs view
@@ -18,14 +18,14 @@  module Sound.Tidal.Stepwise where -import Data.List (sort, sortOn, transpose)-import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, mapMaybe)-import Sound.Tidal.Core (stack, timecat, zoom, zoompat)+import Data.List (sort, transpose)+import Data.Maybe (fromMaybe, isJust, mapMaybe)+import Sound.Tidal.Core (slowcat, stack, timecat, zoom) import Sound.Tidal.Pattern-import Sound.Tidal.Utils (enumerate, nubOrd, pairs)+import Sound.Tidal.Utils (nubOrd, pairs) --- _lcmsteps :: [Pattern a] -> Maybe Time--- _lcmsteps pats = foldl1 lcmr <$> (sequence $ map steps pats)+-- _lcmsteps :: [Pattern a] -> Pattern Time+-- _lcmsteps pats = foldl1 (liftA2 lcmr) $ mapMaybe steps pats  s_patternify :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c) s_patternify f (Pattern _ _ (Just a)) b = f a b@@ -37,6 +37,7 @@ stepJoin :: Pattern (Pattern a) -> Pattern a stepJoin pp = Pattern q first_t Nothing   where+    -- TODO - use context?     q st@(State a c) = query (timecat $ retime $ slices $ query (rotL (sam $ start a) pp) (st {arc = Arc 0 1})) st     first_t :: Maybe Rational     first_t = steps $ timecat $ retime $ slices $ queryArc pp (Arc 0 1)@@ -89,9 +90,9 @@ _stepdrop _ pat@(Pattern _ Nothing _) = pat _stepdrop n pat@(Pattern _ (Just t) _) = steptake (pure $ f t) pat   where-    f t-      | n >= 0 = t - n-      | otherwise = negate (t + n)+    f t'+      | n >= 0 = t' - n+      | otherwise = negate (t' + n)  stepdrop :: Pattern Time -> Pattern a -> Pattern a stepdrop = s_patternify _stepdrop@@ -114,11 +115,26 @@ extend :: Pattern Rational -> Pattern a -> Pattern a extend = s_patternify _extend +-- polymeter :: [Pattern a] -> Pattern a+-- polymeter pats = stack $ map (pace targetSteps) pats'+--   where+--     targetSteps = _lcmsteps pats'+--     pats' = filter hasSteps pats++-- pm :: [Pattern a] -> Pattern a+-- pm = polymeter+ -- | Successively plays a pattern from each group in turn stepalt :: [[Pattern a]] -> Pattern a stepalt groups = stepcat $ concat $ take (fromIntegral $ c * length groups) $ transpose $ map cycle groups   where     c = foldl1 lcm $ map length groups++stepzip :: [Pattern a] -> Pattern a+stepzip pats = setSteps (Just s) $ _fast s zipped+  where+    zipped = slowcat $ map (pace 1) $ filter hasSteps pats+    s = foldl1 lcmr $ mapMaybe steps pats  {- s_while :: Pattern Bool -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
src/Sound/Tidal/UI.hs view
@@ -1434,9 +1434,9 @@       where         r = timeToRand seed'     renorm :: IM.IntMap (Map.Map Double Int)-    renorm = IM.fromList $ zip [0 ..] [Map.fromList $ zip (tail $ scanl (+) 0 x) [0 ..] | x <- tp]+    renorm = IM.fromList $ zip [0 ..] [Map.fromListWith (\new old -> old) $ zip (tail $ scanl (+) 0 x) [0 ..] | x <- tp]     findIndex :: Double -> Map.Map Double Int -> Int-    findIndex x v = maybe 0 snd (Map.lookupGE x v)+    findIndex x v = maybe (snd (Map.findMax v)) snd (Map.lookupGT x v)     delta = 1 / fromIntegral n  -- | @markovPat n xi tp@ generates a one-cycle pattern of @n@ steps in a Markov@@ -1606,6 +1606,20 @@ _chunk' :: (Integral a) => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b _chunk' n f p = _chunk (-n) f p +chunkinto :: Pattern Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b+chunkinto npat f p = innerJoin $ (\n -> _chunkinto n f p) <$> npat++chunkInto :: Pattern Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b+chunkInto = chunkinto++_chunkinto :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+_chunkinto 0 _ pat = pat+_chunkinto n f pat = into (iterf n $ fastcat $ map pure (True : replicate (abs n - 1) False)) f pat+  where+    iterf+      | n > 0 = _iter'+      | otherwise = _iter+ -- | -- @inside@ carries out an operation /inside/ a cycle. -- For example, while @rev "0 1 2 3 4 5 6 7"@ is the same as @"7 6 5 4 3 2 1 0"@,@@ -3000,14 +3014,17 @@ rib = ribbon  -- | Turns a pattern into a pattern of patterns, according to the structure of another given pattern.-unjoin :: Pattern Bool -> Pattern b -> Pattern (Pattern b)-unjoin pieces pat = withEvent snip pieces+unjoinfunc :: Pattern Bool -> (Pattern a -> Pattern a) -> Pattern a -> Pattern (Pattern a)+unjoinfunc pieces f pat = withEvent snip pieces   where     -- If true, set value to the part of pattern looped at event boundaries-    snip e@Event {value = True} = e {value = _ribbon (wholeStart e) (wholeStop e - wholeStart e) pat}+    snip e@Event {value = True} = e {value = f $ _ribbon (wholeStart e) (wholeStop e - wholeStart e) pat}     -- Otherwise, set value to unchanged pattern     snip e = e {value = pat} +unjoin :: Pattern Bool -> Pattern a -> Pattern (Pattern a)+unjoin pieces pat = unjoinfunc pieces id pat+ -- | Applies a function to subcycles of a pattern, as defined by the structure of another given pattern.-into :: Pattern Bool -> (Pattern a -> Pattern b) -> Pattern a -> Pattern b-into pieces func pat = innerJoin $ fmap func $ unjoin pieces pat+into :: Pattern Bool -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b+into pieces func pat = innerJoin $ unjoinfunc pieces func pat
test/Sound/Tidal/StepwiseTest.hs view
@@ -15,7 +15,7 @@ import Sound.Tidal.Stepwise (expand, stepcat, stepdrop, steptake) import Sound.Tidal.UI (inv, iter, linger, segment) import Test.Hspec (Spec, describe, it, shouldBe)-import TestUtils (compareP)+import TestUtils (compareP, firstCycleValues) import Prelude hiding ((*>), (<*))  run :: Spec@@ -47,3 +47,9 @@       it "invert" $ steps (inv "1 0 1" :: Pattern Bool) `shouldBe` Just 3       it "chop" $ steps (chop 3 $ sound "a b") `shouldBe` Just 6       it "chop" $ steps (striate 3 $ sound "a b") `shouldBe` Just 6++-- describe "polymeter" $ do+--   it "can repeat patterns to step count lcm" $+--     compareP (Arc 0 8) (polymeter ["a b c" :: Pattern Char, "d e"]) "{a b c, d e}%6"+--   it "can work with 3 patterns" $+--     compareP (Arc 0 8) (polymeter ["a b c" :: Pattern Char, "d e", "f g h i"]) "{a b c, d e, f g h i}%12"
test/Sound/Tidal/UITest.hs view
@@ -488,3 +488,7 @@          (Arc 0 1)          (_ribbon 0.25 0.25 ("a b c d" :: Pattern String))          "b b b b"+    describe "runMarkov" $ do+      it "deterministic transition matrix" $ do+        runMarkov 4 [[0,1],[1,0]] 0 0+          `shouldBe` [0,1,0,1]
tidal-core.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.0  name: tidal-core-version: 1.10.1+version: 1.10.2  license: GPL-3 copyright:           (c) Alex McLean and other contributors, 2025