From 52c5465d8751589305c6f06fe159c099008d5887 Mon Sep 17 00:00:00 2001 From: polymorphicengine Date: Sun, 16 Jun 2024 12:08:21 +0200 Subject: [PATCH 1/6] replace link operations by functions acting on a given sessionstate, the clock config and a clock reference --- src/Sound/Tidal/Stream/Process.hs | 54 ++++++------ src/Sound/Tidal/Stream/UI.hs | 4 +- tidal-link/src/hs/Sound/Tidal/Clock.hs | 112 ++++++++++--------------- 3 files changed, 72 insertions(+), 98 deletions(-) diff --git a/src/Sound/Tidal/Stream/Process.hs b/src/Sound/Tidal/Stream/Process.hs index 6d02e8a94..0053a491d 100644 --- a/src/Sound/Tidal/Stream/Process.hs +++ b/src/Sound/Tidal/Stream/Process.hs @@ -34,7 +34,6 @@ import Control.Monad (forM_, when) import Data.Coerce (coerce) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromJust, fromMaybe) -import Foreign.C.Types import System.IO (hPutStrLn, stderr) import qualified Sound.Osc.Fd as O @@ -47,7 +46,6 @@ import qualified Sound.Tidal.Link as Link import Sound.Tidal.Params (pS) import Sound.Tidal.Pattern import Sound.Tidal.Show () -import Sound.Tidal.Stream.Config import Sound.Tidal.Utils ((!!!)) import Sound.Tidal.Stream.Target @@ -57,7 +55,7 @@ data ProcessedEvent = ProcessedEvent { peHasOnset :: Bool, peEvent :: Event ValueMap, - peCps :: Link.BPM, + peCps :: Double, peDelta :: Link.Micros, peCycle :: Time, peOnWholeOrPart :: Link.Micros, @@ -88,9 +86,11 @@ doTick :: MVar ValueMap -- pattern state -> Maybe O.Udp -- network socket -> (Time,Time) -- current arc -> Double -- nudge - -> Clock.LinkOperations -- ableton link operations + -> Clock.ClockConfig -- config of the clock + -> Clock.ClockRef -- reference to the clock + -> Link.SessionState -> IO () -doTick stateMV busMV playMV globalFMV cxs listen (st,end) nudge ops = +doTick stateMV busMV playMV globalFMV cxs listen (st,end) nudge cconf cref ss = E.handle (\ (e :: E.SomeException) -> do hPutStrLn stderr $ "Failed to Stream.doTick: " ++ show e hPutStrLn stderr $ "Return to previous pattern." @@ -99,10 +99,10 @@ doTick stateMV busMV playMV globalFMV cxs listen (st,end) nudge ops = pMap <- readMVar playMV busses <- readMVar busMV sGlobalF <- readMVar globalFMV - bpm <- (Clock.getTempo ops) + bpm <- Clock.getTempo ss let patstack = sGlobalF $ playStack pMap - cps = ((Clock.beatToCycles ops) bpm) / 60 + cps = ((Clock.beatToCycles cconf) $ fromRational bpm) / 60 sMap' = Map.insert "_cps" (VF $ coerce cps) sMap extraLatency = nudge -- First the state is used to query the pattern @@ -112,7 +112,7 @@ doTick stateMV busMV playMV globalFMV cxs listen (st,end) nudge ops = ) -- Then it's passed through the events (sMap'', es') = resolveState sMap' es - tes <- processCps ops es' + tes <- processCps cconf cref ss es' -- For each OSC target forM_ cxs $ \cx@(Cx target _ oscs _ _) -> do -- Latency is configurable per target. @@ -124,27 +124,29 @@ doTick stateMV busMV playMV globalFMV cxs listen (st,end) nudge ops = hPutStrLn stderr $ "Failed to send. Is the '" ++ oName target ++ "' target running? " ++ show e putMVar stateMV sMap'') -processCps :: Clock.LinkOperations -> [Event ValueMap] -> IO [ProcessedEvent] -processCps ops = mapM processEvent +processCps :: Clock.ClockConfig -> Clock.ClockRef -> Link.SessionState -> [Event ValueMap] -> IO [ProcessedEvent] +processCps cconf cref ss = mapM processEvent where processEvent :: Event ValueMap -> IO ProcessedEvent processEvent e = do let wope = wholeOrPart e partStartCycle = start $ part e - partStartBeat = (Clock.cyclesToBeat ops) (realToFrac partStartCycle) + partStartBeat = (Clock.cyclesToBeat cconf) (realToFrac partStartCycle) onCycle = start wope - onBeat = (Clock.cyclesToBeat ops) (realToFrac onCycle) + onBeat = (Clock.cyclesToBeat cconf) (realToFrac onCycle) offCycle = stop wope - offBeat = (Clock.cyclesToBeat ops) (realToFrac offCycle) - on <- (Clock.timeAtBeat ops) onBeat - onPart <- (Clock.timeAtBeat ops) partStartBeat + offBeat = (Clock.cyclesToBeat cconf) (realToFrac offCycle) + on <- Clock.timeAtBeat cconf ss onBeat + onPart <- Clock.timeAtBeat cconf ss partStartBeat when (eventHasOnset e) (do let cps' = Map.lookup "cps" (value e) >>= getF - maybe (return ()) (\newCps -> (Clock.setTempo ops) ((Clock.cyclesToBeat ops) (newCps * 60)) on) $ coerce cps' + maybe (return ()) (\newCps -> Clock.setCPS cconf cref newCps) (fmap toRational cps') ) - off <- (Clock.timeAtBeat ops) offBeat - bpm <- (Clock.getTempo ops) - let cps = ((Clock.beatToCycles ops) bpm) / 60 + off <- Clock.timeAtBeat cconf ss offBeat + bpm <- Clock.getTempo ss + wholeOrPartOsc <- Clock.linkToOscTime cref on + onPartOsc <- Clock.linkToOscTime cref onPart + let cps = ((Clock.beatToCycles cconf) $ fromRational bpm) / 60 let delta = off - on return $! ProcessedEvent { peHasOnset = eventHasOnset e, @@ -153,9 +155,9 @@ processCps ops = mapM processEvent peDelta = delta, peCycle = onCycle, peOnWholeOrPart = on, - peOnWholeOrPartOsc = (Clock.linkToOscTime ops) on, + peOnWholeOrPartOsc = wholeOrPartOsc, peOnPart = onPart, - peOnPartOsc = (Clock.linkToOscTime ops) onPart + peOnPartOsc = onPartOsc } @@ -182,7 +184,7 @@ toOSC busses pe osc@(OSC _ _) -- Only events that start within the current nowArc are included playmsg | peHasOnset pe = do -- If there is already cps in the event, the union will preserve that. - let extra = Map.fromList [("cps", (VF (coerce $! peCps pe))), + let extra = Map.fromList [("cps", (VF (peCps pe))), ("delta", VF (Clock.addMicrosToOsc (peDelta pe) 0)), ("cycle", VF (fromRational (peCycle pe))) ] @@ -289,9 +291,9 @@ hasSolo = (>= 1) . length . filter psSolo . Map.elems -- However, since the full arc is processed at once and since Link does not support -- scheduling, tempo change may affect scheduling of events that happen earlier -- in the normal stream (the one handled by onTick). -onSingleTick :: Config -> Clock.ClockRef -> MVar ValueMap -> MVar [Int] -> MVar PlayMap -> MVar (ControlPattern -> ControlPattern) -> [Cx] -> Maybe O.Udp -> ControlPattern -> IO () -onSingleTick config clockRef stateMV busMV _ globalFMV cxs listen pat = do - ops <- Clock.getZeroedLinkOperations (cClockConfig config) clockRef +onSingleTick :: Clock.ClockConfig -> Clock.ClockRef -> MVar ValueMap -> MVar [Int] -> MVar PlayMap -> MVar (ControlPattern -> ControlPattern) -> [Cx] -> Maybe O.Udp -> ControlPattern -> IO () +onSingleTick clockConf clockRef stateMV busMV _ globalFMV cxs listen pat = do + ss <- Clock.getZeroedSessionState clockConf clockRef pMapMV <- newMVar $ Map.singleton "fake" (PlayState {psPattern = pat, psMute = False, @@ -300,7 +302,7 @@ onSingleTick config clockRef stateMV busMV _ globalFMV cxs listen pat = do } ) -- The nowArc is a full cycle - doTick stateMV busMV pMapMV globalFMV cxs listen (0,1) 0 ops + doTick stateMV busMV pMapMV globalFMV cxs listen (0,1) 0 clockConf clockRef ss diff --git a/src/Sound/Tidal/Stream/UI.hs b/src/Sound/Tidal/Stream/UI.hs index 41098889e..36f4f29f3 100644 --- a/src/Sound/Tidal/Stream/UI.hs +++ b/src/Sound/Tidal/Stream/UI.hs @@ -67,15 +67,13 @@ streamReplace stream k !pat = do hPutStrLn stderr $ "Return to previous pattern." setPreviousPatternOrSilence (sPMapMV stream)) (updatePattern stream k t pat) - -- = modifyMVar_ (sActionsMV s) (\actions -> return $ (T.StreamReplace k pat) : actions) - -- streamFirst but with random cycle instead of always first cicle streamOnce :: Stream -> ControlPattern -> IO () streamOnce st p = do i <- getStdRandom $ randomR (0, 8192) streamFirst st $ rotL (toRational (i :: Int)) p streamFirst :: Stream -> ControlPattern -> IO () -streamFirst stream pat = onSingleTick (sConfig stream) (sClockRef stream) (sStateMV stream) (sBusses stream) (sPMapMV stream) (sGlobalFMV stream) (sCxs stream) (sListen stream) pat +streamFirst stream pat = onSingleTick (cClockConfig $ sConfig stream) (sClockRef stream) (sStateMV stream) (sBusses stream) (sPMapMV stream) (sGlobalFMV stream) (sCxs stream) (sListen stream) pat streamMute :: Stream -> ID -> IO () streamMute s k = withPatIds s [k] (\x -> x {psMute = True}) diff --git a/tidal-link/src/hs/Sound/Tidal/Clock.hs b/tidal-link/src/hs/Sound/Tidal/Clock.hs index 1fa5db311..f753f0496 100644 --- a/tidal-link/src/hs/Sound/Tidal/Clock.hs +++ b/tidal-link/src/hs/Sound/Tidal/Clock.hs @@ -56,21 +56,9 @@ data ClockConfig } -- | action to be executed on a tick, --- | given the current timespan and nudge +-- | given the current timespan, nudge and reference to the clock type TickAction - = (Time,Time) -> Double -> LinkOperations -> IO () - --- | link operations for easy interaction with the clock -data LinkOperations - = LinkOperations - {timeAtBeat :: Link.Beat -> IO Link.Micros - ,timeToCycles :: Link.Micros -> IO Time - ,getTempo :: IO Link.BPM - ,setTempo :: Link.BPM -> Link.Micros -> IO () - ,linkToOscTime :: Link.Micros -> O.Time - ,beatToCycles :: CDouble -> CDouble - ,cyclesToBeat :: CDouble -> CDouble - } + = (Time,Time) -> Double -> ClockConfig -> ClockRef -> Link.SessionState -> IO () -- | possible actions for interacting with the clock data ClockAction @@ -187,34 +175,19 @@ tick = do -- hands the current link operations to the TickAction clockProcess :: Clock () clockProcess = do - (ClockMemory config (ClockRef _ abletonLink) action) <- ask + (ClockMemory config ref@(ClockRef _ abletonLink) action) <- ask st <- get let logicalEnd = logicalTime config (start st) $ ticks st + 1 startCycle = arcEnd $ nowArc st sessionState <- liftIO $ Link.createAndCaptureAppSessionState abletonLink - endCycle <- liftIO $ timeToCycles' config sessionState logicalEnd - - let st' = st {nowArc = (startCycle,endCycle)} - - nowOsc <- O.time - nowLink <- liftIO $ Link.clock abletonLink - - let ops = LinkOperations { - timeAtBeat = \beat -> Link.timeAtBeat sessionState beat (cQuantum config) , - timeToCycles = timeToCycles' config sessionState, - getTempo = Link.getTempo sessionState, - setTempo = Link.setTempo sessionState, - linkToOscTime = \lt -> addMicrosToOsc (lt - nowLink) nowOsc, - beatToCycles = \beat -> beat / (cBeatsPerCycle config), - cyclesToBeat = \cyc -> cyc * (cBeatsPerCycle config) - } + endCycle <- liftIO $ timeToCycles config sessionState logicalEnd - liftIO $ action (nowArc st') (nudged st') ops + liftIO $ action (startCycle,endCycle) (nudged st) config ref sessionState liftIO $ Link.commitAndDestroyAppSessionState abletonLink sessionState - put st' + put (st {nowArc = (startCycle,endCycle)}) tick processAction :: ClockAction -> Clock () @@ -240,7 +213,7 @@ processAction (SetCycle cyc) = do modify (\st -> st {ticks = 0, start = now, nowArc = (cyc,cyc)}) --------------------------------------------------------------- --------------------- helper functions ------------------------- +----------- functions representing link operations ------------ --------------------------------------------------------------- arcStart :: (Time, Time) -> Time @@ -249,8 +222,34 @@ arcStart = fst arcEnd :: (Time, Time) -> Time arcEnd = snd -timeToCycles' :: ClockConfig -> Link.SessionState -> Link.Micros -> IO Time -timeToCycles' config ss time = do +beatToCycles :: ClockConfig -> Double -> Double +beatToCycles config beat = beat / (coerce $ cBeatsPerCycle config) + +cyclesToBeat :: ClockConfig -> Double -> Double +cyclesToBeat config cyc = cyc * (coerce $ cBeatsPerCycle config) + +-- onSingleTick assumes it runs at beat 0. +-- The best way to achieve that is to use forceBeatAtTime. +-- But using forceBeatAtTime means we can not commit its session state. +-- Another session state, which we will commit, +-- is introduced to keep track of tempo changes. +getZeroedSessionState :: ClockConfig -> ClockRef -> IO Link.SessionState +getZeroedSessionState config (ClockRef _ abletonLink) = do + ss <- Link.createAndCaptureAppSessionState abletonLink + nowLink <- liftIO $ Link.clock abletonLink + Link.forceBeatAtTime ss 0 (nowLink + processAhead) (cQuantum config) + Link.destroySessionState ss + return ss + where processAhead = round $ (cProcessAhead config) * 1000000 + +getTempo :: Link.SessionState -> IO Time +getTempo ss = fmap toRational $ Link.getTempo ss + +timeAtBeat :: ClockConfig -> Link.SessionState -> Double -> IO Link.Micros +timeAtBeat config ss beat = Link.timeAtBeat ss (coerce beat) (cQuantum config) + +timeToCycles :: ClockConfig -> Link.SessionState -> Link.Micros -> IO Time +timeToCycles config ss time = do beat <- Link.beatAtTime ss time (cQuantum config) return $! (toRational beat) / (toRational (cBeatsPerCycle config)) @@ -260,6 +259,12 @@ cyclesToTime config ss cyc = do let beat = (fromRational cyc) * (cBeatsPerCycle config) Link.timeAtBeat ss beat (cQuantum config) +linkToOscTime :: ClockRef -> Link.Micros -> IO O.Time +linkToOscTime (ClockRef _ abletonLink) lt = do + nowOsc <- O.time + nowLink <- liftIO $ Link.clock abletonLink + return $ addMicrosToOsc (lt - nowLink) nowOsc + addMicrosToOsc :: Link.Micros -> O.Time -> O.Time addMicrosToOsc m t = ((fromIntegral m) / 1000000) + t @@ -274,6 +279,7 @@ logicalTime config startTime ticks' = startTime + ticks' * frameTimespan ----------- functions for interacting with the clock ---------- --------------------------------------------------------------- + getBPM :: ClockRef -> IO Time getBPM (ClockRef _ abletonLink) = do ss <- Link.createAndCaptureAppSessionState abletonLink @@ -288,42 +294,10 @@ getCycleTime :: ClockConfig -> ClockRef -> IO Time getCycleTime config (ClockRef _ abletonLink) = do now <- Link.clock abletonLink ss <- Link.createAndCaptureAppSessionState abletonLink - c <- timeToCycles' config ss now + c <- timeToCycles config ss now Link.destroySessionState ss return $! c --- onSingleTick assumes it runs at beat 0. --- The best way to achieve that is to use forceBeatAtTime. --- But using forceBeatAtTime means we can not commit its session state. --- Another session state, which we will commit, --- is introduced to keep track of tempo changes. -getZeroedLinkOperations :: ClockConfig -> ClockRef -> IO LinkOperations -getZeroedLinkOperations config (ClockRef _ abletonLink) = do - sessionState <- Link.createAndCaptureAppSessionState abletonLink - zeroedSessionState <- Link.createAndCaptureAppSessionState abletonLink - - nowOsc <- O.time - nowLink <- Link.clock abletonLink - - Link.forceBeatAtTime zeroedSessionState 0 (nowLink + processAhead) (cQuantum config) - - Link.commitAndDestroyAppSessionState abletonLink sessionState - Link.destroySessionState zeroedSessionState - - return $ LinkOperations { - timeAtBeat = \beat -> Link.timeAtBeat zeroedSessionState beat (cQuantum config), - timeToCycles = timeToCycles' config zeroedSessionState, - getTempo = Link.getTempo zeroedSessionState, - setTempo = \bpm micros -> - Link.setTempo zeroedSessionState bpm micros >> - Link.setTempo sessionState bpm micros, - linkToOscTime = \lt -> addMicrosToOsc (lt - nowLink) nowOsc, - beatToCycles = \beat -> beat / (cBeatsPerCycle config), - cyclesToBeat = \cyc -> cyc * (cBeatsPerCycle config) - } - where processAhead = round $ (cProcessAhead config) * 1000000 - - resetClock :: ClockRef -> IO () resetClock clock = setClock clock 0 From f237849dda0acd7cf50514606782d5749ad2f096 Mon Sep 17 00:00:00 2001 From: polymorphicengine Date: Sun, 16 Jun 2024 12:21:20 +0200 Subject: [PATCH 2/6] second session state is not needed since we can just use setCPS / setBPM which will create it for us --- tidal-link/src/hs/Sound/Tidal/Clock.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/tidal-link/src/hs/Sound/Tidal/Clock.hs b/tidal-link/src/hs/Sound/Tidal/Clock.hs index f753f0496..2e7f1f17f 100644 --- a/tidal-link/src/hs/Sound/Tidal/Clock.hs +++ b/tidal-link/src/hs/Sound/Tidal/Clock.hs @@ -231,8 +231,6 @@ cyclesToBeat config cyc = cyc * (coerce $ cBeatsPerCycle config) -- onSingleTick assumes it runs at beat 0. -- The best way to achieve that is to use forceBeatAtTime. -- But using forceBeatAtTime means we can not commit its session state. --- Another session state, which we will commit, --- is introduced to keep track of tempo changes. getZeroedSessionState :: ClockConfig -> ClockRef -> IO Link.SessionState getZeroedSessionState config (ClockRef _ abletonLink) = do ss <- Link.createAndCaptureAppSessionState abletonLink From 81c19870a81294e4b5def9cdc24365fa0b23e726 Mon Sep 17 00:00:00 2001 From: polymorphicengine Date: Tue, 18 Jun 2024 23:41:12 +0200 Subject: [PATCH 3/6] use setTempoCPS for instant cps change instead of setCPS --- src/Sound/Tidal/Stream/Process.hs | 2 +- tidal-link/src/hs/Sound/Tidal/Clock.hs | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Sound/Tidal/Stream/Process.hs b/src/Sound/Tidal/Stream/Process.hs index 0053a491d..eb6927bda 100644 --- a/src/Sound/Tidal/Stream/Process.hs +++ b/src/Sound/Tidal/Stream/Process.hs @@ -140,7 +140,7 @@ processCps cconf cref ss = mapM processEvent onPart <- Clock.timeAtBeat cconf ss partStartBeat when (eventHasOnset e) (do let cps' = Map.lookup "cps" (value e) >>= getF - maybe (return ()) (\newCps -> Clock.setCPS cconf cref newCps) (fmap toRational cps') + maybe (return ()) (\newCps -> Clock.setTempoCPS newCps on cconf ss) (fmap toRational cps') ) off <- Clock.timeAtBeat cconf ss offBeat bpm <- Clock.getTempo ss diff --git a/tidal-link/src/hs/Sound/Tidal/Clock.hs b/tidal-link/src/hs/Sound/Tidal/Clock.hs index 2e7f1f17f..97dbd133e 100644 --- a/tidal-link/src/hs/Sound/Tidal/Clock.hs +++ b/tidal-link/src/hs/Sound/Tidal/Clock.hs @@ -243,6 +243,9 @@ getZeroedSessionState config (ClockRef _ abletonLink) = do getTempo :: Link.SessionState -> IO Time getTempo ss = fmap toRational $ Link.getTempo ss +setTempoCPS :: Time -> Link.Micros -> ClockConfig -> Link.SessionState -> IO () +setTempoCPS cps now conf ss = Link.setTempo ss (coerce $ cyclesToBeat conf ((fromRational cps) * 60)) now + timeAtBeat :: ClockConfig -> Link.SessionState -> Double -> IO Link.Micros timeAtBeat config ss beat = Link.timeAtBeat ss (coerce beat) (cQuantum config) From 5e09ab8f3729e7a995fb978dfbc446fd436281b7 Mon Sep 17 00:00:00 2001 From: polymorphicengine Date: Wed, 19 Jun 2024 20:28:00 +0200 Subject: [PATCH 4/6] introduce additional session state in doTick to only handle tempo changes happening during the querying of patterns (via cps parameter) --- src/Sound/Tidal/Stream/Process.hs | 18 ++++++++++-------- tidal-link/src/hs/Sound/Tidal/Clock.hs | 8 +++++--- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/src/Sound/Tidal/Stream/Process.hs b/src/Sound/Tidal/Stream/Process.hs index eb6927bda..069504d1a 100644 --- a/src/Sound/Tidal/Stream/Process.hs +++ b/src/Sound/Tidal/Stream/Process.hs @@ -88,9 +88,9 @@ doTick :: MVar ValueMap -- pattern state -> Double -- nudge -> Clock.ClockConfig -- config of the clock -> Clock.ClockRef -- reference to the clock - -> Link.SessionState + -> (Link.SessionState, Link.SessionState) -- second session state is for keeping track of tempo changes -> IO () -doTick stateMV busMV playMV globalFMV cxs listen (st,end) nudge cconf cref ss = +doTick stateMV busMV playMV globalFMV cxs listen (st,end) nudge cconf cref (ss, temposs) = E.handle (\ (e :: E.SomeException) -> do hPutStrLn stderr $ "Failed to Stream.doTick: " ++ show e hPutStrLn stderr $ "Return to previous pattern." @@ -112,7 +112,7 @@ doTick stateMV busMV playMV globalFMV cxs listen (st,end) nudge cconf cref ss = ) -- Then it's passed through the events (sMap'', es') = resolveState sMap' es - tes <- processCps cconf cref ss es' + tes <- processCps cconf cref (ss, temposs) es' -- For each OSC target forM_ cxs $ \cx@(Cx target _ oscs _ _) -> do -- Latency is configurable per target. @@ -124,8 +124,8 @@ doTick stateMV busMV playMV globalFMV cxs listen (st,end) nudge cconf cref ss = hPutStrLn stderr $ "Failed to send. Is the '" ++ oName target ++ "' target running? " ++ show e putMVar stateMV sMap'') -processCps :: Clock.ClockConfig -> Clock.ClockRef -> Link.SessionState -> [Event ValueMap] -> IO [ProcessedEvent] -processCps cconf cref ss = mapM processEvent +processCps :: Clock.ClockConfig -> Clock.ClockRef -> (Link.SessionState, Link.SessionState) -> [Event ValueMap] -> IO [ProcessedEvent] +processCps cconf cref (ss, temposs) = mapM processEvent where processEvent :: Event ValueMap -> IO ProcessedEvent processEvent e = do @@ -140,7 +140,7 @@ processCps cconf cref ss = mapM processEvent onPart <- Clock.timeAtBeat cconf ss partStartBeat when (eventHasOnset e) (do let cps' = Map.lookup "cps" (value e) >>= getF - maybe (return ()) (\newCps -> Clock.setTempoCPS newCps on cconf ss) (fmap toRational cps') + maybe (return ()) (\newCps -> Clock.setTempoCPS newCps on cconf temposs) (fmap toRational cps') ) off <- Clock.timeAtBeat cconf ss offBeat bpm <- Clock.getTempo ss @@ -294,6 +294,7 @@ hasSolo = (>= 1) . length . filter psSolo . Map.elems onSingleTick :: Clock.ClockConfig -> Clock.ClockRef -> MVar ValueMap -> MVar [Int] -> MVar PlayMap -> MVar (ControlPattern -> ControlPattern) -> [Cx] -> Maybe O.Udp -> ControlPattern -> IO () onSingleTick clockConf clockRef stateMV busMV _ globalFMV cxs listen pat = do ss <- Clock.getZeroedSessionState clockConf clockRef + temposs <- Clock.getSessionState clockRef pMapMV <- newMVar $ Map.singleton "fake" (PlayState {psPattern = pat, psMute = False, @@ -302,8 +303,9 @@ onSingleTick clockConf clockRef stateMV busMV _ globalFMV cxs listen pat = do } ) -- The nowArc is a full cycle - doTick stateMV busMV pMapMV globalFMV cxs listen (0,1) 0 clockConf clockRef ss - + doTick stateMV busMV pMapMV globalFMV cxs listen (0,1) 0 clockConf clockRef (ss, temposs) + Link.destroySessionState ss + Link.commitAndDestroyAppSessionState (Clock.rAbletonLink clockRef) temposs -- Used for Tempo callback diff --git a/tidal-link/src/hs/Sound/Tidal/Clock.hs b/tidal-link/src/hs/Sound/Tidal/Clock.hs index 97dbd133e..f6ca6a4ad 100644 --- a/tidal-link/src/hs/Sound/Tidal/Clock.hs +++ b/tidal-link/src/hs/Sound/Tidal/Clock.hs @@ -58,7 +58,7 @@ data ClockConfig -- | action to be executed on a tick, -- | given the current timespan, nudge and reference to the clock type TickAction - = (Time,Time) -> Double -> ClockConfig -> ClockRef -> Link.SessionState -> IO () + = (Time,Time) -> Double -> ClockConfig -> ClockRef -> (Link.SessionState, Link.SessionState) -> IO () -- | possible actions for interacting with the clock data ClockAction @@ -183,7 +183,7 @@ clockProcess = do sessionState <- liftIO $ Link.createAndCaptureAppSessionState abletonLink endCycle <- liftIO $ timeToCycles config sessionState logicalEnd - liftIO $ action (startCycle,endCycle) (nudged st) config ref sessionState + liftIO $ action (startCycle,endCycle) (nudged st) config ref (sessionState, sessionState) liftIO $ Link.commitAndDestroyAppSessionState abletonLink sessionState @@ -228,6 +228,9 @@ beatToCycles config beat = beat / (coerce $ cBeatsPerCycle config) cyclesToBeat :: ClockConfig -> Double -> Double cyclesToBeat config cyc = cyc * (coerce $ cBeatsPerCycle config) +getSessionState :: ClockRef -> IO Link.SessionState +getSessionState (ClockRef _ abletonLink) = Link.createAndCaptureAppSessionState abletonLink + -- onSingleTick assumes it runs at beat 0. -- The best way to achieve that is to use forceBeatAtTime. -- But using forceBeatAtTime means we can not commit its session state. @@ -236,7 +239,6 @@ getZeroedSessionState config (ClockRef _ abletonLink) = do ss <- Link.createAndCaptureAppSessionState abletonLink nowLink <- liftIO $ Link.clock abletonLink Link.forceBeatAtTime ss 0 (nowLink + processAhead) (cQuantum config) - Link.destroySessionState ss return ss where processAhead = round $ (cProcessAhead config) * 1000000 From 7b6fe7f4fb4b4f9f8f511f51d0f3a7d5366de556 Mon Sep 17 00:00:00 2001 From: polymorphicengine Date: Tue, 25 Jun 2024 19:50:20 +0200 Subject: [PATCH 5/6] add clockOnce, so it doesn't have to be defined in the stream module --- src/Sound/Tidal/Stream/Process.hs | 15 ++------------- tidal-link/src/hs/Sound/Tidal/Clock.hs | 16 ++++++++++++++-- 2 files changed, 16 insertions(+), 15 deletions(-) diff --git a/src/Sound/Tidal/Stream/Process.hs b/src/Sound/Tidal/Stream/Process.hs index 069504d1a..d3d9713db 100644 --- a/src/Sound/Tidal/Stream/Process.hs +++ b/src/Sound/Tidal/Stream/Process.hs @@ -285,16 +285,8 @@ playStack pMap = stack . (map psPattern) . (filter active) . Map.elems $ pMap hasSolo :: Map.Map k PlayState -> Bool hasSolo = (>= 1) . length . filter psSolo . Map.elems - --- Used for Tempo callback --- Tempo changes will be applied. --- However, since the full arc is processed at once and since Link does not support --- scheduling, tempo change may affect scheduling of events that happen earlier --- in the normal stream (the one handled by onTick). onSingleTick :: Clock.ClockConfig -> Clock.ClockRef -> MVar ValueMap -> MVar [Int] -> MVar PlayMap -> MVar (ControlPattern -> ControlPattern) -> [Cx] -> Maybe O.Udp -> ControlPattern -> IO () -onSingleTick clockConf clockRef stateMV busMV _ globalFMV cxs listen pat = do - ss <- Clock.getZeroedSessionState clockConf clockRef - temposs <- Clock.getSessionState clockRef +onSingleTick clockConfig clockRef stateMV busMV _ globalFMV cxs listen pat = do pMapMV <- newMVar $ Map.singleton "fake" (PlayState {psPattern = pat, psMute = False, @@ -302,10 +294,7 @@ onSingleTick clockConf clockRef stateMV busMV _ globalFMV cxs listen pat = do psHistory = [] } ) - -- The nowArc is a full cycle - doTick stateMV busMV pMapMV globalFMV cxs listen (0,1) 0 clockConf clockRef (ss, temposs) - Link.destroySessionState ss - Link.commitAndDestroyAppSessionState (Clock.rAbletonLink clockRef) temposs + Clock.clockOnce (doTick stateMV busMV pMapMV globalFMV cxs listen) clockConfig clockRef -- Used for Tempo callback diff --git a/tidal-link/src/hs/Sound/Tidal/Clock.hs b/tidal-link/src/hs/Sound/Tidal/Clock.hs index f6ca6a4ad..cfb153fb1 100644 --- a/tidal-link/src/hs/Sound/Tidal/Clock.hs +++ b/tidal-link/src/hs/Sound/Tidal/Clock.hs @@ -66,7 +66,6 @@ data ClockAction | SetCycle Time | SetTempo Time | SetNudge Double - deriving Show defaultCps :: Double defaultCps = 0.575 @@ -282,7 +281,6 @@ logicalTime config startTime ticks' = startTime + ticks' * frameTimespan ----------- functions for interacting with the clock ---------- --------------------------------------------------------------- - getBPM :: ClockRef -> IO Time getBPM (ClockRef _ abletonLink) = do ss <- Link.createAndCaptureAppSessionState abletonLink @@ -329,6 +327,20 @@ setNudge (ClockRef clock _) n = atomically $ do NoAction -> modifyTVar' clock (const $ SetNudge n) _ -> retry +-- Used for Tempo callback +-- Tempo changes will be applied. +-- However, since the full arc is processed at once and since Link does not support +-- scheduling, tempo change may affect scheduling of events that happen earlier +-- in the normal stream (the one handled by onTick). +clockOnce :: TickAction -> ClockConfig -> ClockRef -> IO () +clockOnce action config ref@(ClockRef _ abletonLink) = do + ss <- getZeroedSessionState config ref + temposs <- Link.createAndCaptureAppSessionState abletonLink + -- The nowArc is a full cycle + action (0,1) 0 config ref (ss, temposs) + Link.destroySessionState ss + Link.commitAndDestroyAppSessionState abletonLink temposs + disableLink :: ClockRef -> IO () disableLink (ClockRef _ abletonLink) = Link.disable abletonLink From 130023099328c78c00d5cba10d21fea839dfb130 Mon Sep 17 00:00:00 2001 From: polymorphicengine Date: Tue, 25 Jun 2024 19:51:10 +0200 Subject: [PATCH 6/6] bump tidal-link version to 1.0.4 --- tidal-link/tidal-link.cabal | 2 +- tidal.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tidal-link/tidal-link.cabal b/tidal-link/tidal-link.cabal index 94c169358..28295c0d2 100644 --- a/tidal-link/tidal-link.cabal +++ b/tidal-link/tidal-link.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: tidal-link -version: 1.0.3 +version: 1.0.4 synopsis: Ableton Link integration for Tidal -- description: homepage: http://tidalcycles.org/ diff --git a/tidal.cabal b/tidal.cabal index bf4c9dbc3..f8adee1ad 100644 --- a/tidal.cabal +++ b/tidal.cabal @@ -73,7 +73,7 @@ library , random < 1.3 , exceptions < 0.11 , mtl >= 2.2 - , tidal-link == 1.0.3 + , tidal-link == 1.0.4 test-suite tests type: exitcode-stdio-1.0