diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ Tidal [![Build Status](https://github.com/tidalcycles/Tidal/workflows/ci/badge.svg)](https://github.com/tidalcycles/Tidal/actions) ===== -Language for live coding of pattern +Language for live coding algorithmic patterns For documentation, mailing list and more info see here: https://tidalcycles.org/ @@ -10,7 +10,7 @@ You can help speed up Tidal development by contributing to the collective fund here: https://opencollective.com/tidalcycles -(c) Alex McLean and contributors, 2021 +(c) Alex McLean and contributors, 2022 Distributed under the terms of the GNU Public license version 3 (or later). 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 @@ -21,6 +21,7 @@ data Config = Config {cCtrlListen :: Bool, cCtrlAddr :: String, cCtrlPort :: Int, + cCtrlBroadcast :: Bool, cFrameTimespan :: Double, cTempoAddr :: String, cTempoPort :: Int, @@ -33,6 +34,7 @@ defaultConfig = Config {cCtrlListen = True, cCtrlAddr ="127.0.0.1", cCtrlPort = 6010, + cCtrlBroadcast = False, cFrameTimespan = 1/20, cTempoAddr = "127.0.0.1", cTempoPort = 9160, diff --git a/src/Sound/Tidal/Control.hs b/src/Sound/Tidal/Control.hs --- a/src/Sound/Tidal/Control.hs +++ b/src/Sound/Tidal/Control.hs @@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleInstances, OverloadedStrings, FlexibleContexts, BangPatterns #-} module Sound.Tidal.Control where - {- Control.hs - Functions which concern control patterns, which are patterns of hashmaps, used for synth control values. @@ -174,7 +173,7 @@ striateBy :: Pattern Int -> Pattern Double -> ControlPattern -> ControlPattern striateBy = tParam2 _striateBy --- Old name for striateBy, here as a deprecated alias for now. +-- | DEPRECATED, use 'striateBy' instead. striate' :: Pattern Int -> Pattern Double -> ControlPattern -> ControlPattern striate' = striateBy @@ -184,7 +183,6 @@ slot = (1 - f) / fromIntegral n - {- | `gap` is similar to `chop` in that it granualizes every sample in place as it is played, but every other grain is silent. Use an integer value to specify how many granules each sample is chopped into: @@ -346,23 +344,45 @@ smash' n xs p = slowcat $ map (`slow` p') xs where p' = _chop n p +{- | + Applies a type of delay to a pattern. + It has three parameters, which could be called depth, time and feedback. -{- | Stut applies a type of delay to a pattern. It has three parameters, -which could be called depth, feedback and time. Depth is an integer -and the others floating point. This adds a bit of echo: + This adds a bit of echo: + @ + d1 $ echo 4 0.5 0.2 $ sound "bd sn" + @ -@ -d1 $ stut 4 0.5 0.2 $ sound "bd sn" -@ + The above results in 4 echos, each one 50% quieter than the last, with 1/5th of a cycle between them. -The above results in 4 echos, each one 50% quieter than the last, -with 1/5th of a cycle between them. It is possible to reverse the echo: + It is possible to reverse the echo: + @ + d1 $ echo 4 0.5 (-0.2) $ sound "bd sn" + @ +-} +echo :: Pattern Integer -> Pattern Rational -> Pattern Double -> ControlPattern -> ControlPattern +echo = tParam3 _echo -@ -d1 $ stut 4 0.5 (-0.2) $ sound "bd sn" -@ +_echo :: Integer -> Rational -> Double -> ControlPattern -> ControlPattern +_echo count time feedback p = stack (p:map (\x -> ((x%1)*time) `rotR` (p |* P.gain (pure $ (* feedback) (fromIntegral x)))) [1..(count-1)]) + +{- | + Allows to apply a function for each step and overlays the result delayed by the given time. + + @ + d1 $ echoWith 2 "1%3" (# vowel "{a e i o u}%2") $ sound "bd sn" + @ + + In this case there are two _overlays_ delayed by 1/3 of a cycle, where each has the @vowel@ filter applied. -} +echoWith :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a +echoWith n t f p = innerJoin $ (\a b -> _echoWith a b f p) <$> n <* t +_echoWith :: (Num n, Ord n) => n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a +_echoWith count time f p | count <= 1 = p + | otherwise = overlay (f (time `rotR` _echoWith (count-1) time f p)) p + +-- | DEPRECATED, use 'echo' instead stut :: Pattern Integer -> Pattern Double -> Pattern Rational -> ControlPattern -> ControlPattern stut = tParam3 _stut @@ -371,14 +391,7 @@ where scalegain = (+feedback) . (*(1-feedback)) . (/ fromIntegral count) . (fromIntegral count -) -{- | Instead of just decreasing volume to produce echoes, @stut'@ allows to apply a function for each step and overlays the result delayed by the given time. - -@ -d1 $ stut' 2 (1%3) (# vowel "{a e i o u}%2") $ sound "bd sn" -@ - -In this case there are two _overlays_ delayed by 1/3 of a cycle, where each has the @vowel@ filter applied. --} +-- | DEPRECATED, use 'echoWith' instead stutWith :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a stutWith n t f p = innerJoin $ (\a b -> _stutWith a b f p) <$> n <* t @@ -386,7 +399,7 @@ _stutWith count steptime f p | count <= 1 = p | otherwise = overlay (f (steptime `rotR` _stutWith (count-1) steptime f p)) p --- | The old name for stutWith +-- | DEPRECATED, use 'echoWith' instead stut' :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a stut' = stutWith 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 @@ -324,9 +324,7 @@ <|> return Positive intOrFloat :: MyParser Double -intOrFloat = do -- use 'try' to avoid consuming the first '.' in a '..' range. - try float - <|> fromIntegral <$> integer +intOrFloat = try pFloat <|> pInteger pSequence :: Parseable a => MyParser (TPat a) -> MyParser (TPat a) pSequence f = do @@ -560,7 +558,7 @@ pRational = wrapPos $ TPat_Atom Nothing <$> pRatio pRatio :: MyParser Rational -pRatio = do +pRatio = do s <- sign r <- do n <- try intOrFloat v <- pFraction n <|> return (toRational n) @@ -570,12 +568,25 @@ pRatioChar return $ applySign s r +pInteger :: MyParser Double +pInteger = read <$> many1 digit + +pFloat :: MyParser Double +pFloat = do + i <- many1 digit + d <- option "0" (char '.' >> many1 digit) + e <- option "0" (char 'e' >> do + s <- option "" (char '-' >> return "-") + e' <- many1 digit + return $ s++e') + return $ read (i++"."++d++"e"++e) + pFraction :: RealFrac a => a -> MyParser Rational pFraction n = do char '%' - d <- integer + d <- pInteger if (isInt n) - then return ((round n) % d) + then return ((round n) % (round d)) else fail "fractions need int numerator and denominator" pRatioChar :: Fractional a => MyParser a diff --git a/src/Sound/Tidal/Pattern.hs b/src/Sound/Tidal/Pattern.hs --- a/src/Sound/Tidal/Pattern.hs +++ b/src/Sound/Tidal/Pattern.hs @@ -129,7 +129,7 @@ -- * Monad and friends -- Note there are four ways of joining - the default 'unwrap' used by @>>=@, as well --- as innerJoin, outerJoin and squeezeJoin. +-- as innerJoin, innerJoin and squeezeJoin. instance Monad Pattern where return = pure @@ -692,6 +692,8 @@ toValue a = VI a instance Valuable Bool where toValue a = VB a +instance Valuable Note where + toValue a = VN a instance Valuable [Word8] where toValue a = VX a instance Valuable [Value] where diff --git a/src/Sound/Tidal/Show.hs b/src/Sound/Tidal/Show.hs --- a/src/Sound/Tidal/Show.hs +++ b/src/Sound/Tidal/Show.hs @@ -69,8 +69,12 @@ -- Show everything, including event context showAll :: Show a => Arc -> Pattern a -> String -showAll a p = intercalate "\n" $ map show $ sortOn part $ queryArc p a +showAll a p = intercalate "\n" $ map showEventAll $ sortOn part $ queryArc p a +-- Show context of an event +showEventAll :: Show a => Event a -> String +showEventAll e = show (context e) ++ uncurry (++) (showEvent e) + instance Show Context where show (Context cs) = show cs @@ -93,7 +97,7 @@ show (Arc s e) = prettyRat s ++ ">" ++ prettyRat e instance {-# OVERLAPPING #-} Show a => Show (Event a) where - show e = show (context e) ++ uncurry (++) (showEvent e) + show e = uncurry (++) (showEvent e) prettyRat :: Rational -> String prettyRat r | unit == 0 && frac > 0 = showFrac (numerator frac) (denominator frac) 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 @@ -202,7 +202,10 @@ 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 broadcast = if cCtrlBroadcast config then 1 else 0 + u <- O.udp_socket (\sock sockaddr -> do N.setSocketOption sock N.Broadcast broadcast + N.connect sock sockaddr + ) (oAddress target) (oPort target) return $ Cx {cxUDP = u, cxAddr = remote_addr, cxBusAddr = remote_bus_addr, cxTarget = target, cxOSCs = os} ) oscmap let stream = Stream {sConfig = config, @@ -630,6 +633,7 @@ | otherwise = return Nothing where run = do sock <- O.udpServer (cCtrlAddr c) (cCtrlPort c) + when (cCtrlBroadcast c) $ N.setSocketOption (O.udpSocket sock) N.Broadcast 1 return $ Just sock catchAny :: IO a -> (E.SomeException -> IO a) -> IO a catchAny = E.catch 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 @@ -25,8 +25,9 @@ import Data.Char (digitToInt, isDigit, ord) import Data.Bits (testBit, Bits, xor, shiftL, shiftR) + +import Data.Ratio ((%), Ratio) import Data.Fixed (mod') -import Data.Ratio ((%)) import Data.List (sort, sortOn, findIndices, elemIndex, groupBy, transpose, intercalate, findIndex) import Data.Maybe (isJust, fromJust, fromMaybe, mapMaybe) import qualified Data.Text as T @@ -1449,7 +1450,41 @@ thumbup xs = concatMap (\x -> [thumb,x]) $ tail xs where thumb = head xs +{- | `rolled` plays each note of a chord quickly in order, as opposed to simultaneously; to give a chord a harp-like effect. +This will played from the lowest note to the highest note of the chord +@ +rolled $ n "c'maj'4" # s "superpiano" +@ + +And you can use `rolledBy` or `rolledBy'` to specify the length of the roll. The value in the passed pattern +is the divisor of the cycle length. A negative value will play the arpeggio in reverse order. + +@ +rolledBy "<1 -0.5 0.25 -0.125>" $ note "c'maj9" # s "superpiano" +@ +-} + +rolledWith :: Ratio Integer -> Pattern a -> Pattern a +rolledWith t = withEvents aux + where aux es = concatMap (steppityIn) (groupBy (\a b -> whole a == whole b) $ ((isRev t) es)) + isRev b = (\x -> if x > 0 then id else reverse ) b + steppityIn xs = mapMaybe (\(n, ev) -> (timeguard n xs ev t)) $ enumerate xs + timeguard _ _ ev 0 = return ev + timeguard n xs ev _ = (shiftIt n (length xs) ev) + shiftIt n d (Event c (Just (Arc s e)) a' v) = do + a'' <- subArc (Arc newS e) a' + return (Event c (Just $ Arc newS e) a'' v) + where newS = s + (dur * fromIntegral n) + dur = ((e - s)) / ((1/ (abs t))*fromIntegral d) + shiftIt _ _ ev = return ev + +rolledBy :: Pattern (Ratio Integer) -> Pattern a -> Pattern a +rolledBy pt = tParam rolledWith (segment 1 $ pt) + +rolled :: Pattern a -> Pattern a +rolled = rolledBy (1/4) + {- TODO ! -- | @fill@ 'fills in' gaps in one pattern with events from another. For example @fill "bd" "cp ~ cp"@ would result in the equivalent of `"~ bd ~"`. This only finds gaps in a resulting pattern, in other words @"[bd ~, sn]"@ doesn't contain any gaps (because @sn@ covers it all), and @"bd ~ ~ sn"@ only contains a single gap that bridges two steps. @@ -1521,12 +1556,6 @@ stutter :: Integral i => i -> Time -> Pattern a -> Pattern a stutter n t p = stack $ map (\i -> (t * fromIntegral i) `rotR` p) [0 .. (n-1)] - -echo, triple, quad, double :: Time -> Pattern a -> Pattern a -echo = stutter (2 :: Int) -triple = stutter (3 :: Int) -quad = stutter (4 :: Int) -double = echo {- | The `jux` function creates strange stereo effects, by applying a function to a pattern, but only in the right-hand channel. For 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 @@ -21,7 +21,7 @@ -} tidal_version :: String -tidal_version = "1.7.10" +tidal_version = "1.8.0" tidal_status :: IO () tidal_status = tidal_status_string >>= putStrLn diff --git a/test/Sound/Tidal/ControlTest.hs b/test/Sound/Tidal/ControlTest.hs --- a/test/Sound/Tidal/ControlTest.hs +++ b/test/Sound/Tidal/ControlTest.hs @@ -15,6 +15,19 @@ run :: Microspec () run = describe "Sound.Tidal.Control" $ do + + describe "echo" $ do + it "should echo the event by the specified time and multiply the gain factor" $ do + compareP (Arc 0 1) + (echo 2 0.25 0.5 $ s "bd" # gain "1") + (stack [rotR 0 "bd" # gain 1, rotR 0.25 "bd" # gain 0.5]) + + describe "echoWith" $ do + it "should echo the event by the specified time and apply the specified function" $ do + compareP (Arc 0 1) + (echoWith 2 0.25 (|* speed 2) $ s "bd" # speed "1") + (stack [rotR 0 "bd" # speed 1, rotR 0.25 "bd" # speed 2]) + describe "stutWith" $ do it "can mimic stut" $ do comparePD (Arc 0 1) 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 @@ -207,4 +207,12 @@ it "can't parse a floating point number as int" $ do evaluate ("1.5" :: Pattern Int) `shouldThrow` anyException + it "can correctly parse multiplied boolean patterns 1" $ do + compareP (Arc 0 1) + ("t*2 t*3" :: Pattern Bool) + ("1*2 1*3" :: Pattern Bool) + it "can correctly parse multiplied boolean patterns 2" $ do + compareP (Arc 0 1) + ("t*2t t" :: Pattern Bool) + ("1*2%3 1" :: Pattern Bool) where degradeByDefault = _degradeBy 0.5 diff --git a/test/Sound/Tidal/UITest.hs b/test/Sound/Tidal/UITest.hs --- a/test/Sound/Tidal/UITest.hs +++ b/test/Sound/Tidal/UITest.hs @@ -53,6 +53,44 @@ ("0*4" :: Pattern Double) -} + describe "rolledBy" $ do + it "shifts each start of events in a list correctly" $ do + let + overTimeSpan = (Arc 0 1) + testMe = rolledBy "0.5" $ n ("[0,1,2,3]") + expectedResult = n "[0, ~ 1@7, ~@2 2@6, ~@3 3@5]" + in + compareP overTimeSpan testMe expectedResult + it "shifts each start of events in a list correctly in reverse order" $ do + let + overTimeSpan = (Arc 0 1) + testMe = rolledBy "-0.5" $ n ("[0,1,2,3]") + expectedResult = n "[3, ~ 2@7, ~@2 1@6, ~@3 0@5]" + in + compareP overTimeSpan testMe expectedResult + it "trims the result pattern if it becomes larger than the original pattern" $ do + let + overTimeSpan = (Arc 0 1) + testMe = rolledBy "1.5" $ n ("[0,1,2]") + expectedResult = n "[0, ~ 1]" + in + compareP overTimeSpan testMe expectedResult + it "does nothing for continous functions" $ do + let + overTimeSpan = (Arc 0 1) + testMe = n (rolledBy "0.25" (irand 0) |+ "[0,12]") + expectedResult = n (irand 0) |+ n "[0, 12]" + in + compareP overTimeSpan testMe expectedResult + it "does nothing when passing zero as time value" $ do + let + overTimeSpan = (Arc 0 1) + testMe = n (rolledBy "0" "[0,1,2,3]") + expectedResult = n "[0,1,2,3]" + in + compareP overTimeSpan testMe expectedResult + + describe "sometimesBy" $ do it "does nothing when set at 0% probability" $ do let @@ -98,7 +136,7 @@ (queryArc (irand 10) (Arc 0.25 0.25)) `shouldBe` [Event (Context []) Nothing (Arc 0.25 0.25) (6 :: Int)] it "is patternable" $ (queryArc (irand "10 2") (Arc 0 1)) `shouldBe` [ - Event (Context [((1,1),(4,1))]) Nothing (Arc 0 0.5) (6 :: Int), Event (Context [((4,1),(5,1))]) Nothing (Arc 0.5 1) (0 :: Int) + Event (Context [((1,1),(3,1))]) Nothing (Arc 0 0.5) (6 :: Int), Event (Context [((4,1),(5,1))]) Nothing (Arc 0.5 1) (0 :: Int) ] describe "range" $ do diff --git a/tidal.cabal b/tidal.cabal --- a/tidal.cabal +++ b/tidal.cabal @@ -1,5 +1,7 @@ +cabal-version: 2.0 + name: tidal -version: 1.7.10 +version: 1.8.0 synopsis: Pattern language for improvised music description: Tidal is a domain specific language for live coding patterns. homepage: http://tidalcycles.org/ @@ -11,7 +13,6 @@ Copyright: (c) Alex McLean and other contributors, 2021 category: Sound build-type: Simple -cabal-version: >=1.10 tested-with: GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1, GHC == 9.0.1 data-files: BootTidal.hs