diff --git a/src/Sound/Tidal/Pattern.hs b/src/Sound/Tidal/Pattern.hs index 49229d9f..e0d24e19 100644 --- a/src/Sound/Tidal/Pattern.hs +++ b/src/Sound/Tidal/Pattern.hs @@ -461,6 +461,9 @@ withResultArc f pat = pat withResultTime :: (Time -> Time) -> Pattern a -> Pattern a withResultTime f = withResultArc (\(Arc s e) -> Arc (f s) (f e)) +withResultStart :: (Time -> Time) -> Pattern a -> Pattern a +withResultStart f pat = withResultArc (\(Arc s e) -> Arc (f s) (f s + (e-s))) pat + -- | Apply a function to the timespan of the query withQueryArc :: (Arc -> Arc) -> Pattern a -> Pattern a withQueryArc f pat = pat {query = query pat . (\(State a m) -> State (f a) m)} @@ -469,6 +472,9 @@ withQueryArc f pat = pat {query = query pat . (\(State a m) -> State (f a) m)} withQueryTime :: (Time -> Time) -> Pattern a -> Pattern a withQueryTime f pat = withQueryArc (\(Arc s e) -> Arc (f s) (f e)) pat +withQueryStart :: (Time -> Time) -> Pattern a -> Pattern a +withQueryStart f pat = withQueryArc (\(Arc s e) -> Arc (f s) (f s + (e-s))) pat + -- | Apply a function to the control values of the query withQueryControls :: (ValueMap -> ValueMap) -> Pattern a -> Pattern a withQueryControls f pat = pat { query = query pat . (\(State a m) -> State a (f m))} diff --git a/src/Sound/Tidal/UI.hs b/src/Sound/Tidal/UI.hs index f4cf91b7..83491e1c 100644 --- a/src/Sound/Tidal/UI.hs +++ b/src/Sound/Tidal/UI.hs @@ -2935,17 +2935,32 @@ stepwhen patb f pat@(Pattern _ (Just t) _) = while (_steps t patb) f pat -- TODO raise exception? stepwhen _ _ pat = pat +separateCycles :: Int -> Pattern a -> [Pattern a] +separateCycles n pat = map (\i -> skip $ rotL (toRational i) pat) [0 .. n-1] + + where n' = toRational n + skip pat' = splitQueries $ withResultStart (\t -> ((sam t) / n') + cyclePos t) $ withQueryStart (\t -> (sam t * n') + cyclePos t) $ pat' + + +-- _steplastof :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a +-- _steplastof i f pat | i <= 1 = pat +-- | otherwise = stepwhen (fastcat $ map pure $ (replicate (i-1) False) ++ [True]) f pat + _steplastof :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a -_steplastof i f pat | i <= 1 = pat - | otherwise = stepwhen (fastcat $ map pure $ (replicate (i-1) False) ++ [True]) f pat +_steplastof n f pat | n <= 1 = pat + | otherwise = _fast t $ stepcat $ reverse $ (f $ head cycles):tail cycles + where cycles = reverse $ separateCycles n $ _slow t pat + t = fromMaybe 1 $ tactus pat steplastof :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a steplastof (Pattern _ _ (Just i)) f pat = _steplastof i f pat steplastof tp f p = innerJoin $ (\t -> _steplastof t f p) <$> tp _stepfirstof :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a -_stepfirstof i f pat | i <= 1 = pat - | otherwise = stepwhen (fastcat $ map pure $ True:replicate (i-1) False) f pat +_stepfirstof n f pat | n <= 1 = pat + | otherwise = _fast t $ stepcat $ (f $ head cycles):tail cycles + where cycles = separateCycles n $ _slow t pat + t = fromMaybe 1 $ tactus pat stepfirstof :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a stepfirstof (Pattern _ _ (Just i)) f pat = _stepfirstof i f pat