diff --git a/BootTidal.hs b/BootTidal.hs --- a/BootTidal.hs +++ b/BootTidal.hs @@ -12,7 +12,7 @@ hSetEncoding stdout utf8 -- total latency = oLatency + cFrameTimespan -tidal <- startTidal (superdirtTarget {oLatency = 0.1, oAddress = "127.0.0.1", oPort = 57120}) (defaultConfig {cFrameTimespan = 1/20}) +tidal <- startTidal (superdirtTarget {oLatency = 0.1, oAddress = "127.0.0.1", oPort = 57120}) (defaultConfig {cVerbose = True, cFrameTimespan = 1/20}) :{ let only = (hush >>) diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,17 @@ # TidalCycles log of changes +## 1.7.1 - IKLECTIK b + * Fix stack build @yaxu + * Add tidal_status command @yaxu + * Add cVerbose config setting (default on) @yaxu + * Fix for emacs plugin @jwaldmann + * Snowball bugfix @yaxu + * Migrate to github actions, tested against additional ghc versions @ndr_brt + * Fix mininotation bug - allow leading/trailing spaces @ndr_brt + * Make linger work with negative numbers (to linger on end of cycle rather than start) @yaxu + * Friendlier startup messages @yaxu + * Compatibility with ghc 9.0.1 @yaxu + ## 1.7 - IKLECTIK * Added drum aliases from GM2 percussion spec to `drum` function @lvm * `getcps` helper function now in BootTidal.hs @yaxu diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ -Tidal [![Build Status](https://travis-ci.org/tidalcycles/Tidal.svg?branch=main)](https://travis-ci.org/tidalcycles/Tidal) +Tidal [![Build Status](https://github.com/tidalcycles/Tidal/workflows/ci/badge.svg)](https://github.com/tidalcycles/Tidal/actions) ===== Language for live coding of pattern diff --git a/src/Sound/Tidal/Config.hs b/src/Sound/Tidal/Config.hs --- a/src/Sound/Tidal/Config.hs +++ b/src/Sound/Tidal/Config.hs @@ -25,8 +25,8 @@ cTempoAddr :: String, cTempoPort :: Int, cTempoClientPort :: Int, - cSendParts :: Bool, - cSkipTicks :: Int + cSkipTicks :: Int, + cVerbose :: Bool } defaultConfig :: Config @@ -37,6 +37,6 @@ cTempoAddr = "127.0.0.1", cTempoPort = 9160, cTempoClientPort = 0, -- choose at random - cSendParts = False, - cSkipTicks = 10 + cSkipTicks = 10, + cVerbose = True } diff --git a/src/Sound/Tidal/Params.hs b/src/Sound/Tidal/Params.hs --- a/src/Sound/Tidal/Params.hs +++ b/src/Sound/Tidal/Params.hs @@ -1,6 +1,6 @@ module Sound.Tidal.Params where --- **Please note**, this file is generated by bin/generate-params.hs +-- Please note, this file is generated by bin/generate-params.hs -- Submit any pull requests against that file and/or params-header.hs -- in the same folder, thanks. diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs --- a/src/Sound/Tidal/ParseBP.hs +++ b/src/Sound/Tidal/ParseBP.hs @@ -23,7 +23,7 @@ along with this library. If not, see . -} -import Control.Applicative ((<$>), (<*>), pure) +import Control.Applicative () import qualified Control.Exception as E import Data.Colour import Data.Colour.Names @@ -333,27 +333,32 @@ return TPat_Silence pSequence :: Parseable a => MyParser (TPat a) -> GenParser Char Int (TPat a) -pSequence f = do s <- many $ do a <- pPart f - spaces - do try $ symbol ".." - b <- pPart f - return $ TPat_EnumFromTo a b - <|> pElongate a - <|> pRepeat a - <|> return a - <|> do symbol "." - return TPat_Foot - pRand $ resolve_feet s - where resolve_feet ps | length ss > 1 = TPat_Seq $ map TPat_Seq ss - | otherwise = TPat_Seq ps - where ss = splitFeet ps - splitFeet :: [TPat t] -> [[TPat t]] - splitFeet [] = [] - splitFeet pats = foot : splitFeet pats' - where (foot, pats') = takeFoot pats - takeFoot [] = ([], []) - takeFoot (TPat_Foot:pats'') = ([], pats'') - takeFoot (pat:pats'') = (\(a,b) -> (pat:a,b)) $ takeFoot pats'' +pSequence f = do + spaces + s <- many $ do + a <- pPart f + spaces + do + symbol ".." + b <- pPart f + return $ TPat_EnumFromTo a b + <|> pElongate a + <|> pRepeat a + <|> return a + <|> do + symbol "." + return TPat_Foot + pRand $ resolve_feet s + where resolve_feet ps | length ss > 1 = TPat_Seq $ map TPat_Seq ss + | otherwise = TPat_Seq ps + where ss = splitFeet ps + splitFeet :: [TPat t] -> [[TPat t]] + splitFeet [] = [] + splitFeet pats = foot : splitFeet pats' + where (foot, pats') = takeFoot pats + takeFoot [] = ([], []) + takeFoot (TPat_Foot:pats'') = ([], pats'') + takeFoot (pat:pats'') = (\(a,b) -> (pat:a,b)) $ takeFoot pats'' pRepeat :: TPat a -> MyParser (TPat a) pRepeat a = do es <- many1 $ do char '!' diff --git a/src/Sound/Tidal/Stream.hs b/src/Sound/Tidal/Stream.hs --- a/src/Sound/Tidal/Stream.hs +++ b/src/Sound/Tidal/Stream.hs @@ -45,6 +45,8 @@ import Sound.Tidal.Show () import Data.Word (Word8) +import Sound.Tidal.Version + data Stream = Stream {sConfig :: Config, sBusses :: MVar [Int], sInput :: MVar StateMap, @@ -191,22 +193,17 @@ bussesMV <- newMVar [] globalFMV <- newMVar id tempoMV <- newEmptyMVar + + tidal_status_string >>= verbose config + verbose config $ "Listening for external controls on " ++ cCtrlAddr config ++ ":" ++ show (cCtrlPort config) listen <- openListener config + cxs <- mapM (\(target, os) -> do remote_addr <- resolve (oAddress target) (show $ oPort target) remote_bus_addr <- if isJust $ oBusPort target then Just <$> resolve (oAddress target) (show $ fromJust $ oBusPort target) else return Nothing u <- O.openUDP (oAddress target) (oPort target) - let cx = Cx {cxUDP = u, cxAddr = remote_addr, cxBusAddr = remote_bus_addr, cxTarget = target, cxOSCs = os} - when (oHandshake target) $ - if (isJust listen) - then - do -- send it _from_ the udp socket we're listening to, so the - -- replies go back there - sendO False listen cx $ O.Message "/dirt/handshake" [] - else - hPutStrLn stderr "Can't handshake with SuperCollider without control port." - return cx + return $ Cx {cxUDP = u, cxAddr = remote_addr, cxBusAddr = remote_bus_addr, cxTarget = target, cxOSCs = os} ) oscmap let stream = Stream {sConfig = config, sBusses = bussesMV, @@ -217,10 +214,22 @@ sGlobalFMV = globalFMV, sCxs = cxs } + sendHandshakes stream _ <- T.clocked config tempoMV $ onTick stream - _ <- forkIO $ ctrlResponder stream + _ <- forkIO $ ctrlResponder config stream return stream +-- It only really works to handshake with one target at the moment.. +sendHandshakes :: Stream -> IO () +sendHandshakes stream = mapM_ sendHandshake $ filter (oHandshake . cxTarget) (sCxs stream) + where sendHandshake cx = if (isJust $ sListen stream) + then + do -- send it _from_ the udp socket we're listening to, so the + -- replies go back there + sendO False (sListen stream) cx $ O.Message "/dirt/handshake" [] + else + hPutStrLn stderr "Can't handshake with SuperCollider without control port." + sendO :: Bool -> (Maybe O.UDP) -> Cx -> O.Message -> IO () sendO isBusMsg (Just listen) cx msg = O.sendTo listen (O.Packet_Message msg) (N.addrAddress addr) where addr | isBusMsg && isJust (cxBusAddr cx) = fromJust $ cxBusAddr cx @@ -437,8 +446,6 @@ --filterOns = filter eventHasOnset extraLatency | fake = 0 | otherwise = cFrameTimespan config + T.nudged tempo - --filterOns | cSendParts config = id - -- | otherwise = filter eventHasOnset es = sortOn (start . part) $ query pat (State {arc = T.nowArc st, controls = sMap' } @@ -595,13 +602,9 @@ openListener :: Config -> IO (Maybe O.UDP) openListener c - | cCtrlListen c = do hPutStrLn stderr $ "Listening for controls on " ++ cCtrlAddr c ++ ":" ++ show (cCtrlPort c) - catchAny run (\_ -> if (cCtrlPort c) == 0 - then error "Failed to listen to any port." - else do hPutStrLn stderr "Failed to open that port. Trying another." - u <- openListener (c {cCtrlPort = 0}) - return u - ) + | cCtrlListen c = catchAny run (\_ -> do verbose c "That port isn't available, perhaps another Tidal instance is already listening on that port?" + return Nothing + ) | otherwise = return Nothing where run = do sock <- O.udpServer (cCtrlAddr c) (cCtrlPort c) @@ -609,13 +612,21 @@ catchAny :: IO a -> (E.SomeException -> IO a) -> IO a catchAny = E.catch -ctrlResponder :: Stream -> IO () -ctrlResponder (stream@(Stream {sListen = Just sock})) = do ms <- O.recvMessages sock - mapM_ act ms - ctrlResponder stream +ctrlResponder :: Config -> Stream -> IO () +ctrlResponder c (stream@(Stream {sListen = Just sock})) = do ms <- recvMessagesTimeout 2 sock + if (null ms) + then checkHandshake -- there was a timeout, check handshake + else mapM_ act ms + ctrlResponder c stream where - act (O.Message "/dirt/hello" _) = return () - act (O.Message "/dirt/handshake/reply" xs) = do _ <- swapMVar (sBusses stream) $ bufferIndices xs + checkHandshake = do busses <- readMVar (sBusses stream) + when (null busses) $ do verbose c $ "Waiting for SuperDirt.." + sendHandshakes stream + + act (O.Message "/dirt/hello" _) = sendHandshakes stream + act (O.Message "/dirt/handshake/reply" xs) = do prev <- swapMVar (sBusses stream) $ bufferIndices xs + -- Only report the first time.. + when (null prev) $ verbose c $ "Connected to SuperDirt." return () where bufferIndices [] = [] @@ -634,4 +645,11 @@ add k v = do sMap <- takeMVar (sInput stream) putMVar (sInput stream) $ Map.insert k (pure v) sMap return () -ctrlResponder _ = return () +ctrlResponder _ _ = return () + + +verbose :: Config -> String -> IO () +verbose c s = when (cVerbose c) $ putStrLn s + +recvMessagesTimeout :: (O.Transport t) => Double -> t -> IO [O.Message] +recvMessagesTimeout n sock = fmap (maybe [] O.packetMessages) $ O.recvPacketTimeout n sock diff --git a/src/Sound/Tidal/UI.hs b/src/Sound/Tidal/UI.hs --- a/src/Sound/Tidal/UI.hs +++ b/src/Sound/Tidal/UI.hs @@ -585,7 +585,7 @@ whenmod a b f pat = innerJoin $ (\a' b' -> _whenmod a' b' f pat) <$> a <*> b _whenmod :: Time -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a -_whenmod a b = Sound.Tidal.Core.whenT (\t -> ((t `mod'` a) >= b )) +_whenmod a b = whenT (\t -> ((t `mod'` a) >= b )) {- | @@ -618,17 +618,26 @@ _trunc :: Time -> Pattern a -> Pattern a _trunc t = compress (0, t) . zoomArc (Arc 0 t) -{- | @linger@ is similar to `trunc` but the truncated part of the pattern loops until the end of the cycle +{- | @linger@ is similar to `trunc` but the truncated part of the pattern loops until the end of the cycle. @ d1 $ linger 0.25 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2" @ + +If you give it a negative number, it will linger on the last part of +the pattern, instead of the start of it. E.g. to linger on the last +quarter: + +@ +d1 $ linger (-0.25) $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2" +@ -} linger :: Pattern Time -> Pattern a -> Pattern a linger = tParam _linger _linger :: Time -> Pattern a -> Pattern a -_linger n p = _fast (1/n) $ zoomArc (Arc 0 n) p +_linger n p | n < 0 = _fast (1/n) $ zoomArc (Arc (1 + n) 1) p + | otherwise = _fast (1/n) $ zoomArc (Arc 0 n) p {- | Use `within` to apply a function to only a part of a pattern. For example, to @@ -1002,7 +1011,7 @@ fit :: Pattern Int -> [a] -> Pattern Int -> Pattern a fit pint xs p = (tParam func) pint (xs,p) - where func = \i @_(xs',p') -> _fit i xs' p' + where func i (xs',p') = _fit i xs' p' permstep :: RealFrac b => Int -> [a] -> Pattern b -> Pattern a permstep nSteps things p = unwrap $ (\n -> fastFromList $ concatMap (\x -> replicate (fst x) (snd x)) $ zip (ps !! floor (n * fromIntegral (length ps - 1))) things) <$> _segment 1 p @@ -1865,7 +1874,7 @@ d1 $ note (scale "hexDorian" $ snowball (+) (slow 2 . rev) 8 "0 ~ . -1 . 5 3 4 . ~ -2") # s "gtr" -} snowball :: Int -> (Pattern a -> Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a -snowball depth combinationFunction f pattern = cat $ take depth $ scanl combinationFunction pattern $ iterate f pattern +snowball depth combinationFunction f pattern = cat $ take depth $ scanl combinationFunction pattern $ drop 1 $ iterate f pattern {- @soak@ | applies a function to a pattern and cats the resulting pattern, diff --git a/src/Sound/Tidal/Version.hs b/src/Sound/Tidal/Version.hs --- a/src/Sound/Tidal/Version.hs +++ b/src/Sound/Tidal/Version.hs @@ -1,5 +1,7 @@ module Sound.Tidal.Version where +import Paths_tidal + {- Version.hs - For giving the current tidal version. Copyright (C) 2020, Alex McLean and contributors @@ -19,4 +21,12 @@ -} tidal_version :: String -tidal_version = "1.7" +tidal_version = "1.7.1" + +tidal_status :: IO () +tidal_status = tidal_status_string >>= putStrLn + +tidal_status_string :: IO String +tidal_status_string = do datadir <- getDataDir + return $ "[TidalCycles version " ++ tidal_version ++ "]\nInstalled in " ++ datadir + diff --git a/test/Sound/Tidal/ParseTest.hs b/test/Sound/Tidal/ParseTest.hs --- a/test/Sound/Tidal/ParseTest.hs +++ b/test/Sound/Tidal/ParseTest.hs @@ -119,6 +119,10 @@ compareP (Arc 0 2) ("c'major e'minor f'dim7" :: Pattern Int) ("c e f" + "'major 'minor 'dim7") + it "handle trailing and leading whitespaces" $ do + compareP (Arc 0 1) + (" bd " :: Pattern String) + ("bd" :: Pattern String) it "doesn't crash on zeroes (1)" $ do compareP (Arc 0 2) ("cp/0" :: Pattern String) diff --git a/tidal.cabal b/tidal.cabal --- a/tidal.cabal +++ b/tidal.cabal @@ -1,5 +1,5 @@ name: tidal -version: 1.7 +version: 1.7.1 synopsis: Pattern language for improvised music -- description: homepage: http://tidalcycles.org/ diff --git a/tidal.el b/tidal.el --- a/tidal.el +++ b/tidal.el @@ -66,7 +66,7 @@ ("separator" . "\\") )) ((or (string-equal system-type "darwin") (string-equal system-type "gnu/linux")) - '(("path" . "echo -n data-dir: && ghc -e 'import Paths_tidal' -e 'getDataDir>>=putStr'") + '(("path" . "echo -n data-dir: && ghc -e 'import Paths_tidal' -e 'getDataDir>>=putStr' 2>/dev/null") ("separator" . "/") )) )