tidal 1.4.0 → 1.4.1

raw patch · 7 files changed

+57/−24 lines, 7 files

Files

• CHANGELOG.md +5/−0
• src/Sound/Tidal/Pattern.hs +1/−1
• src/Sound/Tidal/Stream.hs +25/−10
• src/Sound/Tidal/Tempo.hs +23/−7
• src/Sound/Tidal/UI.hs +1/−4
• src/Sound/Tidal/Version.hs +1/−1
• tidal.cabal +1/−1

@@ -1,5 +1,10 @@ # TidalCycles log of changes +## 1.4.1 - Carl Wark++* improvements to handling of cps changes @yaxu #501+* fix for parameter patterning in 'range' @yaxu #547+ ## 1.4.0 - Padley Gorge  * fix representation to handle continuous and analog events properly @yaxu

@@ -422,7 +422,7 @@ innerJoin :: Pattern (Pattern a) -> Pattern a innerJoin pp = pp {query = q}   where q st = concatMap-               (\(Event _ p v) -> mapMaybe munge $ query v st {arc = p}+               (\(Event _ op v) -> mapMaybe munge $ query v st {arc = op}           )           (query pp st)           where munge (Event iw ip v) =

@@ -23,6 +23,7 @@ import           Sound.Tidal.Pattern import qualified Sound.Tidal.Tempo as T -- import qualified Sound.OSC.Datum as O+import           Data.List (sortOn)  data TimeStamp = BundleStamp | MessageStamp | NoStamp  deriving (Eq, Show)@@ -199,26 +200,40 @@ onTick config sMapMV pMV cxs tempoMV st =   do p <- readMVar pMV      sMap <- readMVar sMapMV-     tempo <- readMVar tempoMV+     tempo <- takeMVar tempoMV      now <- O.time-     let sMap' = Map.insert "_cps" (pure $ VF $ T.cps tempo) sMap-         es = filterOns $ query p (State {arc = T.nowArc st, controls = 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            -- there should always be a whole (due to the eventHasOnset filter)-         on e = (sched tempo $ start $ wholeOrPart e) + eventNudge e+         on e tempo' = (sched tempo' $ start $ wholeOrPart e) + eventNudge e          eventNudge e = fromJust $ getF $ fromMaybe (VF 0) $ Map.lookup "nudge" $ value e-         messages target = catMaybes $ map (\e -> do m <- toMessage config (on e + latency target) target tempo e-                                                     return $ (on e, m)-                                           ) es-         cpsChanges = map (\e -> (on e - now, Map.lookup "cps" $ value e)) es+         processCps :: T.Tempo -> [Event ControlMap] -> ([(T.Tempo, Event ControlMap)], T.Tempo)+         processCps tempo [] = ([], tempo)+         processCps tempo (e:es) = (((tempo', e):es'), tempo'')+           where cps' = do x <- Map.lookup "cps" $ value e+                           getF x+                 tempo' = (maybe tempo (\newCps -> T.changeTempo' tempo newCps (eventPartStart e)) cps')+                 (es', tempo'') = processCps tempo' es          latency target = oLatency target + cFrameTimespan config + T.nudged tempo-     mapM_ (\(Cx target udp) -> E.catch (mapM_ (send target (latency target) udp) (messages target))+         (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+                                                                            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)+                                )                        (\(e ::E.SomeException)                         -> putStrLn $ "Failed to send. Is the '" ++ oName target ++ "' target running? " ++ show e                        )            ) cxs-     mapM_ (doCps tempoMV) cpsChanges+     putMVar tempoMV tempo'      return ()  send :: O.Transport t => OSCTarget -> Double -> t -> (Double, O.Message) -> IO ()

@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}+{-# LANGUAGE RecordWildCards #-}  module Sound.Tidal.Tempo where @@ -11,11 +12,14 @@ import qualified Network.Socket as N import Control.Concurrent (forkIO, ThreadId, threadDelay) import Control.Monad (forever, when, foldM)-import Data.List (isPrefixOf, nub)+import Data.List (isPrefixOf, nub, intercalate) import qualified Control.Exception as E  import Sound.Tidal.Config +instance Show O.UDP where+  show x = "-unshowable-"+ data Tempo = Tempo {atTime  :: O.Time,                     atCycle :: Rational,                     cps     :: O.Time,@@ -25,14 +29,14 @@                     remoteAddr :: N.SockAddr,                     synched :: Bool                    }-           -- deriving Show+  deriving Show  -- sendTempo udp tempo remote_sockaddr             --   data State = State {ticks   :: Int,                     start   :: O.Time,-                    nowTime :: O.Time,+                    nowTimespan :: (O.Time, O.Time),                     nowArc  :: P.Arc,                     starting :: Bool                    }@@ -45,6 +49,11 @@                            putMVar tempoMV tempo'                            return tempo' +changeTempo' :: Tempo -> O.Time -> Rational -> Tempo+changeTempo' tempo newCps cyc = tempo {atTime = cyclesToTime tempo cyc,+                                       cps = newCps,+                                       atCycle = cyc+                                      }  resetCycles :: MVar Tempo -> IO Tempo resetCycles tempoMV = changeTempo tempoMV (\t tempo -> tempo {atTime = t, atCycle = 0})@@ -73,6 +82,11 @@   where delta = t - atTime tempo         cycleDelta = realToFrac (cps tempo) * delta +cyclesToTime :: Tempo -> Rational -> O.Time+cyclesToTime tempo cyc = atTime tempo + (fromRational timeDelta)+  where cycleDelta = cyc - atCycle tempo+        timeDelta = cycleDelta / (toRational $ cps tempo)+ {- getCurrentCycle :: MVar Tempo -> IO Rational getCurrentCycle t = (readMVar t) >>= (cyclesNow) >>= (return . toRational)@@ -86,18 +100,19 @@        (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)@@ -114,6 +129,7 @@                          | 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)

@@ -1565,10 +1565,7 @@ -}  range :: Num a => Pattern a -> Pattern a -> Pattern a -> Pattern a-range fromP toP p = do-  from <- fromP-  to <- toP-  _range from to p+range fromP toP p = (\from to v -> ((v * (to-from)) + from)) <$> fromP *> toP *> p  _range :: (Functor f, Num b) => b -> b -> f b -> f b _range from to p = (+ from) . (* (to-from)) <$> p

@@ -1,4 +1,4 @@ module Sound.Tidal.Version where  tidal_version :: String-tidal_version = "1.4.0"+tidal_version = "1.4.1"

@@ -1,5 +1,5 @@ name:                tidal-version:             1.4.0+version:             1.4.1 synopsis:            Pattern language for improvised music -- description: homepage:            http://tidalcycles.org/