From 09ed26c254f63fa0fe0e69815783828d4f2c5d5d Mon Sep 17 00:00:00 2001 From: Alex McLean Date: Mon, 20 Jan 2025 16:19:23 +0000 Subject: [PATCH] stepJoin compiles.. --- src/Sound/Tidal/Stepwise.hs | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/src/Sound/Tidal/Stepwise.hs b/src/Sound/Tidal/Stepwise.hs index 1928f50e..346c82d5 100644 --- a/src/Sound/Tidal/Stepwise.hs +++ b/src/Sound/Tidal/Stepwise.hs @@ -39,19 +39,25 @@ s_patternify f pa p = stepJoin $ (`f` p) <$> pa s_patternify2 :: (a -> b -> c -> Pattern d) -> Pattern a -> Pattern b -> c -> Pattern d s_patternify2 f a b p = stepJoin $ (\x y -> f x y p) <$> a <*> b +-- Breaks up pattern of patterns at event boundaries, then timecats them all together stepJoin :: Pattern (Pattern a) -> Pattern a stepJoin pp = Pattern q first_t Nothing - where 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 = tactus $ timecat $ retime $ slices $ queryArc pp (Arc 0 1) - retime :: [(Time, Pattern a)] -> [(Time, Pattern a)] + where q st@(State a c) = query (s_cat $ retime $ slices $ + -- query whole, single cycle of pp (should there be a splitCycles here???) + query (rotL (sam $ start a) pp) (st {arc = Arc 0 1})) st + first_t :: Maybe (Pattern Rational) + first_t = tactus $ s_cat $ retime $ slices $ queryArc pp (Arc 0 1) + -- retime each pattern slice + retime :: [(Time, Pattern a)] -> [Pattern a] retime xs = map (\(dur, pat) -> adjust dur pat) xs where occupied_perc = sum $ map fst $ filter (isJust . tactus . snd) xs occupied_tactus = sum $ catMaybes $ map (tactus . snd) xs - total_tactus = occupied_tactus / occupied_perc - adjust dur pat@(Pattern {tactus = Just t}) = (t, pat) - adjust dur pat = (dur*total_tactus, pat) - -- break up events at all start/end points, into groups, including empty ones. + total_tactus = (/ occupied_perc) <$> occupied_tactus + adjust _ pat@(Pattern {tactus = Just _}) = pat + adjust dur pat = setTactus (Just $ (* dur) <$> total_tactus) pat + -- break up events at all start/end points, into groups + -- stacked into single patterns, with duration. Some patterns + -- will be have no events. slices :: [Event (Pattern a)] -> [(Time, Pattern a)] slices evs = map (\s -> ((snd s - fst s), stack $ map (\x -> withContext (\c -> combineContexts [c, context x]) $ value x) $ fit s evs)) $ pairs $ sort $ nubOrd $ 0:1:concatMap (\ev -> start (part ev):stop (part ev):[]) evs -- list of slices of events within the given range @@ -173,4 +179,4 @@ s_expand = s_patternify _s_expand s_contract :: Pattern Rational -> Pattern a -> Pattern a s_contract = s_patternify _s_contract --} \ No newline at end of file +-}