Merge pull request #1090 from polymorphicengine/dev

simplify the clock logic by removing LinkOperations

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,25 +285,16 @@ 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,
                       psSolo = False,
                       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

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})

tidal-link/src/hs/Sound/Tidal/Clock.hs

@@ -56,29 +56,16 @@ 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
   = NoAction
   | 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
 

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/

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