From 82d29af80dd4d4f68e55d9907c675acb39f59332 Mon Sep 17 00:00:00 2001 From: Alex McLean Date: Fri, 23 Sep 2022 11:52:10 +0100 Subject: [PATCH] fix for squeezejoin (ref https://github.com/tidalcycles/strudel/issues/216), moving some supporting functions up to the pattern module --- src/Sound/Tidal/Core.hs | 57 ---------------------------------- src/Sound/Tidal/Pattern.hs | 63 ++++++++++++++++++++++++++++++++++++-- src/Sound/Tidal/Simple.hs | 4 +-- src/Sound/Tidal/Stream.hs | 2 +- src/Sound/Tidal/Tempo.hs | 5 ++- 5 files changed, 66 insertions(+), 65 deletions(-) diff --git a/src/Sound/Tidal/Core.hs b/src/Sound/Tidal/Core.hs index 04592b9d0..ae0b41991 100644 --- a/src/Sound/Tidal/Core.hs +++ b/src/Sound/Tidal/Core.hs @@ -29,10 +29,6 @@ import Sound.Tidal.Pattern -- ** Elemental patterns --- | An empty pattern -silence :: Pattern a -silence = empty - -- | Takes a function from time to values, and turns it into a 'Pattern'. sig :: (Time -> a) -> Pattern a sig f = Pattern q @@ -347,31 +343,6 @@ stack = foldr overlay silence (~>) :: Pattern Time -> Pattern a -> Pattern a (~>) = tParam rotR --- | Speed up a pattern by the given time pattern -fast :: Pattern Time -> Pattern a -> Pattern a -fast = tParam _fast - --- | Slow down a pattern by the factors in the given time pattern, 'squeezing' --- the pattern to fit the slot given in the time pattern -fastSqueeze :: Pattern Time -> Pattern a -> Pattern a -fastSqueeze = tParamSqueeze _fast - --- | An alias for @fast@ -density :: Pattern Time -> Pattern a -> Pattern a -density = fast - -_fast :: Time -> Pattern a -> Pattern a -_fast rate pat | rate == 0 = silence - | rate < 0 = rev $ _fast (negate rate) pat - | otherwise = withResultTime (/ rate) $ withQueryTime (* rate) pat - --- | Slow down a pattern by the given time pattern -slow :: Pattern Time -> Pattern a -> Pattern a -slow = tParam _slow -_slow :: Time -> Pattern a -> Pattern a -_slow 0 _ = silence -_slow r p = _fast (1/r) p - -- | Slow down a pattern by the factors in the given time pattern, 'squeezing' -- the pattern to fit the slot given in the time pattern slowSqueeze :: Pattern Time -> Pattern a -> Pattern a @@ -381,34 +352,6 @@ slowSqueeze = tParamSqueeze _slow sparsity :: Pattern Time -> Pattern a -> Pattern a sparsity = slow --- | @rev p@ returns @p@ with the event positions in each cycle --- reversed (or mirrored). -rev :: Pattern a -> Pattern a -rev p = - splitQueries $ p { - query = \st -> map makeWholeAbsolute $ - mapParts (mirrorArc (midCycle $ arc st)) $ - map makeWholeRelative - (query p st - {arc = mirrorArc (midCycle $ arc st) (arc st) - }) - } - where makeWholeRelative :: Event a -> Event a - makeWholeRelative e@Event {whole = Nothing} = e - makeWholeRelative (Event c (Just (Arc s e)) p'@(Arc s' e') v) = - Event c (Just $ Arc (s'-s) (e-e')) p' v - makeWholeAbsolute :: Event a -> Event a - makeWholeAbsolute e@Event {whole = Nothing} = e - makeWholeAbsolute (Event c (Just (Arc s e)) p'@(Arc s' e') v) = - Event c (Just $ Arc (s'-e) (e'+s)) p' v - midCycle :: Arc -> Time - midCycle (Arc s _) = sam s + 0.5 - mapParts :: (Arc -> Arc) -> [Event a] -> [Event a] - mapParts f es = (\(Event c w p' v) -> Event c w (f p') v) <$> es - -- | Returns the `mirror image' of a 'Arc' around the given point in time - mirrorArc :: Time -> Arc -> Arc - mirrorArc mid' (Arc s e) = Arc (mid' - (e-mid')) (mid'+(mid'-s)) - {- | Plays a portion of a pattern, specified by a time arc (start and end time). The new resulting pattern is played over the time period of the original pattern: diff --git a/src/Sound/Tidal/Pattern.hs b/src/Sound/Tidal/Pattern.hs index 57a50c907..13f315e50 100644 --- a/src/Sound/Tidal/Pattern.hs +++ b/src/Sound/Tidal/Pattern.hs @@ -199,7 +199,7 @@ squeezeJoin :: Pattern (Pattern a) -> Pattern a squeezeJoin pp = pp {query = q} where q st = concatMap (\e@(Event c w p v) -> - mapMaybe (munge c w p) $ query (compressArc (cycleArc $ wholeOrPart e) v) st {arc = p} + mapMaybe (munge c w p) $ query (focusArc (wholeOrPart e) v) st {arc = p} ) (query pp st) munge oContext oWhole oPart (Event iContext iWhole iPart v) = @@ -342,11 +342,14 @@ instance Floating ValueMap atanh _ = noOv "atanh" ------------------------------------------------------------------------ --- * Internal functions +-- * Internal/fundamental functions empty :: Pattern a empty = Pattern {query = const []} +silence :: Pattern a +silence = empty + queryArc :: Pattern a -> Arc -> [Event a] queryArc p a = query p $ State a Map.empty @@ -427,6 +430,35 @@ compressArc (Arc s e) p | s > e = empty compressArcTo :: Arc -> Pattern a -> Pattern a compressArcTo (Arc s e) = compressArc (Arc (cyclePos s) (e - sam s)) +focusArc :: Arc -> Pattern a -> Pattern a +focusArc (Arc s e) p = s `rotR` (_fast (1/(e-s)) p) + + +-- | Speed up a pattern by the given time pattern +fast :: Pattern Time -> Pattern a -> Pattern a +fast = tParam _fast + +-- | Slow down a pattern by the factors in the given time pattern, 'squeezing' +-- the pattern to fit the slot given in the time pattern +fastSqueeze :: Pattern Time -> Pattern a -> Pattern a +fastSqueeze = tParamSqueeze _fast + +-- | An alias for @fast@ +density :: Pattern Time -> Pattern a -> Pattern a +density = fast + +_fast :: Time -> Pattern a -> Pattern a +_fast rate pat | rate == 0 = silence + | rate < 0 = rev $ _fast (negate rate) pat + | otherwise = withResultTime (/ rate) $ withQueryTime (* rate) pat + +-- | Slow down a pattern by the given time pattern +slow :: Pattern Time -> Pattern a -> Pattern a +slow = tParam _slow +_slow :: Time -> Pattern a -> Pattern a +_slow 0 _ = silence +_slow r p = _fast (1/r) p + _fastGap :: Time -> Pattern a -> Pattern a _fastGap 0 _ = empty _fastGap r p = splitQueries $ @@ -448,6 +480,33 @@ rotL t p = withResultTime (subtract t) $ withQueryTime (+ t) p rotR :: Time -> Pattern a -> Pattern a rotR t = rotL (negate t) +-- | @rev p@ returns @p@ with the event positions in each cycle +-- reversed (or mirrored). +rev :: Pattern a -> Pattern a +rev p = + splitQueries $ p { + query = \st -> map makeWholeAbsolute $ + mapParts (mirrorArc (midCycle $ arc st)) $ + map makeWholeRelative + (query p st + {arc = mirrorArc (midCycle $ arc st) (arc st) + }) + } + where makeWholeRelative :: Event a -> Event a + makeWholeRelative e@Event {whole = Nothing} = e + makeWholeRelative (Event c (Just (Arc s e)) p'@(Arc s' e') v) = + Event c (Just $ Arc (s'-s) (e-e')) p' v + makeWholeAbsolute :: Event a -> Event a + makeWholeAbsolute e@Event {whole = Nothing} = e + makeWholeAbsolute (Event c (Just (Arc s e)) p'@(Arc s' e') v) = + Event c (Just $ Arc (s'-e) (e'+s)) p' v + midCycle :: Arc -> Time + midCycle (Arc s _) = sam s + 0.5 + mapParts :: (Arc -> Arc) -> [Event a] -> [Event a] + mapParts f es = (\(Event c w p' v) -> Event c w (f p') v) <$> es + -- | Returns the `mirror image' of a 'Arc' around the given point in time + mirrorArc :: Time -> Arc -> Arc + mirrorArc mid' (Arc s e) = Arc (mid' - (e-mid')) (mid'+(mid'-s)) -- | Mark values in the first pattern which match with at least one -- value in the second pattern. diff --git a/src/Sound/Tidal/Simple.hs b/src/Sound/Tidal/Simple.hs index 9604a5b12..2bc622be8 100644 --- a/src/Sound/Tidal/Simple.hs +++ b/src/Sound/Tidal/Simple.hs @@ -22,10 +22,10 @@ module Sound.Tidal.Simple where import Sound.Tidal.Control (chop, hurry) -import Sound.Tidal.Core ((#), (|*), (<~), silence, rev) +import Sound.Tidal.Core ((#), (|*), (<~)) import Sound.Tidal.Params (crush, gain, pan, speed, s) import Sound.Tidal.ParseBP (parseBP_E) -import Sound.Tidal.Pattern (ControlPattern) +import Sound.Tidal.Pattern (ControlPattern, silence, rev) import GHC.Exts ( IsString(..) ) instance {-# OVERLAPPING #-} IsString ControlPattern where diff --git a/src/Sound/Tidal/Stream.hs b/src/Sound/Tidal/Stream.hs index b0a65c416..6b7526e35 100644 --- a/src/Sound/Tidal/Stream.hs +++ b/src/Sound/Tidal/Stream.hs @@ -38,7 +38,7 @@ import qualified Sound.OSC.FD as O import qualified Network.Socket as N import Sound.Tidal.Config -import Sound.Tidal.Core (stack, silence, (#)) +import Sound.Tidal.Core (stack, (#)) import Sound.Tidal.ID import qualified Sound.Tidal.Link as Link import Sound.Tidal.Params (pS) diff --git a/src/Sound/Tidal/Tempo.hs b/src/Sound/Tidal/Tempo.hs index 1ade69eb7..801f6742b 100644 --- a/src/Sound/Tidal/Tempo.hs +++ b/src/Sound/Tidal/Tempo.hs @@ -20,7 +20,6 @@ import System.IO (hPutStrLn, stderr) import Data.Int(Int64) import Sound.Tidal.StreamTypes -import Sound.Tidal.Core (silence) {- Tempo.hs - Tidal's scheduler @@ -284,10 +283,10 @@ clocked config stateMV mapMV actionsMV ac abletonLink let appendPat flag = if flag then (pat:) else id updatePS (Just playState) = playState {history = (appendPat historyFlag) (history playState)} - updatePS Nothing = PlayState {pattern = silence, + updatePS Nothing = PlayState {pattern = P.silence, mute = False, solo = False, - history = (appendPat historyFlag) (silence:[]) + history = (appendPat historyFlag) (P.silence:[]) } transition' pat' = do now <- Link.clock abletonLink ss <- Link.createAndCaptureAppSessionState abletonLink