avoid possibility of doubling of events immediately following mid-fra…

…me cps changes, fixes tidalcycles#501
jamagin · Aug 25, 2019 · 3ceea79 · 3ceea79
1 parent 9a08f69
commit 3ceea79
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 7 deletions.
diff --git a/src/Sound/Tidal/Stream.hs b/src/Sound/Tidal/Stream.hs
@@ -202,7 +202,8 @@ onTick config sMapMV pMV cxs tempoMV st =
      sMap <- readMVar sMapMV
      tempo <- takeMVar tempoMV
      now <- O.time
-     let sMap' = Map.insert "_cps" (pure $ VF $ T.cps tempo) sMap
+     let frameEnd = snd $ T.nowTimespan st
+         sMap' = Map.insert "_cps" (pure $ VF $ T.cps tempo) sMap
          es = sortOn (start . part) $ filterOns $ query p (State {arc = T.nowArc st, controls = sMap'})
          filterOns | cSendParts config = id
                    | otherwise = filter eventHasOnset
@@ -219,7 +220,12 @@ onTick config sMapMV pMV cxs tempoMV st =
          latency target = oLatency target + cFrameTimespan config + T.nudged tempo
          (tes, tempo') = processCps tempo es
      mapM_ (\(Cx target udp) -> (do let ms = catMaybes $ map (\(t, e) -> do m <- toMessage config (on e t + latency target) target tempo e
-                                                                            return (on e t, m)
+                                                                            let onset = on e t
+                                                                            -- drop events that have gone out of frame (due to tempo
+                                                                            -- changes during the frame)
+                                                                            if (onset < frameEnd)
+                                                                              then Just (onset, m)
+                                                                              else  Nothing
                                                              ) tes
                                     E.catch (mapM_ (send target (latency target) udp) ms)
                                 )

diff --git a/src/Sound/Tidal/Tempo.hs b/src/Sound/Tidal/Tempo.hs
@@ -36,7 +36,7 @@ data Tempo = Tempo {atTime  :: O.Time,
 
 data State = State {ticks   :: Int,
                     start   :: O.Time,
-                    nowTime :: O.Time,
+                    nowTimespan :: (O.Time, O.Time),
                     nowArc  :: P.Arc,
                     starting :: Bool
                    }
@@ -100,18 +100,19 @@ clocked config callback
        (tempoMV, listenTid) <- clientListen config s
        let st = State {ticks = 0,
                        start = s,
-                       nowTime = s,
+                       nowTimespan = (s, s + frameTimespan),
                        nowArc = P.Arc 0 0,
                        starting = True
                       }
        clockTid <- forkIO $ loop tempoMV st
        return (tempoMV, [listenTid, clockTid])
-  where loop tempoMV st =
+  where frameTimespan :: Double
+        frameTimespan = cFrameTimespan config
+        loop tempoMV st =
           do -- putStrLn $ show $ nowArc ts
              tempo <- readMVar tempoMV               
              t <- O.time
-             let frameTimespan = cFrameTimespan config
-                 logicalT ticks' = start st + fromIntegral ticks' * frameTimespan
+             let logicalT ticks' = start st + fromIntegral ticks' *  frameTimespan
                  logicalNow = logicalT $ ticks st + 1
                  -- Wait maximum of two frames
                  delta = min (frameTimespan * 2) (logicalNow - t)
@@ -128,6 +129,7 @@ clocked config callback
                          | otherwise = (ticks st) + 1
                  st' = st {ticks = newTick,
                            nowArc = P.Arc s e,
+                           nowTimespan = (logicalNow,  logicalNow + frameTimespan),
                            starting = not (synched tempo)
                           }
              when ahead $ putStrLn $ "skip: " ++ show (actualTick - ticks st)