tidal 1.4.4 → 1.4.5
raw patch · 13 files changed
+282/−214 lines, 13 files
Files
- BootTidal.hs +2/−1
- CHANGELOG.md +23/−0
- src/Sound/Tidal/Config.hs +4/−2
- src/Sound/Tidal/Control.hs +8/−0
- src/Sound/Tidal/Core.hs +10/−6
- src/Sound/Tidal/ParseBP.hs +170/−172
- src/Sound/Tidal/Stream.hs +0/−1
- src/Sound/Tidal/Tempo.hs +36/−27
- src/Sound/Tidal/UI.hs +19/−3
- src/Sound/Tidal/Utils.hs +4/−0
- src/Sound/Tidal/Version.hs +1/−1
- test/Sound/Tidal/ParseTest.hs +4/−0
- tidal.cabal +1/−1
BootTidal.hs view
@@ -16,6 +16,7 @@ solo = streamSolo tidal unsolo = streamUnsolo tidal once = streamOnce tidal+ first = streamFirst tidal asap = once nudgeAll = streamNudgeAll tidal all = streamAll tidal@@ -60,7 +61,7 @@ let setI = streamSetI tidal setF = streamSetF tidal setS = streamSetS tidal- setR = streamSetI tidal+ setR = streamSetR tidal setB = streamSetB tidal :}
CHANGELOG.md view
@@ -1,5 +1,28 @@ # TidalCycles log of changes +## 1.4.5 - Porter Brook++* Mini notation - `@` (and its alias `_`) now accepts rational relative durations. E.g. `a b@0.5 c d` to make `b` have a half step (that would be the same as `a@2 b c@2 c@d`). This can also be patterned `a b@<0.5 2> c d` @yaxu #435+* Experimental `reset` function - stick in a pattern so it acts as though the cycle number was reset to 0, from the next cycle @yaxu+* Bugfix for setR in BootTidal.hs @yaxu+* Mini notation - `!`, `@` and `_` now work properly within `{}` and `<>`, e.g. `<a b ! c!3 d>` will repeat every 7 cycles @yaxu #369 #248+* Mini notation - `@` and `_` are now aliases for each other, e.g. `a_3` is the same as `a@3` as are `_` and `@` @yaxu #369+* Frame skipping on clock jumps now configurable @yaxu #567+* Sync between tidal instances now works straight away, without having to setcps @yaxu #569+* New `while` function for applying a function selectively according to a binary pattern @yaxu+* Lowercases aliases `slowappend` and `fastappend` for `slowAppend` and `fastAppend` respectively @yaxu+* Many tidal-parse updates @dktr0++## 1.4.4 - Chee Dale++* wrandcat (weighted randcat) @yaxu+* MIDI Sysex support #558 @yaxu+* Elements in an Open Sound Control path address can now be patterned #557+* 'once' now chooses a random cycle to play. To get the old behaviour of playing the first cycle, use 'first' @yaxu #476+* Make random choices in mini-notation behave independently @yaxu #560+* Add [a|b|c] syntax to mini notation for randomly choosing between subsequences @yaxu #555+* Add power pattern operators |**, **| and |**| @yaxu+ ## 1.4.3 - Stanage Edge * Fix for xfade / xfadein transition
src/Sound/Tidal/Config.hs view
@@ -8,7 +8,8 @@ cTempoAddr :: String, cTempoPort :: Int, cTempoClientPort :: Int,- cSendParts :: Bool+ cSendParts :: Bool,+ cSkipTicks :: Int } defaultConfig :: Config@@ -19,5 +20,6 @@ cTempoAddr = "127.0.0.1", cTempoPort = 9160, cTempoClientPort = 0, -- choose at random- cSendParts = False+ cSendParts = False,+ cSkipTicks = 10 }
src/Sound/Tidal/Control.hs view
@@ -387,6 +387,14 @@ qt :: Show a => a -> Pattern b -> Pattern b qt = qtrigger +reset :: Show a => a -> Pattern b -> Pattern b+reset k pat = pat {query = q}+ where q st = query ((offset st) ~> (when (<=0) (const silence) pat)) st+ f = (fromIntegral :: Int -> Rational) . floor+ offset st = fromMaybe (pure 0) $ do p <- Map.lookup ctrl (controls st)+ return $ ((f . fromMaybe 0 . getR) <$> p)+ ctrl = "_t_" ++ show k+ _getP_ :: (Value -> Maybe a) -> Pattern Value -> Pattern a _getP_ f pat = filterJust $ f <$> pat
src/Sound/Tidal/Core.hs view
@@ -124,12 +124,12 @@ ( %|) :: Real a => Pattern a -> Pattern a -> Pattern a a %| b = mod' <$> a *> b -(|**|) :: (Applicative a, Real b) => a b -> a b -> a b-a |**| b = mod' <$> a <*> b-(|** ) :: Real a => Pattern a -> Pattern a -> Pattern a-a |** b = mod' <$> a <* b-( **|) :: Real a => Pattern a -> Pattern a -> Pattern a-a **| b = mod' <$> a *> b+(|**|) :: (Applicative a, Floating b) => a b -> a b -> a b+a |**| b = (**) <$> a <*> b+(|** ) :: Floating a => Pattern a -> Pattern a -> Pattern a+a |** b = (**) <$> a <* b+( **|) :: Floating a => Pattern a -> Pattern a -> Pattern a+a **| b = (**) <$> a *> b (|>|) :: (Applicative a, Unionable b) => a b -> a b -> a b a |>| b = flip union <$> a <*> b@@ -215,10 +215,14 @@ -- | Alias for 'append' slowAppend :: Pattern a -> Pattern a -> Pattern a slowAppend = append+slowappend :: Pattern a -> Pattern a -> Pattern a+slowappend = append -- | Like 'append', but twice as fast fastAppend :: Pattern a -> Pattern a -> Pattern a fastAppend a b = _fast 2 $ append a b+fastappend :: Pattern a -> Pattern a -> Pattern a+fastappend = fastAppend -- | The same as 'cat', but speeds up the result by the number of -- patterns there are, so the cycles from each are squashed to fit a
src/Sound/Tidal/ParseBP.hs view
@@ -17,7 +17,7 @@ import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Language ( haskellDef ) import qualified Text.ParserCombinators.Parsec.Token as P-+import qualified Text.Parsec.Prim import Sound.Tidal.Pattern import Sound.Tidal.UI import Sound.Tidal.Core@@ -36,54 +36,97 @@ message = showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" $ errorMessages perr perr = parsecError err -+type MyParser = Text.Parsec.Prim.Parsec String Int+ -- | AST representation of patterns data TPat a = TPat_Atom a- | TPat_Density (TPat Time) (TPat a)+ | TPat_Fast (TPat Time) (TPat a) | TPat_Slow (TPat Time) (TPat a)- | TPat_Zoom Arc (TPat a)- | TPat_DegradeBy Double (TPat a)+ | TPat_DegradeBy Int Double (TPat a)+ | TPat_CycleChoose Int [TPat a]+ | TPat_Euclid (TPat Int) (TPat Int) (TPat Int) (TPat a)+ | TPat_Stack [TPat a]+ | TPat_Polyrhythm (Maybe (TPat Rational)) [TPat a]+ | TPat_Seq [TPat a] | TPat_Silence | TPat_Foot- | TPat_Elongate Int+ | TPat_Elongate Rational (TPat a)+ | TPat_Repeat Int (TPat a) | TPat_EnumFromTo (TPat a) (TPat a)- | TPat_Cat [TPat a]- | TPat_TimeCat [TPat a]- | TPat_Overlay (TPat a) (TPat a)- | TPat_Stack [TPat a]- | TPat_CycleChoose [TPat a]- | TPat_ShiftL Time (TPat a)- -- TPat_E Int Int (TPat a)- | TPat_pE (TPat Int) (TPat Int) (TPat Int) (TPat a) deriving (Show) +{-+patLen :: TPat a -> Rational+patLen (TPat_Seq xs) = toRational $ sum $ map patLen xs+patLen TPat_Foot = error "Feet (.) aren't allowed here"+patLen (TPat_Elongate r) = r - 1+patLen (TPat_Repeat n) = toRational $ n - 1+patLen _ = 1+-}++{-+resolve a@(TPat_Atom _) = a+resolve (TPat_Fast a b) = TPat_Fast (resolve a) (resolve b)+resolve (TPat_Slow a b) = TPat_Slow (resolve a) (resolve b)+resolve (TPat_DegradeBy a b c) = TPat_DegradeBy a b (resolve c)+resolve (TPat_CycleChoose a bs) = TPat_CycleChoose a (map resolve bs)+resolve (TPat_Euclid a b c d) = TPat_Euclid (resolve a) (resolve b) (resolve c) (resolve d)+resolve (TPat_Stack as) = TPat_Stack resolve+ | TPat_Polyrhythm (Maybe (TPat Rational)) [TPat a]+ | TPat_Seq [TPat a]+ | TPat_Silence+ | TPat_Foot+ | TPat_Elongate Rational+ | TPat_Repeat Int+ | TPat_EnumFromTo (TPat a) (TPat a)+-}+ toPat :: (Enumerable a, Parseable a) => TPat a -> Pattern a toPat = \case TPat_Atom x -> pure x- TPat_Density t x -> fast (toPat t) $ toPat x+ TPat_Fast t x -> fast (toPat t) $ toPat x TPat_Slow t x -> slow (toPat t) $ toPat x- TPat_Zoom a x -> zoomArc a $ toPat x- TPat_DegradeBy amt x -> _degradeBy amt $ toPat x- TPat_Silence -> silence- TPat_Cat xs -> fastcat $ map toPat xs- TPat_TimeCat xs -> timeCat $ map (\(n, pat) -> (toRational n, toPat pat)) $ durations xs- TPat_Overlay x0 x1 -> overlay (toPat x0) (toPat x1)- TPat_Stack xs -> stack $ map toPat xs- TPat_CycleChoose xs -> unwrap $ cycleChoose $ map toPat xs- TPat_ShiftL t x -> t `rotL` toPat x- TPat_pE n k s thing ->+ TPat_DegradeBy seed amt x -> _degradeByUsing (rotL (0.0001 * (fromIntegral seed)) rand) amt $ toPat x+ TPat_CycleChoose seed xs -> unwrap $ segment 1 $ chooseBy (rotL (0.0001 * (fromIntegral seed)) rand) $ map toPat xs+ TPat_Euclid n k s thing -> doEuclid (toPat n) (toPat k) (toPat s) (toPat thing)- TPat_Foot -> error "Can't happen, feet (.'s) only used internally.."+ TPat_Stack xs -> stack $ map toPat xs+ TPat_Silence -> silence TPat_EnumFromTo a b -> unwrap $ fromTo <$> toPat a <*> toPat b- -- TPat_EnumFromThenTo a b c -> unwrap $ fromThenTo <$> (toPat a) <*> (toPat b) <*> (toPat c)+ TPat_Foot -> error "Can't happen, feet are pre-processed."+ TPat_Polyrhythm mSteprate ps -> stack $ map adjust_speed pats+ where adjust_speed (sz, pat) = fast ((/sz) <$> steprate) pat+ pats = map resolve_tpat ps+ steprate :: Pattern Rational+ steprate = fromMaybe base_first (toPat <$> mSteprate)+ base_first | null pats = pure 0+ | otherwise = pure $ fst $ head pats+ TPat_Seq xs -> snd $ resolve_seq xs _ -> silence +resolve_tpat :: (Enumerable a, Parseable a) => TPat a -> (Rational, Pattern a)+resolve_tpat (TPat_Seq xs) = resolve_seq xs+resolve_tpat a = (1, toPat a)++resolve_seq :: (Enumerable a, Parseable a) => [TPat a] -> (Rational, Pattern a)+resolve_seq xs = (total_size, timeCat sized_pats)+ where sized_pats = map (toPat <$>) $ resolve_size xs+ total_size = sum $ map fst sized_pats++resolve_size :: [TPat a] -> [(Rational, TPat a)]+resolve_size [] = []+resolve_size ((TPat_Elongate r p):ps) = (r, p):(resolve_size ps)+resolve_size ((TPat_Repeat n p):ps) = replicate n (1,p) ++ (resolve_size ps)+resolve_size (p:ps) = (1,p):(resolve_size ps)++{- durations :: [TPat a] -> [(Int, TPat a)] durations [] = [] durations (TPat_Elongate n : xs) = (n, TPat_Silence) : durations xs durations (a : TPat_Elongate n : xs) = (n+1,a) : durations xs durations (a:xs) = (1,a) : durations xs+-} parseBP :: (Enumerable a, Parseable a) => String -> Either ParseError (Pattern a) parseBP s = toPat <$> parseTPat s@@ -100,7 +143,7 @@ parseTPat = parseRhythm tPatParser class Parseable a where- tPatParser :: Parser (TPat a)+ tPatParser :: MyParser (TPat a) doEuclid :: Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a -- toEuclid :: a -> @@ -184,23 +227,23 @@ lexer :: P.GenTokenParser String u Data.Functor.Identity.Identity lexer = P.makeTokenParser haskellDef -braces, brackets, parens, angles:: Parser a -> Parser a+braces, brackets, parens, angles:: MyParser a -> MyParser a braces = P.braces lexer brackets = P.brackets lexer parens = P.parens lexer angles = P.angles lexer -symbol :: String -> Parser String+symbol :: String -> MyParser String symbol = P.symbol lexer -natural, integer :: Parser Integer+natural, integer :: MyParser Integer natural = P.natural lexer integer = P.integer lexer -float :: Parser Double+float :: MyParser Double float = P.float lexer -naturalOrFloat :: Parser (Either Integer Double)+naturalOrFloat :: MyParser (Either Integer Double) naturalOrFloat = P.naturalOrFloat lexer data Sign = Positive | Negative@@ -209,14 +252,14 @@ applySign Positive = id applySign Negative = negate -sign :: Parser Sign+sign :: MyParser Sign sign = do char '-' return Negative <|> do char '+' return Positive <|> return Positive -intOrFloat :: Parser Double+intOrFloat :: MyParser Double intOrFloat = do s <- sign num <- naturalOrFloat return (case num of@@ -224,118 +267,96 @@ Left x -> fromIntegral $ applySign s x ) -{--r :: (Enumerable a, Parseable a) => String -> Pattern a -> IO (Pattern a)-r s orig = do E.handle- (\err -> do putStrLn (show (err :: E.SomeException))- return orig- )- (return $ p s)--}+parseRhythm :: Parseable a => MyParser (TPat a) -> String -> Either ParseError (TPat a)+parseRhythm f = runParser (pSequence f') (0 :: Int) ""+ where f' = do f+ <|> do symbol "~" <?> "rest"+ return TPat_Silence -parseRhythm :: Parseable a => Parser (TPat a) -> String -> Either ParseError (TPat a)-parseRhythm f = parse (pSequence f') ""- where f' = f- <|> do symbol "~" <?> "rest"- return TPat_Silence+pSequence :: Parseable a => MyParser (TPat a) -> GenParser Char Int (TPat a)+pSequence f = do spaces -- TODO is this needed?+ -- d <- pFast+ s <- many $ do a <- pPart f+ spaces+ do try $ symbol ".."+ b <- pPart f+ return $ TPat_EnumFromTo a b+ <|> do rs <- many1 $ do oneOf "@_"+ r <- ((subtract 1) <$> pRatio) <|> return 1+ spaces+ return $ r+ return $ TPat_Elongate (1 + sum rs) a+ <|> do es <- many1 $ do char '!'+ n <- (((subtract 1) . read) <$> many1 digit) <|> return 1+ spaces+ return n+ return $ TPat_Repeat (1 + sum es) a+ <|> return a+ <|> do symbol "."+ return TPat_Foot+ return $ 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'' -pSequenceN :: Parseable a => Parser (TPat a) -> GenParser Char () (Int, TPat a)-pSequenceN f = do spaces- -- d <- pDensity- ps <- many $ do a <- pPart f- do Text.ParserCombinators.Parsec.try $ symbol ".."- b <- pPart f- return [TPat_EnumFromTo (TPat_Cat a) (TPat_Cat b)]- <|> return a- <|> do symbol "."- return [TPat_Foot]- <|> do es <- many1 (symbol "_")- return [TPat_Elongate (length es)]- let ps' = TPat_Cat $ map elongate $ splitFeet $ concat ps- extraElongate (TPat_Elongate n) = n-1- extraElongate _ = 0- sumElongates x = sum (map extraElongate x)- return (length ps + sumElongates (concat ps), ps') -elongate :: [TPat a] -> TPat a-elongate xs | any isElongate xs = TPat_TimeCat xs- | otherwise = TPat_Cat xs- where isElongate (TPat_Elongate _) = True- isElongate _ = False-{--expandEnum :: Parseable t => Maybe (TPat t) -> [TPat t] -> [TPat t]-expandEnum a [] = [a]-expandEnum (Just a) (TPat_Enum:b:ps) = (TPat_EnumFromTo a b) : (expandEnum Nothing ps)--- ignore ..s in other places-expandEnum a (TPat_Enum:ps) = expandEnum a ps-expandEnum (Just a) (b:ps) = a:(expandEnum b (Just c) ps)-expandEnum Nothing (c:ps) = expandEnum (Just c) ps--}---- could use splitOn here but `TPat a` isn't a member of `EQ`..-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 :: Parseable a => Parser (TPat a) -> GenParser Char () (TPat a)-pSequence f = do (_, pat) <- pSequenceN f- return pat--pSingle :: Parser (TPat a) -> Parser (TPat a)+pSingle :: MyParser (TPat a) -> MyParser (TPat a) pSingle f = f >>= pRand >>= pMult -pPart :: Parseable a => Parser (TPat a) -> Parser [TPat a]-pPart f = do pt <- pSingle f <|> pPolyIn f <|> pPolyOut f- pt' <- pE pt- pt'' <- pRand pt'- spaces- pts <- pStretch pt- <|> pReplicate pt''- spaces- return pts+pPart :: Parseable a => MyParser (TPat a) -> MyParser (TPat a)+pPart f = do pt <- (pSingle f <|> pPolyIn f <|> pPolyOut f) >>= pE >>= pRand+ spaces -- TODO is this needed?+ return pt -pPolyIn :: Parseable a => Parser (TPat a) -> Parser (TPat a)-pPolyIn f = do x <- brackets $ do p <- pSequence f <?> "sequence"- stackTail p <|> chooseTail p <|> return p+newSeed :: MyParser Int+newSeed = do seed <- Text.Parsec.Prim.getState+ Text.Parsec.Prim.modifyState (+1)+ return seed++pPolyIn :: Parseable a => MyParser (TPat a) -> MyParser (TPat a)+pPolyIn f = do x <- brackets $ do s <- pSequence f <?> "sequence"+ stackTail s <|> chooseTail s <|> return s pMult x- where stackTail p = do symbol ","- ps <- pSequence f `sepBy` symbol ","- spaces- return $ TPat_Stack (p:ps)- chooseTail p = do symbol "|"- ps <- pSequence f `sepBy` symbol "|"- spaces- return $ TPat_CycleChoose (p:ps)+ where stackTail s = do symbol ","+ ss <- pSequence f `sepBy` symbol ","+ spaces -- TODO needed?+ return $ TPat_Stack (s:ss)+ chooseTail s = do symbol "|"+ ss <- pSequence f `sepBy` symbol "|"+ spaces -- TODO needed?+ seed <- newSeed+ return $ TPat_CycleChoose seed (s:ss) -pPolyOut :: Parseable a => Parser (TPat a) -> Parser (TPat a)-pPolyOut f = do ps <- braces (pSequenceN f `sepBy` symbol ",")- spaces+pPolyOut :: Parseable a => MyParser (TPat a) -> MyParser (TPat a)+pPolyOut f = do ss <- braces (pSequence f `sepBy` symbol ",")+ spaces -- TODO needed? base <- do char '%'- spaces- i <- integer <?> "integer"- return $ Just (fromIntegral i)+ spaces -- TODO needed/wanted?+ r <- pRational <?> "rational" -- TODO does rational work ok here?+ return $ Just r <|> return Nothing- pMult $ TPat_Stack $ scale' base ps+ pMult $ TPat_Polyrhythm base ss <|>- do ps <- angles (pSequenceN f `sepBy` symbol ",")- spaces- pMult $ TPat_Stack $ scale' (Just 1) ps- where scale' _ [] = []- scale' base pats@((n,_):_) = map (\(n',pat) -> TPat_Density (TPat_Atom $ fromIntegral (fromMaybe n base)/ fromIntegral n') pat) pats+ do ss <- angles (pSequence f `sepBy` symbol ",")+ spaces -- TODO needed/wanted?+ pMult $ TPat_Polyrhythm (Just $ TPat_Atom 1) ss -pString :: Parser String+pString :: MyParser String pString = do c <- (letter <|> oneOf "0123456789") <?> "charnum" cs <- many (letter <|> oneOf "0123456789:.-_") <?> "string" return (c:cs) -pVocable :: Parser (TPat String)+pVocable :: MyParser (TPat String) pVocable = TPat_Atom <$> pString -pDouble :: Parser (TPat Double)+pDouble :: MyParser (TPat Double) pDouble = do f <- choice [intOrFloat, parseNote] <?> "float" do c <- parseChord return $ TPat_Stack $ map (TPat_Atom . (+f)) c@@ -345,24 +366,24 @@ return $ TPat_Stack $ map TPat_Atom c -pBool :: Parser (TPat Bool)+pBool :: MyParser (TPat Bool) pBool = do oneOf "t1" return $ TPat_Atom True <|> do oneOf "f0" return $ TPat_Atom False -parseIntNote :: Integral i => Parser i+parseIntNote :: Integral i => MyParser i parseIntNote = do s <- sign i <- choice [integer, parseNote] return $ applySign s $ fromIntegral i -parseInt :: Parser Int+parseInt :: MyParser Int parseInt = do s <- sign i <- integer return $ applySign s $ fromIntegral i -pIntegral :: Integral a => Parser (TPat a)+pIntegral :: Integral a => MyParser (TPat a) pIntegral = do i <- parseIntNote do c <- parseChord return $ TPat_Stack $ map (TPat_Atom . (+i)) c@@ -371,7 +392,7 @@ do c <- parseChord return $ TPat_Stack $ map TPat_Atom c -parseChord :: (Enum a, Num a) => Parser [a]+parseChord :: (Enum a, Num a) => MyParser [a] parseChord = do char '\'' name <- many1 $ letter <|> digit let chord = fromMaybe [0] $ lookup name chordTable@@ -384,14 +405,14 @@ return chord' <|> return chord -parseNote :: Num a => Parser a+parseNote :: Num a => MyParser a parseNote = do n <- notenum modifiers <- many noteModifier octave <- option 5 natural let n' = foldr (+) n modifiers return $ fromIntegral $ n' + ((octave-5)*12) where- notenum :: Parser Integer+ notenum :: MyParser Integer notenum = choice [char 'c' >> return 0, char 'd' >> return 2, char 'e' >> return 4,@@ -400,25 +421,25 @@ char 'a' >> return 9, char 'b' >> return 11 ]- noteModifier :: Parser Integer+ noteModifier :: MyParser Integer noteModifier = choice [char 's' >> return 1, char 'f' >> return (-1), char 'n' >> return 0 ] fromNote :: Num a => Pattern String -> Pattern a-fromNote pat = either (const 0) id . parse parseNote "" <$> pat+fromNote pat = either (const 0) id . runParser parseNote 0 "" <$> pat -pColour :: Parser (TPat ColourD)+pColour :: MyParser (TPat ColourD) pColour = do name <- many1 letter <?> "colour name" colour <- readColourName name <?> "known colour" return $ TPat_Atom colour -pMult :: TPat a -> Parser (TPat a)+pMult :: TPat a -> MyParser (TPat a) pMult thing = do char '*' spaces r <- pRational <|> pPolyIn pRational <|> pPolyOut pRational- return $ TPat_Density r thing+ return $ TPat_Fast r thing <|> do char '/' spaces@@ -427,18 +448,19 @@ <|> return thing -pRand :: TPat a -> Parser (TPat a)+pRand :: TPat a -> MyParser (TPat a) pRand thing = do char '?' r <- float <|> return 0.5 spaces- return $ TPat_DegradeBy r thing+ seed <- newSeed+ return $ TPat_DegradeBy seed r thing <|> return thing -pE :: TPat a -> Parser (TPat a)+pE :: TPat a -> MyParser (TPat a) pE thing = do (n,k,s) <- parens pair- pure $ TPat_pE n k s thing+ pure $ TPat_Euclid n k s thing <|> return thing- where pair :: Parser (TPat Int, TPat Int, TPat Int)+ where pair :: MyParser (TPat Int, TPat Int, TPat Int) pair = do a <- pSequence pIntegral spaces symbol ","@@ -450,25 +472,7 @@ <|> return (TPat_Atom 0) return (a, b, c) -pReplicate :: TPat a -> Parser [TPat a]-pReplicate thing =- do extras <- many $ do char '!'- -- if a number is given (without a space)slow 2 $ fast- -- replicate that number of times- n <- (read <$> many1 digit) <|> return (2 :: Int)- spaces- thing' <- pRand thing- -- -1 because we already have parsed the original one- return $ replicate (fromIntegral (n-1)) thing'- return (thing:concat extras)--pStretch :: TPat a -> Parser [TPat a]-pStretch thing =- do char '@'- n <- (read <$> many1 digit) <|> return 1- return $ map (\x -> TPat_Zoom (Arc (x%n) ((x+1)%n)) thing) [0 .. (n-1)]--pRatio :: Parser Rational+pRatio :: MyParser Rational pRatio = do s <- sign n <- natural result <- do char '%'@@ -484,13 +488,7 @@ return (n%1) return $ applySign s result -pRational :: Parser (TPat Rational)+pRational :: MyParser (TPat Rational) pRational = TPat_Atom <$> pRatio -{--pDensity :: Parser (Rational)-pDensity = angles (pRatio <?> "ratio")- <|>- return (1 % 1)--}
src/Sound/Tidal/Stream.hs view
@@ -25,7 +25,6 @@ -- import qualified Sound.OSC.Datum as O import Data.List (sortOn) import System.Random (getStdRandom, randomR)-import Data.Word (Word8) data TimeStamp = BundleStamp | MessageStamp | NoStamp deriving (Eq, Show)
src/Sound/Tidal/Tempo.hs view
@@ -12,10 +12,11 @@ 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 (nub) import qualified Control.Exception as E-+import Data.Maybe (fromJust) import Sound.Tidal.Config+import Sound.Tidal.Utils (writeError) instance Show O.UDP where show _ = "-unshowable-"@@ -64,10 +65,13 @@ cps = newCps }) +defaultCps :: O.Time+defaultCps = 0.5625+ defaultTempo :: O.Time -> O.UDP -> N.SockAddr -> Tempo defaultTempo t local remote = Tempo {atTime = t, atCycle = 0,- cps = 0.5625,+ cps = defaultCps, paused = False, nudged = 0, localUDP = local,@@ -123,8 +127,8 @@ when (t < logicalNow) $ threadDelay (floor $ delta * 1000000) t' <- O.time let actualTick = floor $ (t' - start st) / frameTimespan- -- reset ticks if ahead/behind by 4 or more- ahead = (abs $ actualTick - ticks st) > 4+ -- reset ticks if ahead/behind by skipTicks or more+ ahead = (abs $ actualTick - ticks st) > (cSkipTicks config) newTick | ahead = actualTick | otherwise = (ticks st) + 1 st' = st {ticks = newTick,@@ -132,7 +136,7 @@ nowTimespan = (logicalNow, logicalNow + frameTimespan), starting = not (synched tempo) }- when ahead $ putStrLn $ "skip: " ++ show (actualTick - ticks st)+ when ahead $ writeError $ "skip: " ++ show (actualTick - ticks st) callback tempoMV st' {-putStrLn ("actual tick: " ++ show actualTick ++ " old tick: " ++ show (ticks st)@@ -165,7 +169,7 @@ O.Float $ realToFrac $ cps tempo, O.Int32 $ if paused tempo then 1 else 0 ]-+ listenTempo :: O.UDP -> MVar Tempo -> IO () listenTempo udp tempoMV = forever $ do pkt <- O.recvPacket udp act Nothing pkt@@ -184,33 +188,38 @@ paused = paused' == 1, synched = True }- act _ pkt = putStrLn $ "Unknown packet: " ++ show pkt+ act _ pkt = writeError $ "Unknown packet (client): " ++ show pkt serverListen :: Config -> IO (Maybe ThreadId)-serverListen config = catchAny run (\_ -> do putStrLn "Tempo listener failed (is one already running?)"- return Nothing- )+serverListen config = catchAny run (\_ -> return Nothing) -- probably just already running) where run = do let port = cTempoPort config -- iNADDR_ANY deprecated - what's the right way to do this? udp <- O.udpServer "0.0.0.0" port- tid <- forkIO $ loop udp []+ cpsMessage <- defaultCpsMessage+ tid <- forkIO $ loop udp ([], cpsMessage) return $ Just tid- loop udp cs = do (pkt,c) <- O.recvFrom udp- cs' <- act udp c Nothing cs pkt- loop udp cs'- act :: O.UDP -> N.SockAddr -> Maybe O.Time -> [N.SockAddr] -> O.Packet -> IO [N.SockAddr]- act udp c _ cs (O.Packet_Bundle (O.Bundle ts ms)) = foldM (act udp c (Just ts)) cs $ map O.Packet_Message ms- act _ c _ cs (O.Packet_Message (O.Message "/hello" []))- = return $ nub $ c:cs- act udp _ (Just ts) cs (O.Packet_Message (O.Message path params))- | "/transmit" `isPrefixOf` path =- do let path' = drop 9 path- msg = O.Message path' params- mapM_ (O.sendTo udp $ O.p_bundle ts [msg]) cs- return cs- act _ _ _ cs pkt = do putStrLn $ "Unknown packet: " ++ show pkt- return cs+ loop udp (cs, msg) = do (pkt,c) <- O.recvFrom udp+ (cs', msg') <- act udp c Nothing (cs,msg) pkt+ loop udp (cs', msg')+ act :: O.UDP -> N.SockAddr -> Maybe O.Time -> ([N.SockAddr], O.Packet) -> O.Packet -> IO ([N.SockAddr], O.Packet)+ act udp c _ (cs,msg) (O.Packet_Bundle (O.Bundle ts ms)) = foldM (act udp c (Just ts)) (cs,msg) $ map O.Packet_Message ms+ act udp c _ (cs,msg) (O.Packet_Message (O.Message "/hello" []))+ = do O.sendTo udp msg c + return (nub (c:cs),msg)+ act udp _ (Just ts) (cs,_) (O.Packet_Message (O.Message "/transmit/cps/cycle" params)) =+ do let path' = "/cps/cycle"+ msg' = O.p_bundle ts [O.Message path' params]+ mapM_ (O.sendTo udp msg') cs+ return (cs, msg')+ act _ x _ (cs,msg) pkt = do writeError $ "Unknown packet (serv): " ++ show pkt ++ " / " ++ (show x)+ return (cs,msg) catchAny :: IO a -> (E.SomeException -> IO a) -> IO a catchAny = E.catch+ defaultCpsMessage = do ts <- O.time+ return $ O.p_bundle ts [O.Message "/cps/cycle" [O.Float $ 0,+ O.Float $ realToFrac $ defaultCps,+ O.Int32 0+ ]+ ]
src/Sound/Tidal/UI.hs view
@@ -197,8 +197,12 @@ degradeBy = tParam _degradeBy _degradeBy :: Double -> Pattern a -> Pattern a-_degradeBy x p = fmap fst $ filterValues ((> x) . snd) $ (,) <$> p <* rand+_degradeBy = _degradeByUsing rand +-- Useful for manipulating random stream, e.g. to change 'seed'+_degradeByUsing :: Pattern Double -> Double -> Pattern a -> Pattern a+_degradeByUsing prand x p = fmap fst $ filterValues ((> x) . snd) $ (,) <$> p <* prand+ unDegradeBy :: Pattern Double -> Pattern a -> Pattern a unDegradeBy = tParam _unDegradeBy @@ -1427,13 +1431,25 @@ where compound n | n <= 1 = p | otherwise = overlay p (f $ compound $ n-1) --- Uses the first (binary) pattern to switch between the following two--- patterns.+-- | Uses the first (binary) pattern to switch between the following+-- two patterns. The resulting structure comes from the source patterns, not the+-- binary pattern. See also @stitch@. sew :: Pattern Bool -> Pattern a -> Pattern a -> Pattern a sew pb a b = overlay (mask pb a) (mask (inv pb) b) +-- | Uses the first (binary) pattern to switch between the following+-- two patterns. The resulting structure comes from the binary+-- pattern, not the source patterns. See also @sew@. stitch :: Pattern Bool -> Pattern a -> Pattern a -> Pattern a stitch pb a b = overlay (struct pb a) (struct (inv pb) b)++-- | A binary pattern is used to conditionally apply a function to a+-- source pattern. The function is applied when a @True@ value is+-- active, and the pattern is let through unchanged when a @False@+-- value is active. No events are let through where no binary values+-- are active.+while :: Pattern Bool -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+while b f pat = sew b (f pat) pat stutter :: Integral i => i -> Time -> Pattern a -> Pattern a stutter n t p = stack $ map (\i -> (t * fromIntegral i) `rotR` p) [0 .. (n-1)]
src/Sound/Tidal/Utils.hs view
@@ -1,6 +1,10 @@ module Sound.Tidal.Utils where import Data.List (delete)+import System.IO (hPutStrLn, stderr)++writeError :: String -> IO ()+writeError = hPutStrLn stderr mapBoth :: (a -> a) -> (a,a) -> (a,a) mapBoth f (a,b) = (f a, f b)
src/Sound/Tidal/Version.hs view
@@ -1,4 +1,4 @@ module Sound.Tidal.Version where tidal_version :: String-tidal_version = "1.4.4"+tidal_version = "1.4.5"
test/Sound/Tidal/ParseTest.hs view
@@ -43,6 +43,10 @@ compareP (Arc 0 2) ("a! b" :: Pattern String) (fastCat ["a", "a", "b"])+ it "can replicate with ! inside {}" $ do+ compareP (Arc 0 2)+ ("{a a}%2" :: Pattern String)+ ("{a !}%2" :: Pattern String) it "can replicate with ! and number" $ do compareP (Arc 0 2) ("a!3 b" :: Pattern String)
tidal.cabal view
@@ -1,5 +1,5 @@ name: tidal-version: 1.4.4+version: 1.4.5 synopsis: Pattern language for improvised music -- description: homepage: http://tidalcycles.org/