diff --git a/src/Sound/Tidal/Stream/Process.hs b/src/Sound/Tidal/Stream/Process.hs index 6d02e8a94..d3d9713db 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, Link.SessionState) -- second session state is for keeping track of tempo changes -> 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, temposs) = 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, temposs) 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, Link.SessionState) -> [Event ValueMap] -> IO [ProcessedEvent] +processCps cconf cref (ss, temposs) = 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.setTempoCPS newCps on cconf temposs) (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))) ] @@ -283,15 +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 :: 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 clockConfig clockRef stateMV busMV _ globalFMV cxs listen pat = do pMapMV <- newMVar $ Map.singleton "fake" (PlayState {psPattern = pat, psMute = False, @@ -299,9 +294,7 @@ onSingleTick config 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 ops - + Clock.clockOnce (doTick stateMV busMV pMapMV globalFMV cxs listen) clockConfig clockRef -- Used for Tempo callback 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..cfb153fb1 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, Link.SessionState) -> IO () -- | possible actions for interacting with the clock data ClockAction @@ -78,7 +66,6 @@ data ClockAction | SetCycle Time | SetTempo Time | SetNudge Double - deriving Show defaultCps :: Double defaultCps = 0.575 @@ -187,34 +174,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 + endCycle <- liftIO $ timeToCycles config sessionState logicalEnd - 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) - } - - liftIO $ action (nowArc st') (nudged st') ops + liftIO $ action (startCycle,endCycle) (nudged st) config ref (sessionState, sessionState) liftIO $ Link.commitAndDestroyAppSessionState abletonLink sessionState - put st' + put (st {nowArc = (startCycle,endCycle)}) tick processAction :: ClockAction -> Clock () @@ -240,7 +212,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 +221,37 @@ 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) + +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. +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) + return ss + where processAhead = round $ (cProcessAhead config) * 1000000 + +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) + +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 +261,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 @@ -288,42 +295,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 @@ -352,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 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