tidal 1.7 → 1.7.1
raw patch · 12 files changed
+122/−64 lines, 12 files
Files
- BootTidal.hs +1/−1
- CHANGELOG.md +12/−0
- README.md +1/−1
- src/Sound/Tidal/Config.hs +4/−4
- src/Sound/Tidal/Params.hs +1/−1
- src/Sound/Tidal/ParseBP.hs +27/−22
- src/Sound/Tidal/Stream.hs +45/−27
- src/Sound/Tidal/UI.hs +14/−5
- src/Sound/Tidal/Version.hs +11/−1
- test/Sound/Tidal/ParseTest.hs +4/−0
- tidal.cabal +1/−1
- tidal.el +1/−1
BootTidal.hs view
@@ -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 >>)
CHANGELOG.md view
@@ -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
README.md view
@@ -1,5 +1,5 @@ -Tidal [](https://travis-ci.org/tidalcycles/Tidal)+Tidal [](https://github.com/tidalcycles/Tidal/actions) ===== Language for live coding of pattern
src/Sound/Tidal/Config.hs view
@@ -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 }
src/Sound/Tidal/Params.hs view
@@ -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.
src/Sound/Tidal/ParseBP.hs view
@@ -23,7 +23,7 @@ along with this library. If not, see <http://www.gnu.org/licenses/>. -} -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 '!'
src/Sound/Tidal/Stream.hs view
@@ -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
src/Sound/Tidal/UI.hs view
@@ -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,
src/Sound/Tidal/Version.hs view
@@ -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+
test/Sound/Tidal/ParseTest.hs view
@@ -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)
tidal.cabal view
@@ -1,5 +1,5 @@ name: tidal-version: 1.7+version: 1.7.1 synopsis: Pattern language for improvised music -- description: homepage: http://tidalcycles.org/
tidal.el view
@@ -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" . "/") )) )