diff --git a/Sound/Tidal/Dirt.hs b/Sound/Tidal/Dirt.hs --- a/Sound/Tidal/Dirt.hs +++ b/Sound/Tidal/Dirt.hs @@ -43,8 +43,10 @@ F "hcutoff" (Just 0), F "hresonance" (Just 0), F "bandf" (Just 0), - F "bandq" (Just 0) + F "bandq" (Just 0), + S "unit" (Just "rate") ], + cpsStamp = True, timestamp = MessageStamp, latency = 0.04, namedParams = False, @@ -56,6 +58,7 @@ params = [ I "ksymbol" Nothing, F "kpitch" (Just 1) ], + cpsStamp = False, timestamp = MessageStamp, latency = 0.04, namedParams = False, @@ -133,7 +136,7 @@ hresonance = makeF dirt "hresonance" bandf = makeF dirt "bandf" bandq = makeF dirt "bandq" - +unit = makeS dirt "unit" cut :: Pattern Int -> OscPattern cut = makeI dirt "cut" diff --git a/Sound/Tidal/Pattern.hs b/Sound/Tidal/Pattern.hs --- a/Sound/Tidal/Pattern.hs +++ b/Sound/Tidal/Pattern.hs @@ -218,7 +218,7 @@ (~>) = (<~) . (0-) brak :: Pattern a -> Pattern a -brak = every 2 (((1%4) ~>) . (\x -> cat [x, silence])) +brak = when ((== 1) . (`mod` 2)) (((1%4) ~>) . (\x -> cat [x, silence])) iter :: Int -> Pattern a -> Pattern a iter n p = slowcat $ map (\i -> ((fromIntegral i)%(fromIntegral n)) <~ p) [0 .. n] diff --git a/Sound/Tidal/Strategies.hs b/Sound/Tidal/Strategies.hs --- a/Sound/Tidal/Strategies.hs +++ b/Sound/Tidal/Strategies.hs @@ -97,7 +97,7 @@ inside n f p = density n $ f (slow n p) stut :: Integer -> Double -> Rational -> OscPattern -> OscPattern -stut steps feedback time p = stack (p:(map (\x -> (((x%steps)*time) ~> (p |+| gain (pure $ scale (fromIntegral x))))) [0..(steps-1)])) +stut steps feedback time p = stack (p:(map (\x -> (((x%steps)*time) ~> (p |+| gain (pure $ scale (fromIntegral x))))) [1..(steps-1)])) where scale x = ((+feedback) . (*(1-feedback)) . (/(fromIntegral steps)) . ((fromIntegral steps)-)) x diff --git a/Sound/Tidal/Stream.hs b/Sound/Tidal/Stream.hs --- a/Sound/Tidal/Stream.hs +++ b/Sound/Tidal/Stream.hs @@ -15,7 +15,7 @@ import Sound.Tidal.Pattern import qualified Sound.Tidal.Parse as P -import Sound.Tidal.Tempo (Tempo, logicalTime, clocked,clockedTick) +import Sound.Tidal.Tempo (Tempo, logicalTime, clocked,clockedTick,cps) import Sound.Tidal.Utils import qualified Data.Map as Map @@ -37,6 +37,7 @@ data OscShape = OscShape {path :: String, params :: [Param], + cpsStamp :: Bool, timestamp :: TimeStamp, latency :: Double, namedParams :: Bool, @@ -85,7 +86,7 @@ logicalOnset = logicalNow + (logicalPeriod * o) + (latency shape) sec = floor logicalOnset usec = floor $ 1000000 * (logicalOnset - (fromIntegral sec)) - oscdata = preamble shape ++ (parameterise $ catMaybes $ mapMaybe (\x -> Map.lookup x m') (params shape)) + oscdata = cpsPrefix ++ preamble shape ++ (parameterise $ catMaybes $ mapMaybe (\x -> Map.lookup x m') (params shape)) oscdata' = ((int32 sec):(int32 usec):oscdata) osc | timestamp shape == BundleStamp = sendOSC s $ Bundle (ut_to_ntpr logicalOnset) [Message (path shape) oscdata] | timestamp shape == MessageStamp = sendOSC s $ Message (path shape) oscdata' @@ -96,6 +97,8 @@ parameterise ds | namedParams shape = mergelists (map (string . name) (params shape)) ds | otherwise = ds + cpsPrefix | cpsStamp shape = [float (cps change)] + | otherwise = [] doAt t action = do forkIO $ do now <- getCurrentTime let nowf = realToFrac $ utcTimeToPOSIXSeconds now diff --git a/Sound/Tidal/SuperCollider.hs b/Sound/Tidal/SuperCollider.hs --- a/Sound/Tidal/SuperCollider.hs +++ b/Sound/Tidal/SuperCollider.hs @@ -14,6 +14,7 @@ preamble = [string n, int32 (-1), int32 1, int32 1], namedParams = True, params = ps, + cpsStamp = False, timestamp = BundleStamp, latency = l } diff --git a/Sound/Tidal/Tempo.hs b/Sound/Tidal/Tempo.hs --- a/Sound/Tidal/Tempo.hs +++ b/Sound/Tidal/Tempo.hs @@ -19,14 +19,14 @@ import Sound.Tidal.Utils -data Tempo = Tempo {at :: UTCTime, beat :: Double, bps :: Double} +data Tempo = Tempo {at :: UTCTime, beat :: Double, cps :: Double} type ClientState = [WS.Connection] instance Eq WS.Connection instance Show Tempo where - show x = show (at x) ++ "," ++ show (beat x) ++ "," ++ show (bps x) + show x = show (at x) ++ "," ++ show (beat x) ++ "," ++ show (cps x) getClockIp :: IO String getClockIp = getEnvDefault "127.0.0.1" "TIDAL_TEMPO_IP" @@ -41,7 +41,7 @@ logicalTime :: Tempo -> Double -> Double logicalTime t b = changeT + timeDelta where beatDelta = b - (beat t) - timeDelta = beatDelta / (bps t) + timeDelta = beatDelta / (cps t) changeT = realToFrac $ utcTimeToPOSIXSeconds $ at t tempoMVar :: IO (MVar (Tempo)) @@ -55,13 +55,13 @@ beatNow :: Tempo -> IO (Double) beatNow t = do now <- getCurrentTime let delta = realToFrac $ diffUTCTime now (at t) - let beatDelta = bps t * delta + let beatDelta = cps t * delta return $ beat t + beatDelta clientApp :: MVar Tempo -> MVar Double -> WS.ClientApp () -clientApp mTempo mBps conn = do +clientApp mTempo mCps conn = do --sink <- WS.getSink - liftIO $ forkIO $ sendBps conn mBps + liftIO $ forkIO $ sendCps conn mCps forever loop where loop = do @@ -70,18 +70,18 @@ liftIO $ tryTakeMVar mTempo liftIO $ putMVar mTempo tempo -sendBps :: WS.Connection -> MVar Double -> IO () -sendBps conn mBps = forever $ do - bps <- takeMVar mBps - WS.sendTextData conn (T.pack $ show bps) +sendCps :: WS.Connection -> MVar Double -> IO () +sendCps conn mCps = forever $ do + cps <- takeMVar mCps + WS.sendTextData conn (T.pack $ show cps) connectClient :: Bool -> String -> MVar Tempo -> MVar Double -> IO () -connectClient secondTry ip mTempo mBps = do +connectClient secondTry ip mTempo mCps = do let errMsg = "Failed to connect to tidal server. Try specifying a " ++ "different port (default is 9160) setting the " ++ "environment variable TIDAL_TEMPO_PORT" serverPort <- getServerPort - WS.runClient ip serverPort "/tempo" (clientApp mTempo mBps) `E.catch` + WS.runClient ip serverPort "/tempo" (clientApp mTempo mCps) `E.catch` \(_ :: E.SomeException) -> do case secondTry of True -> error errMsg @@ -91,35 +91,39 @@ Left (_ :: E.SomeException) -> error errMsg Right _ -> do threadDelay 500000 - connectClient True ip mTempo mBps + connectClient True ip mTempo mCps runClient :: IO ((MVar Tempo, MVar Double)) runClient = do clockip <- getClockIp mTempo <- newEmptyMVar - mBps <- newEmptyMVar - forkIO $ connectClient False clockip mTempo mBps - return (mTempo, mBps) + mCps <- newEmptyMVar + forkIO $ connectClient False clockip mTempo mCps + return (mTempo, mCps) -bpsUtils :: IO ((Double -> IO (), IO (Rational))) -bpsUtils = do (mTempo, mBps) <- runClient - let bpsSetter b = putMVar mBps b +cpsUtils :: IO ((Double -> IO (), IO (Rational))) +cpsUtils = do (mTempo, mCps) <- runClient + let cpsSetter b = putMVar mCps b currentTime = do tempo <- readMVar mTempo now <- beatNow tempo return $ toRational now - return (bpsSetter, currentTime) + return (cpsSetter, currentTime) -bpsSetter :: IO (Double -> IO ()) -bpsSetter = do (f, _) <- bpsUtils +-- Backwards compatibility +bpsUtils :: IO ((Double -> IO (), IO (Rational))) +bpsUtils = cpsUtils + +cpsSetter :: IO (Double -> IO ()) +cpsSetter = do (f, _) <- cpsUtils return f clocked :: (Tempo -> Int -> IO ()) -> IO () clocked callback = - do (mTempo, mBps) <- runClient + do (mTempo, mCps) <- runClient t <- readMVar mTempo now <- getCurrentTime let delta = realToFrac $ diffUTCTime now (at t) - beatDelta = bps t * delta + beatDelta = cps t * delta nowBeat = beat t + beatDelta nextBeat = ceiling nowBeat -- next4 = nextBeat + (4 - (nextBeat `mod` 4)) @@ -128,20 +132,20 @@ do t <- readMVar mTempo now <- getCurrentTime let delta = realToFrac $ diffUTCTime now (at t) - actualBeat = (beat t) + ((bps t) * delta) + actualBeat = (beat t) + ((cps t) * delta) beatDelta = (fromIntegral b) - actualBeat - delay = beatDelta / (bps t) + delay = beatDelta / (cps t) threadDelay $ floor (delay * 1000000) callback t b loop mTempo $ b + 1 clockedTick :: Int -> (Tempo -> Int -> IO ()) -> IO () clockedTick tpb callback = - do (mTempo, mBps) <- runClient + do (mTempo, mCps) <- runClient t <- readMVar mTempo now <- getCurrentTime let delta = realToFrac $ diffUTCTime now (at t) - beatDelta = bps t * delta + beatDelta = cps t * delta nowBeat = beat t + beatDelta nextTick = ceiling (nowBeat * (fromIntegral tpb)) -- next4 = nextBeat + (4 - (nextBeat `mod` 4)) @@ -149,7 +153,7 @@ where loop mTempo tick = do t <- readMVar mTempo now <- getCurrentTime - let tps = (fromIntegral tpb) * bps t + let tps = (fromIntegral tpb) * cps t delta = realToFrac $ diffUTCTime now (at t) actualTick = ((fromIntegral tpb) * beat t) + (tps * delta) tickDelta = (fromIntegral tick) - actualTick @@ -160,11 +164,11 @@ updateTempo :: MVar Tempo -> Maybe Double -> IO () updateTempo mt Nothing = return () -updateTempo mt (Just bps') = do t <- takeMVar mt +updateTempo mt (Just cps') = do t <- takeMVar mt now <- getCurrentTime let delta = realToFrac $ diffUTCTime now (at t) - beat' = (beat t) + ((bps t) * delta) - putMVar mt $ Tempo now beat' bps' + beat' = (beat t) + ((cps t) * delta) + putMVar mt $ Tempo now beat' cps' addClient :: WS.Connection -> ClientState -> ClientState addClient client clients = client : clients diff --git a/tidal.cabal b/tidal.cabal --- a/tidal.cabal +++ b/tidal.cabal @@ -1,8 +1,8 @@ name: tidal -version: 0.4.29 +version: 0.4.29.1 synopsis: Pattern language for improvised music -- description: -homepage: http://yaxu.org/tidal/ +homepage: http://tidal.lurk.org/ license: GPL-3 license-file: LICENSE author: Alex McLean diff --git a/tidal.el b/tidal.el --- a/tidal.el +++ b/tidal.el @@ -73,9 +73,10 @@ (tidal-send-string "d9 <- dirtStream") (tidal-send-string "d10 <- dirtStream") ; (tidal-send-string "k1 <- keyStream") +; (tidal-send-string "keyproxy 150000 \"24:0\"") (tidal-send-string "(cps, getNow) <- bpsUtils") (tidal-send-string "let bps x = cps (x/2)") - ; (tidal-send-string "let hush = mapM_ ($ silence) [d1,d2,d3,d4,d5,d6,d7,d8,d9,d10,k1]") +; (tidal-send-string "let hush = mapM_ ($ silence) [d1,d2,d3,d4,d5,d6,d7,d8,d9,d10,k1]") (tidal-send-string "let hush = mapM_ ($ silence) [d1,d2,d3,d4,d5,d6,d7,d8,d9,d10]") (tidal-send-string "let solo = (>>) hush") (tidal-send-string ":set prompt \"tidal> \"")