tidal 1.0.5 → 1.0.6

raw patch · 15 files changed

+689/−318 lines, 15 filesdep −hashabledep −monad-loopsdep −mtldep ~basedep ~bifunctorsdep ~colourPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: hashable, monad-loops, mtl, random, safe, time

Dependency ranges changed: base, bifunctors, colour, containers, hosc, mwc-random, network, parsec, text, vector

API changes (from Hackage documentation)

Files

• src/Sound/Tidal/Control.hs +4/−4
• src/Sound/Tidal/Core.hs +1/−6
• src/Sound/Tidal/MiniTidal.hs +387/−206
• src/Sound/Tidal/Params.hs +27/−0
• src/Sound/Tidal/ParseBP.hs +7/−2
• src/Sound/Tidal/Pattern.hs +1/−1
• src/Sound/Tidal/Stream.hs +125/−41
• src/Sound/Tidal/Transition.hs +2/−2
• src/Sound/Tidal/UI.hs +49/−11
• test/Sound/Tidal/ControlTest.hs +27/−0
• test/Sound/Tidal/CoreTest.hs +5/−0
• test/Sound/Tidal/MiniTidalTest.hs +12/−0
• test/Test.hs +2/−0
• tidal.cabal +12/−17
• tidal.el +28/−28

@@ -335,7 +335,7 @@ stut = tParam3 _stut  _stut :: Integer -> Double -> Rational -> ControlPattern -> ControlPattern-_stut count feedback time p = stack (p:(map (\x -> (((x%count)*time) `rotR` (p |* P.gain (pure $ scalegain (fromIntegral x))))) [1..(count-1)]))+_stut count feedback steptime p = stack (p:(map (\x -> (((x%1)*steptime) `rotR` (p |* P.gain (pure $ scalegain (fromIntegral x))))) [1..(count-1)]))   where scalegain x           = ((+feedback) . (*(1-feedback)) . (/(fromIntegral count)) . ((fromIntegral count)-)) x @@ -348,11 +348,11 @@ In this case there are two _overlays_ delayed by 1/3 of a cycle, where each has the @vowel@ filter applied. -} stutWith :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-stutWith n t f p = unwrap $ (\a b -> _stutWith a b f p) <$> n <*> t+stutWith n t f p = innerJoin $ (\a b -> _stutWith a b f p) <$> n <* t  _stutWith :: (Num n, Ord n) => n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-_stutWith count steptime f p | count <= 0 = p-                          | otherwise = overlay (f (steptime `rotR` _stutWith (count-1) steptime f p)) p+_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 stut' :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a

@@ -361,7 +361,7 @@ -- | @every n f p@ applies the function @f@ to @p@, but only affects -- every @n@ cycles. every :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-every tp f p = tp >>= \t -> _every t f p+every tp f p = innerJoin $ (\t -> _every t f p) <$> tp  _every :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a _every 0 _ p = p@@ -405,8 +405,3 @@ whenT test f p = splitQueries $ p {query = apply}   where apply st | test (start $ arc st) = query (f p) st                  | otherwise = query p st-----eoff :: Int -> Int -> Integer -> Pattern a -> Pattern a---eoff n k s p = ((s%(fromIntegral k)) `rotL`) (_e n k p)-   -- TPat_ShiftL (s%(fromIntegral k)) (TPat_E n k p)

@@ -4,10 +4,11 @@  import           Data.Functor.Identity (Identity) import           Text.Parsec.Language (haskellDef)-import           Text.Parsec.Prim (ParsecT)+import           Text.Parsec.Prim (ParsecT,parserZero) import           Text.ParserCombinators.Parsec import qualified Text.ParserCombinators.Parsec.Token as P import           Control.Monad (forever)+import Control.Applicative (liftA2) -- import Data.List (intercalate) -- import Data.Bool (bool) -- import Data.Ratio@@ -28,94 +29,78 @@     return x   ] -class Pattern' a where-  simplePattern :: Parser (Pattern a)-  complexPattern :: Parser (Pattern a)-  mergeOperator :: Parser (Pattern a -> Pattern a -> Pattern a)-  transformationWithoutArgs :: Parser (Pattern a -> Pattern a)-  transformationWithArgs :: Parser (Pattern a -> Pattern a)-  literal :: Parser a+class MiniTidal a where+  literal :: Parser a -- parse an individual pure value of this type+  simplePattern :: Parser (Pattern a) -- any way of making this pattern that wouldn't require parentheses if it was an argument+  complexPattern :: Parser (Pattern a) -- producing this pattern by way of unary functions with an argument of a different type+  transformationWithArguments:: Parser (Pattern a -> Pattern a) -- producing this pattern by with unary functions that take same type+  transformationWithoutArguments :: Parser (Pattern a -> Pattern a) -- also producing this pattern by unary functions of same type+  mergeOperator :: Parser (Pattern a -> Pattern a -> Pattern a) -- operators for combining this type of pattern, eg. # or |>+  binaryFunctions :: Parser (a -> a -> a) -- binary functions on pure values of this type, eg. (+) for Int or other Num instances -pattern :: Pattern' a => Parser (Pattern a)+literalArg :: MiniTidal a => Parser a+literalArg = choice [+  literal,+  nestedParens literal,+  try $ applied $ parensOrNot literal+  ]++listLiteralArg :: MiniTidal a => Parser [a]+listLiteralArg = brackets (commaSep $ parensOrNot literal)++pattern :: MiniTidal a => Parser (Pattern a) pattern = chainl1 pattern' mergeOperator -pattern' :: Pattern' a => Parser (Pattern a)+pattern' :: MiniTidal a => Parser (Pattern a) pattern' = choice [   nestedParens $ chainl1 pattern mergeOperator,-  parensOrNot complexPattern,-  parensOrNot genericComplexPatterns,-  parensOrNot transformedPattern,-  parensOrNot simplePattern,+  transformation <*> patternArg,+  genericComplexPattern,+  complexPattern,+  simplePattern,   silence   ] -patternArg :: Pattern' a => Parser (Pattern a)+patternArg :: MiniTidal a => Parser (Pattern a) patternArg = choice [   try $ parensOrApplied $ chainl1 pattern mergeOperator,-  try $ parensOrApplied transformedPattern,+  try $ parensOrApplied $ transformation <*> patternArg,+  try $ parensOrApplied genericComplexPattern,   try $ parensOrApplied complexPattern,-  try $ parensOrApplied genericComplexPatterns,-  appliedOrNot simplePattern,+  try $ appliedOrNot simplePattern,   appliedOrNot silence   ] -literalArg :: Pattern' a => Parser a-literalArg = choice [-  literal,-  nestedParens literal,-  try $ applied $ parensOrNot literal-  ]--listLiteralArg :: Pattern' a => Parser [a]-listLiteralArg = brackets (commaSep $ parensOrNot literal)--listPatternArg :: Pattern' a => Parser [Pattern a]-listPatternArg = parensOrNot $ brackets (commaSep pattern)--silence :: Parser (Pattern a)-silence = function "silence" >> return T.silence+transformation :: MiniTidal a => Parser (Pattern a -> Pattern a)+transformation = transformationWithArguments <|> transformationWithoutArguments -genericComplexPatterns :: Pattern' a => Parser (Pattern a)-genericComplexPatterns = choice [-  (function "stack" >> return T.stack) <*> listPatternArg,-  (function "fastcat" >> return T.fastcat) <*> listPatternArg,-  (function "slowcat" >> return T.slowcat) <*> listPatternArg,-  (function "cat" >> return T.cat) <*> listPatternArg,-  (function "listToPat" >> return T.listToPat) <*> listLiteralArg,-  (function "fit" >> return T.fit) <*> literalArg <*> listLiteralArg <*> patternArg,-  (function "choose" >> return T.choose) <*> listLiteralArg,-  (function "randcat" >> return T.randcat) <*> listPatternArg,-  (function "cycleChoose" >> return T.cycleChoose) <*> listLiteralArg+transformationArg :: MiniTidal a => Parser (Pattern a -> Pattern a)+transformationArg = choice [+  try $ appliedOrNot $ transformationWithoutArguments,+  parensOrApplied $ transformationWithArguments   ] -enumComplexPatterns :: (Enum a, Num a, Pattern' a) => Parser (Pattern a)-enumComplexPatterns = choice [-  (function "run" >> return T.run) <*> patternArg,-  (function "scan" >> return T.scan) <*> patternArg-  ]+listPatternArg :: MiniTidal a => Parser [Pattern a]+listPatternArg = try $ parensOrNot $ brackets (commaSep pattern) -numComplexPatterns :: (Num a, Pattern' a) => Parser (Pattern a)-numComplexPatterns = choice [-  (function "irand" >> return T.irand) <*> literal,-  (function "toScale'" >> return T.toScale') <*> literalArg <*> listLiteralArg <*> patternArg,-  (function "toScale" >> return T.toScale) <*> listLiteralArg <*> patternArg-  ]+listTransformationArg :: MiniTidal a => Parser [Pattern a -> Pattern a]+listTransformationArg = try $ parensOrNot $ brackets (commaSep transformation) -intComplexPatterns :: Parser (Pattern Int)-intComplexPatterns = choice [-  (function "randStruct" >> return T.randStruct) <*> literalArg-  ]+--  d1 $ spread ($) [density 2, rev, slow 2, striate 3, (# speed "0.8")] $ sound "[bd*2 [~ bd]] [sn future]*2 cp jvbass*4"+--  spread  ((a -> b) -> a -> b) -> [ControlPattern -> ControlPattern] -> ControlPattern -> ControlPattern -transformedPattern :: Pattern' a => Parser (Pattern a)-transformedPattern = (transformationWithArgs <|> transformationWithoutArgs) <*> patternArg -instance Pattern' ControlMap where-  simplePattern = choice []+silence :: Parser (Pattern a)+silence = function "silence" >> return T.silence++instance MiniTidal ControlMap where+  literal = parserZero+  simplePattern = parserZero+  transformationWithArguments = p_p <|> pControl_pControl+  transformationWithoutArguments = p_p_noArgs   complexPattern = specificControlPatterns   mergeOperator = controlPatternMergeOperator-  transformationWithArgs = controlPatternTransformation <|> patternTransformationWithArgs-  transformationWithoutArgs = patternTransformationWithoutArgs-  literal = choice []+  binaryFunctions = parserZero  controlPatternMergeOperator :: Parser (ControlPattern -> ControlPattern -> ControlPattern) controlPatternMergeOperator = choice [@@ -132,6 +117,7 @@  specificControlPatterns :: Parser ControlPattern specificControlPatterns = choice [+  try $ parens specificControlPatterns,   (function "coarse" >> return T.coarse) <*> patternArg,   (function "cut" >> return T.cut) <*> patternArg,   (function "n" >> return T.n) <*> patternArg,@@ -162,108 +148,273 @@   (function "note" >> return T.note) <*> patternArg   ] -controlPatternTransformation :: Parser (ControlPattern -> ControlPattern)-controlPatternTransformation = choice [-  function "chop" >> patternArg >>= return . T.chop,-  function "striate" >> patternArg >>= return . T.striate,-  (function "striate'" >> return T.striate') <*> patternArg <*> patternArg,-  (function "stut" >> return T.stut) <*> patternArg <*> patternArg <*> patternArg,-  function "jux" >> patternTransformationArg >>= return . T.jux+genericComplexPattern :: MiniTidal a => Parser (Pattern a)+genericComplexPattern = choice [+  try $ parens genericComplexPattern,+  lp_p <*> listPatternArg,+  l_p <*> listLiteralArg   ] -patternTransformationArg :: Pattern' a => Parser (Pattern a -> Pattern a)-patternTransformationArg = appliedOrNot transformationWithoutArgs <|> parensOrApplied transformationWithArgs--patternTransformationWithoutArgs :: Parser (Pattern a -> Pattern a)-patternTransformationWithoutArgs = choice [+p_p_noArgs :: Parser (Pattern a -> Pattern a)+p_p_noArgs  = choice [   function "brak" >> return T.brak,   function "rev" >> return T.rev,   function "palindrome" >> return T.palindrome,   function "stretch" >> return T.stretch,   function "loopFirst" >> return T.loopFirst,---  function "breakUp" >> return T.breakUp, -- removed from new Tidal?   function "degrade" >> return T.degrade   ] -patternTransformationWithArgs :: Pattern' a => Parser (Pattern a -> Pattern a)-patternTransformationWithArgs = parensOrNot $ choice [-  function "fast" >> patternArg >>= return . T.fast,---  function "fast'" >> patternArg >>= return . T.fast', -- removed from Tidal 1.0?-  function "density" >> patternArg >>= return . T.density,-  function "slow" >> patternArg >>= return . T.slow,-  function "iter" >> patternArg >>= return . T.iter,-  function "iter'" >> patternArg >>= return . T.iter',-  function "trunc" >> patternArg >>= return . T.trunc,-  (function "swingBy" >> return T.swingBy) <*> patternArg <*> patternArg,-  (function "append" >> return T.append) <*> patternArg,---  (function "append'" >> return T.append') <*> patternArg,-  (function "every" >> return T.every) <*> patternArg <*> patternTransformationArg,-  (function "every'" >> return T.every') <*> patternArg <*> patternArg <*> patternTransformationArg,-  (function "whenmod" >> return T.whenmod) <*> int <*> int <*> patternTransformationArg,-  (function "overlay" >> return T.overlay) <*> patternArg,-  (function "fastGap" >> return T.fastGap) <*> patternArg,-  (function "densityGap" >> return T.densityGap) <*> patternArg,-  (function "sparsity" >> return T.sparsity) <*> patternArg,-  (function "rotL" >> return T.rotL) <*> literalArg,-  (function "rotR" >> return T.rotR) <*> literalArg,-  (function "playFor" >> return T.playFor) <*> literalArg <*> literalArg,-  (function "foldEvery" >> return T.foldEvery) <*> listLiteralArg <*> patternTransformationArg,-  (function "superimpose" >> return T.superimpose) <*> patternTransformationArg,-  (function "trunc" >> return T.trunc) <*> patternArg,-  (function "linger" >> return T.linger) <*> patternArg,-  (function "zoom" >> return T.zoomArc) <*> literalArg,-  (function "compress" >> return T.compressArc) <*> literalArg,---  (function "sliceArc" >> return T.sliceArc) <*> literalArg,-  (function "within" >> return T.withinArc) <*> literalArg <*> patternTransformationArg,-  --(function "within'" >> return T.within') <*> literalArg <*> patternTransformationArg,-  -- (function "revArc" >> return T.revArc) <*> literalArg,-  (function "euclid" >> return T.euclid) <*> patternArg <*> patternArg,-  (function "euclidFull" >> return T.euclidFull) <*> patternArg <*> patternArg <*> patternArg,-  (function "euclidInv" >> return T.euclidInv) <*> patternArg <*> patternArg,-  (function "distrib" >> return T.distrib) <*> listPatternArg,-  (function "wedge" >> return T.wedge) <*> literalArg <*> patternArg,---  (function "prr" >> return T.prr) <*> literalArg <*> literalArg <*> patternArg,---  (function "preplace" >> return T.preplace) <*> literalArg <*> patternArg,---  (function "prep" >> return T.prep) <*> literalArg <*> patternArg,---  (function "preplace1" >> return T.preplace1) <*> patternArg,---  (function "protate" >> return T.protate) <*> literalArg <*> literalArg,---  (function "prot" >> return T.prot) <*> literalArg <*> literalArg,---  (function "prot1" >> return T.prot1) <*> literalArg,-  (function "discretise" >> return T.discretise) <*> patternArg,-  (function "segment" >> return T.segment) <*> patternArg,-  --(function "struct" >> return T.struct) <*> patternArg,-  (function "substruct" >> return T.substruct) <*> patternArg,-  (function "compressTo" >> return T.compressArcTo) <*> literalArg,-  (function "substruct'" >> return T.substruct') <*> patternArg,-  (function "slowstripe" >> return T.slowstripe) <*> patternArg,-  (function "fit'" >> return T.fit') <*> patternArg <*> literalArg <*> patternArg <*> patternArg,-  (function "chunk" >> return T.chunk) <*> literalArg <*> patternTransformationArg,-  (function "timeLoop" >> return T.timeLoop) <*> patternArg,-  (function "swing" >> return T.swing) <*> patternArg,-  (function "degradeBy" >> return T.degradeBy) <*> patternArg,-  (function "unDegradeBy" >> return T.unDegradeBy) <*> patternArg,-  (function "degradeOverBy" >> return T.degradeOverBy) <*> literalArg <*> patternArg,-  (function "sometimesBy" >> return T.sometimesBy) <*> patternArg <*> patternTransformationArg,-  (function "sometimes" >> return T.sometimes) <*> patternTransformationArg,-  (function "often" >> return T.often) <*> patternTransformationArg,-  (function "rarely" >> return T.rarely) <*> patternTransformationArg,-  (function "almostNever" >> return T.almostNever) <*> patternTransformationArg,-  (function "almostAlways" >> return T.almostAlways) <*> patternTransformationArg,-  (function "never" >> return T.never) <*> patternTransformationArg,-  (function "always" >> return T.always) <*> patternTransformationArg,-  (function "someCyclesBy" >> return T.someCyclesBy) <*> literalArg <*> patternTransformationArg,-  (function "somecyclesBy" >> return T.somecyclesBy) <*> literalArg <*> patternTransformationArg,-  (function "someCycles" >> return T.someCycles) <*> patternTransformationArg,-  (function "somecycles" >> return T.somecycles) <*> patternTransformationArg,-  (function "substruct'" >> return T.substruct') <*> patternArg,-  (function "repeatCycles" >> return T.repeatCycles) <*> literalArg,-  (function "spaceOut" >> return T.spaceOut) <*> listLiteralArg,---  (function "fill" >> return T.fill) <*> patternArg, -- removed from tidal-1.0?-  (function "ply" >> return T.ply) <*> patternArg,-  (function "shuffle" >> return T.shuffle) <*> literalArg,-  (function "scramble" >> return T.scramble) <*> literalArg+p_p :: (MiniTidal a, MiniTidal a) => Parser (Pattern a -> Pattern a)+p_p = choice [+  try $ parens p_p,+  p_p_p <*> patternArg,+  t_p_p <*> transformationArg,+  lp_p_p <*> listPatternArg,+  lt_p_p <*> listTransformationArg,+  lpInt_p_p <*> listPatternArg,+  pTime_p_p <*> patternArg,+  pInt_p_p <*> patternArg,+  pString_p_p <*> patternArg,+  pDouble_p_p <*> patternArg,+  vTime_p_p <*> literalArg,+  vInt_p_p <*> literalArg,+  vTimeTime_p_p <*> literalArg,+  pDouble_p_p <*> patternArg,+  lTime_p_p <*> listLiteralArg   ] +lt_p_p = choice [+  try $ parens lt_p_p,+  spreads <*> (nestedParens $ reservedOp "$" >> return ($))+  ]++l_p :: MiniTidal a => Parser ([a] -> Pattern a)+l_p = choice [+  function "listToPat" >> return T.listToPat,+  function "choose" >> return T.choose,+  function "cycleChoose" >> return T.cycleChoose+  ]++lp_p :: MiniTidal a => Parser ([Pattern a] -> Pattern a)+lp_p = choice [+  function "stack" >> return T.stack,+  function "fastcat" >> return T.fastcat,+  function "slowcat" >> return T.slowcat,+  function "cat" >> return T.cat,+  function "randcat" >> return T.randcat+  ]++pInt_p :: MiniTidal a => Parser (Pattern Int -> Pattern a)+pInt_p = choice [+  try $ parens pInt_p,+  l_pInt_p <*> listLiteralArg+  ]++p_p_p :: MiniTidal a => Parser (Pattern a -> Pattern a -> Pattern a)+p_p_p = choice [+  try $ parens p_p_p,+  liftA2 <$> binaryFunctions,+  function "overlay" >> return T.overlay,+  function "append" >> return T.append,+  vTime_p_p_p <*> literalArg,+  pInt_p_p_p <*> patternArg+  ]++pTime_p_p = choice [+  try $ parens pTime_p_p,+  function "fast" >> return T.fast,+  function "fastGap" >> return T.fastGap,+  function "density" >> return T.density,+  function "slow" >> return T.slow,+  function "trunc" >> return T.trunc,+  function "fastGap" >> return T.fastGap,+  function "densityGap" >> return T.densityGap,+  function "sparsity" >> return T.sparsity,+  function "trunc" >> return T.trunc,+  function "linger" >> return T.linger,+  function "segment" >> return T.segment,+  function "discretise" >> return T.discretise,+  function "timeLoop" >> return T.timeLoop,+  function "swing" >> return T.swing,+  pTime_pTime_p_p <*> patternArg+  ]++lTime_p_p = choice [+  try $ parens lTime_p_p,+  spreads <*> parens vTime_p_p -- re: spread+  ]++spreads = choice [+  function "spread" >> return T.spread,+  function "slowspread" >> return T.slowspread,+  function "fastspread" >> return T.fastspread+  ]++pInt_p_p = choice [+  try $ parens pInt_p_p,+  function "iter" >> return T.iter,+  function "iter'" >> return T.iter',+  function "ply" >> return T.ply,+  function "substruct'" >> return T.substruct',+  function "slowstripe" >> return T.slowstripe,+  pInt_pInt_p_p <*> patternArg+  ]++pString_p_p = function "substruct" >> return T.substruct++pDouble_p_p = choice [+  try $ parens pDouble_p_p,+  function "degradeBy" >> return T.degradeBy,+  function "unDegradeBy" >> return T.unDegradeBy,+  vInt_pDouble_p_p <*> literalArg+  ]++vTime_p_p = choice [+  try $ parens vTime_p_p,+  function "rotL" >> return T.rotL,+  function "rotR" >> return T.rotR,+  vTime_vTime_p_p <*> literalArg+  ]++vInt_p_p = choice [+  function "shuffle" >> return T.shuffle,+  function "scramble" >> return T.scramble,+  function "repeatCycles" >> return T.repeatCycles+  ]++vTimeTime_p_p = choice [+  function "compress" >> return T.compressArc,+  function "zoom" >> return T.zoomArc,+  function "compressTo" >> return T.compressArcTo+  ]++t_p_p = choice [+  try $ parens t_p_p,+  function "sometimes" >> return T.sometimes,+  function "often" >> return T.often,+  function "rarely" >> return T.rarely,+  function "almostNever" >> return T.almostNever,+  function "almostAlways" >> return T.almostAlways,+  function "never" >> return T.never,+  function "always" >> return T.always,+  function "superimpose" >> return T.superimpose,+  function "someCycles" >> return T.someCycles,+  function "somecycles" >> return T.somecycles,+  pInt_t_p_p <*> patternArg,+  pDouble_t_p_p <*> patternArg,+  lvInt_t_p_p <*> listLiteralArg,+  vInt_t_p_p <*> literalArg,+  vDouble_t_p_p <*> literalArg+  ]++lvTime_p_p = function "spaceOut" >> return T.spaceOut++lpInt_p_p = function "distrib" >> return T.distrib++lp_p_p :: MiniTidal a => Parser ([Pattern a] -> Pattern a -> Pattern a)+lp_p_p = choice [+  try $ parens lp_p_p,+  try $ spreads <*> parens p_p_p+  ]++l_pInt_p = choice [+  try $ parens l_pInt_p,+  vInt_l_pInt_p <*> literalArg+  ]++vInt_l_pInt_p = function "fit" >> return T.fit++vTime_p_p_p = function "wedge" >> return T.wedge++vInt_pDouble_p_p = function "degradeOverBy" >> return T.degradeOverBy++pInt_t_p_p = choice [+  try $ parens pInt_t_p_p,+  function "every" >> return T.every,+  pInt_pInt_t_p_p <*> patternArg+  ]++pDouble_t_p_p = function "sometimesBy" >> return T.sometimesBy++lvInt_t_p_p = function "foldEvery" >> return T.foldEvery++vTime_vTime_p_p = function "playFor" >> return T.playFor++vTimeTime_t_p_p = function "within" >> return T.withinArc++vInt_t_p_p = choice [+  try $ parens vInt_t_p_p,+  function "chunk" >> return T.chunk,+  vInt_vInt_t_p_p <*> literalArg+  ]++vDouble_t_p_p = choice [+  function "someCyclesBy" >> return T.someCyclesBy,+  function "somecyclesBy" >> return T.somecyclesBy+  ]++pInt_pInt_p_p = choice [+  try $ parens pInt_pInt_p_p,+  function "euclid" >> return T.euclid,+  function "euclidInv" >> return T.euclidInv,+  vInt_pInt_pInt_p_p <*> literalArg+  ]++pTime_pTime_p_p = function "swingBy" >> return T.swingBy++pInt_pInt_t_p_p = function "every'" >> return T.every'++vInt_vInt_t_p_p = function "whenmod" >> return T.whenmod++pInt_p_p_p = choice [+  try $ parens pInt_p_p_p,+  pInt_pInt_p_p_p <*> patternArg+  ]++pInt_pInt_p_p_p = function "euclidFull" >> return T.euclidFull++vInt_pInt_pInt_p_p = choice [+  try $ parens vInt_pInt_pInt_p_p,+  pTime_vInt_pInt_pInt_p_p <*> patternArg+  ]++pTime_vInt_pInt_pInt_p_p = function "fit'" >> return T.fit'++pControl_pControl = choice [+  try $ parens pControl_pControl,+  pInt_pControl_pControl <*> patternArg,+  pDouble_pControl_pControl <*> patternArg,+  pTime_pControl_pControl <*> patternArg,+  tControl_pControl_pControl <*> transformationArg+  ]++tControl_pControl_pControl = function "jux" >> return T.jux++pInt_pControl_pControl = choice [+  function "chop" >> return T.chop,+  function "striate" >> return T.striate+  ]++pDouble_pControl_pControl = choice [+  try $ parens pDouble_pControl_pControl,+  pInt_pDouble_pControl_pControl <*> patternArg+  ]++pInt_pDouble_pControl_pControl = function "striate'" >> return T.striate'++pTime_pControl_pControl = choice [+  try $ parens pTime_pControl_pControl,+  pDouble_pTime_pControl_pControl <*> patternArg+  ]++pDouble_pTime_pControl_pControl = choice [+  try $ parens pDouble_pTime_pControl_pControl,+  pInteger_pDouble_pTime_pControl_pControl <*> patternArg+  ]++pInteger_pDouble_pTime_pControl_pControl = function "stut" >> return T.stut+ simpleDoublePatterns :: Parser (Pattern Double) simpleDoublePatterns = choice [   function "rand" >> return T.rand,@@ -275,71 +426,69 @@   function "cosine" >> return T.cosine   ] -instance Pattern' Int where-  simplePattern = choice [-    parseBP',-    pure <$> int-    ]+binaryNumFunctions :: Num a => Parser (a -> a -> a)+binaryNumFunctions = choice [+  try $ parens binaryNumFunctions,+  reservedOp "+" >> return (+),+  reservedOp "-" >> return (-),+  reservedOp "*" >> return (*)+  ]++instance MiniTidal Int where+  literal = int+  simplePattern = parseBP' <|> (pure <$> int)+  transformationWithArguments = p_p_noArgs+  transformationWithoutArguments = p_p   complexPattern = (atom <*> int) <|> enumComplexPatterns <|> numComplexPatterns <|> intComplexPatterns   mergeOperator = numMergeOperator-  transformationWithoutArgs = patternTransformationWithoutArgs-  transformationWithArgs = patternTransformationWithArgs-  literal = int+  binaryFunctions = binaryNumFunctions -instance Pattern' Integer where-  simplePattern = choice [-    parseBP',-    pure <$> integer-    ]+instance MiniTidal Integer where+  literal = integer+  simplePattern = parseBP' <|> (pure <$> integer)+  transformationWithArguments = p_p_noArgs+  transformationWithoutArguments = p_p   complexPattern = (atom <*> integer) <|> enumComplexPatterns <|> numComplexPatterns   mergeOperator = numMergeOperator-  transformationWithoutArgs = patternTransformationWithoutArgs-  transformationWithArgs = patternTransformationWithArgs-  literal = integer+  binaryFunctions = binaryNumFunctions -instance Pattern' Double where-  simplePattern = choice [-    parseBP',-    try $ pure <$> double,-    simpleDoublePatterns-    ]+instance MiniTidal Double where+  literal = double+  simplePattern = parseBP' <|> (try $ pure <$> double) <|> simpleDoublePatterns+  transformationWithArguments = p_p_noArgs+  transformationWithoutArguments = p_p   complexPattern = (atom <*> double) <|> enumComplexPatterns <|> numComplexPatterns   mergeOperator = numMergeOperator <|> fractionalMergeOperator-  transformationWithoutArgs = patternTransformationWithoutArgs-  transformationWithArgs = patternTransformationWithArgs-  literal = double+  binaryFunctions = binaryNumFunctions -instance Pattern' Time where-  simplePattern = choice [-    parseBP',-    pure <$> literal-    ]+instance MiniTidal Time where+  literal = (toRational <$> double) <|> (fromIntegral <$> integer)+  simplePattern = parseBP' <|> (pure <$> literal)+  transformationWithArguments = p_p_noArgs+  transformationWithoutArguments = p_p   complexPattern = atom <*> literal <|> numComplexPatterns   mergeOperator = numMergeOperator <|> fractionalMergeOperator-  transformationWithoutArgs = patternTransformationWithoutArgs-  transformationWithArgs = patternTransformationWithArgs-  literal = choice [-    toRational <$> double,-    fromIntegral <$> integer-    ]+  binaryFunctions = binaryNumFunctions -instance Pattern' Arc where-  simplePattern = pure <$> literal-  complexPattern = atom <*> literal-  mergeOperator = choice []-  transformationWithoutArgs = patternTransformationWithoutArgs-  transformationWithArgs = patternTransformationWithArgs+instance MiniTidal Arc where   literal = do     xs <- parens (commaSep1 literal)     if length xs == 2 then return (T.Arc (xs!!0) (xs!!1)) else unexpected "Arcs must contain exactly two values"+  simplePattern = pure <$> literal+  transformationWithArguments = p_p_noArgs+  transformationWithoutArguments = p_p+  complexPattern = atom <*> literal+  mergeOperator = parserZero+  binaryFunctions = parserZero -instance Pattern' String where+instance MiniTidal String where+  literal = stringLiteral   simplePattern = parseBP'+  transformationWithArguments = p_p_noArgs+  transformationWithoutArguments = p_p   complexPattern = atom <*> stringLiteral-  mergeOperator = choice [] -- ??-  transformationWithoutArgs = patternTransformationWithoutArgs-  transformationWithArgs = patternTransformationWithArgs-  literal = stringLiteral+  mergeOperator = parserZero+  binaryFunctions = parserZero  fractionalMergeOperator :: Fractional a => Parser (Pattern a -> Pattern a -> Pattern a) fractionalMergeOperator = op "/" >> return (/)@@ -351,6 +500,24 @@   op "*" >> return (*)   ] +enumComplexPatterns :: (Enum a, Num a, MiniTidal a) => Parser (Pattern a)+enumComplexPatterns = choice [+  (function "run" >> return T.run) <*> patternArg,+  (function "scan" >> return T.scan) <*> patternArg+  ]++numComplexPatterns :: (Num a, MiniTidal a) => Parser (Pattern a)+numComplexPatterns = choice [+  (function "irand" >> return T.irand) <*> literal,+  (function "toScale'" >> return T.toScale') <*> literalArg <*> listLiteralArg <*> patternArg,+  (function "toScale" >> return T.toScale) <*> listLiteralArg <*> patternArg+  ]++intComplexPatterns :: Parser (Pattern Int)+intComplexPatterns = choice [+  (function "randStruct" >> return T.randStruct) <*> literalArg+  ]+ atom :: Applicative m => Parser (a -> m a) atom = (function "pure" <|> function "atom" <|> function "return") >> return (pure) @@ -393,8 +560,7 @@     "append","append'","silence","s","sound","n","up","speed","vowel","pan","shape","gain",     "accelerate","bandf","bandq","begin","coarse","crush","cut","cutoff","delayfeedback",     "delaytime","delay","end","hcutoff","hresonance","loop","resonance","shape","unit",-    "sine","saw","isaw","fit","irand",-    "tri","square","rand",+    "sine","saw","isaw","fit","irand","tri","square","rand",     "pure","return","stack","fastcat","slowcat","cat","atom","overlay","run","scan","fast'",     "fastGap","densityGap","sparsity","rotL","rotR","playFor","every'","foldEvery",     "cosine","superimpose","trunc","linger","zoom","compress","sliceArc","within","within'",@@ -406,7 +572,7 @@     "someCycles","somecycles","substruct'","repeatCycles","spaceOut","fill","ply","shuffle",     "scramble","breakUp","degrade","randcat","randStruct","toScale'","toScale","cycleChoose",     "d1","d2","d3","d4","d5","d6","d7","d8","d9","t1","t2","t3","t4","t5","t6","t7","t8","t9",-    "cps","xfadeIn","note"],+    "cps","xfadeIn","note","spread","slowspread","fastspread"],   P.reservedOpNames = ["+","-","*","/","<~","~>","#","|+|","|-|","|*|","|/|","$","\"","|>","<|","|>|","|<|"]   } @@ -545,3 +711,18 @@   forever $ do     cmd <- miniTidalIO tidal <$> getLine     either (\x -> putStrLn $ "error: " ++ show x) id cmd++-- things whose status in new tidal we are unsure of+--(function "within'" >> return T.within') <*> literalArg <*> transformationArg,+-- (function "revArc" >> return T.revArc) <*> literalArg,+--  (function "prr" >> return T.prr) <*> literalArg <*> literalArg <*> patternArg,+--  (function "preplace" >> return T.preplace) <*> literalArg <*> patternArg,+--  (function "prep" >> return T.prep) <*> literalArg <*> patternArg,+--  (function "preplace1" >> return T.preplace1) <*> patternArg,+--  (function "protate" >> return T.protate) <*> literalArg <*> literalArg,+--  (function "prot" >> return T.prot) <*> literalArg <*> literalArg,+--  (function "prot1" >> return T.prot1) <*> literalArg,+--  (function "fill" >> return T.fill) <*> patternArg,+--function "struct" >> return T.struct,+--  (function "sliceArc" >> return T.sliceArc) <*> literalArg+--  function "breakUp" >> return T.breakUp, -- removed from new Tidal?

@@ -358,6 +358,33 @@ phaserrate = pF "phaserrate" phaserdepth = pF "phaserdepth" +-- More SuperDirt effects+-- frequency shifter+fshift, fshiftphase, fshiftnote :: Pattern Double -> ControlPattern+fshift = pF "fshift"+fshiftphase = pF "fshiftphase"+fshiftnote = pF "fshiftnote"+-- triode (tube distortion)+triode :: Pattern Double -> ControlPattern+triode = pF "triode"+-- krush (like Sonic Pi's shape/bass enhancer)+krush, kcutoff :: Pattern Double -> ControlPattern+krush = pF "krush"+kcutoff = pF "kcutoff"+-- octer (like Sonic Pi's octaver effect)+octer, octersub, octersubsub :: Pattern Double -> ControlPattern+octer = pF "octer"+octersub = pF "octersub"+octersubsub = pF "octersubsub"+-- ring modulation+ring, ringf, ringdf :: Pattern Double -> ControlPattern+ring = pF "ring"+ringf = pF "ringf"+ringdf = pF "ringdf"+-- noisy fuzzy distortion+distort :: Pattern Double -> ControlPattern+distort = pF "distort"+ -- aliases att, bpf, bpq, chdecay, ctf, ctfg, delayfb, delayt, det, gat, hg, hpf, hpq, lag, lbd, lch, lcl, lcp, lcr, lfoc, lfoi    , lfop, lht, llt, loh, lpf, lpq, lsn, ohdecay, phasdp, phasr, pit1, pit2, pit3, por, rel, sz, sag, scl, scp

@@ -359,10 +359,15 @@                do c <- parseChord                   return $ TPat_Stack $ map TPat_Atom c -parseChord :: Num a => Parser [a]+parseChord :: (Enum a, Num a) => Parser [a] parseChord = do char '\''                 name <- many1 $ letter <|> digit-                return $ fromMaybe [0] $ lookup name chordTable+                let chord = fromMaybe [0] $ lookup name chordTable+                do char '\''+                   i <- integer <?> "chord range"+                   let chord' = take (fromIntegral i) $ concatMap (\x -> map (+ x) chord) [0,12..]+                   return $ chord'+                  <|> return chord  parseNote :: Num a => Parser a parseNote = do n <- notenum

@@ -212,7 +212,7 @@  -- | Also known as Continuous vs Discrete/Amorphous vs Pulsating etc. data Nature = Analog | Digital-            deriving Eq+            deriving (Eq, Show)  -- | A datatype that's basically a query, plus a hint about whether its events -- are Analogue or Digital by nature

@@ -3,10 +3,11 @@  module Sound.Tidal.Stream where +import           Control.Applicative ((<|>)) import           Control.Concurrent.MVar import           Control.Concurrent import qualified Data.Map.Strict as Map-import           Data.Maybe (fromJust, fromMaybe)+import           Data.Maybe (fromJust, fromMaybe, isJust, catMaybes) import qualified Control.Exception as E -- import Control.Monad.Reader -- import Control.Monad.Except@@ -23,7 +24,7 @@ -- import qualified Sound.OSC.Datum as O  data TimeStamp = BundleStamp | MessageStamp | NoStamp- deriving Eq+ deriving (Eq, Show)  data Stream = Stream {sConfig :: Config,                       sInput :: MVar ControlMap,@@ -32,13 +33,17 @@                       sPMapMV :: MVar PlayMap,                       sTempoMV :: MVar T.Tempo,                       sGlobalFMV :: MVar (ControlPattern -> ControlPattern),-                      sTarget :: OSCTarget,-                      sUDP :: O.UDP+                      sCxs :: [Cx]                      }  type PatId = String -data OSCTarget = OSCTarget {oAddress :: String,+data Cx = Cx {cxTarget :: OSCTarget,+              cxUDP :: O.UDP+             }++data OSCTarget = OSCTarget {oName :: String,+                            oAddress :: String,                             oPort :: Int,                             oPath :: String,                             oShape :: Maybe [(String, Maybe Value)],@@ -46,9 +51,11 @@                             oPreamble :: [O.Datum],                             oTimestamp :: TimeStamp                            }+                 deriving Show  superdirtTarget :: OSCTarget-superdirtTarget = OSCTarget {oAddress = "127.0.0.1",+superdirtTarget = OSCTarget {oName = "SuperDirt",+                             oAddress = "127.0.0.1",                              oPort = 57120,                              oPath = "/play2",                              oShape = Nothing,@@ -57,12 +64,61 @@                              oTimestamp = BundleStamp                             } -startStream :: Config -> MVar ControlMap -> OSCTarget -> IO (MVar ControlPattern, MVar T.Tempo, O.UDP)-startStream config cMapMV target-  = do u <- O.openUDP (oAddress target) (oPort target)+dirtTarget :: OSCTarget+dirtTarget = OSCTarget {oName = "Dirt",+                        oAddress = "127.0.0.1",+                        oPort = 7771,+                        oPath = "/play",+                        oShape = Just [("sec", Just $ VI 0),+                                       ("usec", Just $ VI 0),+                                       ("cps", Just $ VF 0),+                                       ("s", Nothing),+                                       ("offset", Just $ VF 0),+                                       ("begin", Just $ VF 0),+                                       ("end", Just $ VF 1),+                                       ("speed", Just $ VF 1),+                                       ("pan", Just $ VF 0.5),+                                       ("velocity", Just $ VF 0.5),+                                       ("vowel", Just $ VS ""),+                                       ("cutoff", Just $ VF 0),+                                       ("resonance", Just $ VF 0),+                                       ("accelerate", Just $ VF 0),+                                       ("shape", Just $ VF 0),+                                       ("kriole", Just $ VI 0),+                                       ("gain", Just $ VF 1),+                                       ("cut", Just $ VI 0),+                                       ("delay", Just $ VF 0),+                                       ("delaytime", Just $ VF (-1)),+                                       ("delayfeedback", Just $ VF (-1)),+                                       ("crush", Just $ VF 0),+                                       ("coarse", Just $ VI 0),+                                       ("hcutoff", Just $ VF 0),+                                       ("hresonance", Just $ VF 0),+                                       ("bandf", Just $ VF 0),+                                       ("bandq", Just $ VF 0),+                                       ("unit", Just $ VS "rate"),+                                       ("loop", Just $ VF 0),+                                       ("n", Just $ VF 0),+                                       ("attack", Just $ VF (-1)),+                                       ("hold", Just $ VF 0),+                                       ("release", Just $ VF (-1)),+                                       ("orbit", Just $ VI 0)+                                      ],+                         oLatency = 0.02,+                         oPreamble = [],+                         oTimestamp = MessageStamp+                       }++startStream :: Config -> MVar ControlMap -> [OSCTarget] -> IO (MVar ControlPattern, MVar T.Tempo, [Cx])+startStream config cMapMV targets+  = do cxs <- mapM (\target -> do u <- O.openUDP (oAddress target) (oPort target)+                                  return $ Cx {cxUDP = u,+                                               cxTarget = target+                                              }+                   ) targets        pMV <- newMVar empty-       (tempoMV, _) <- T.clocked config $ onTick config cMapMV pMV target u-       return $ (pMV, tempoMV, u)+       (tempoMV, _) <- T.clocked config $ onTick config cMapMV pMV cxs+       return $ (pMV, tempoMV, cxs)   data PlayState = PlayState {pattern :: ControlPattern,@@ -74,25 +130,37 @@  type PlayMap = Map.Map PatId PlayState - toDatum :: Value -> O.Datum toDatum (VF x) = O.float x toDatum (VI x) = O.int32 x toDatum (VS x) = O.string x -toData :: Event ControlMap -> [O.Datum]-toData e = concatMap (\(n,v) -> [O.string n, toDatum v]) $ Map.toList $ value e+toData :: OSCTarget -> Event ControlMap -> Maybe [O.Datum]+toData target e+  | isJust (oShape target) = fmap (fmap toDatum) $ sequence $ map (\(n,v) -> Map.lookup n (value e) <|> v) (fromJust $ oShape target)+  | otherwise = Just $ concatMap (\(n,v) -> [O.string n, toDatum v]) $ Map.toList $ value e -toMessage :: OSCTarget -> T.Tempo -> Event (Map.Map String Value) -> O.Message-toMessage target tempo e = O.Message (oPath target) $ oPreamble target ++ toData addCps+toMessage :: Double -> OSCTarget -> T.Tempo -> Event (Map.Map String Value) -> Maybe O.Message+toMessage t target tempo e = do vs <- toData target addExtra+                                return $ O.Message (oPath target) $ oPreamble target ++ vs   where on = sched tempo $ start $ whole e         off = sched tempo $ stop $ whole e         delta = off - on+        messageStamp = oTimestamp target == MessageStamp         -- If there is already cps in the event, the union will preserve that.-        addCps = (\v -> (Map.union v $ Map.fromList [("cps", (VF $ T.cps tempo)),-                                                     ("delta", VF delta),-                                                     ("cycle", VF (fromRational $ start $ whole e))-                                                    ])) <$> e+        addExtra = (\v -> (Map.union v $ Map.fromList (extra messageStamp)+                          )) <$> e+        extra False = [("cps", (VF $ T.cps tempo)),+                       ("delta", VF delta),+                       ("cycle", VF (fromRational $ start $ whole e))+                      ]+        extra True = timestamp ++ (extra False)+        timestamp = [("sec", VI sec),+                     ("usec", VI usec)+                    ]+        ut = O.ntpr_to_ut t+        sec = floor ut+        usec = floor $ 1000000 * (ut - (fromIntegral sec))  doCps :: MVar T.Tempo -> (Double, Maybe Value) -> IO () doCps tempoMV (d, Just (VF cps)) = do _ <- forkIO $ do threadDelay $ floor $ d * 1000000@@ -102,8 +170,8 @@                                       return () doCps _ _ = return () -onTick :: Config -> MVar ControlMap -> MVar ControlPattern -> OSCTarget -> O.UDP -> MVar T.Tempo -> T.State -> IO ()-onTick config cMapMV pMV target u tempoMV st =+onTick :: Config -> MVar ControlMap -> MVar ControlPattern -> [Cx] -> MVar T.Tempo -> T.State -> IO ()+onTick config cMapMV pMV cxs tempoMV st =   do p <- readMVar pMV      cMap <- readMVar cMapMV      tempo <- readMVar tempoMV@@ -111,18 +179,27 @@      let es = filter eventHasOnset $ query p (State {arc = T.nowArc st, controls = cMap})          on e = (sched tempo $ start $ whole e) + eventNudge e          eventNudge e = fromJust $ getF $ fromMaybe (VF 0) $ Map.lookup "nudge" $ value e-         messages = map (\e -> (on e, toMessage target tempo e)) es+         messages target = catMaybes $ map (\e -> do m <- toMessage (on e + latency target) target tempo e+                                                     return $ (on e, m)+                                           ) es          cpsChanges = map (\e -> (on e - now, Map.lookup "cps" $ value e)) es-         latency = oLatency target + cFrameTimespan config + T.nudged tempo-     E.catch (mapM_ (send latency u) messages)-       (\(_ ::E.SomeException)-        -> putStrLn $ "Failed to send. Is the target (probably superdirt) running?")-                -- ++ show (msg :: E.SomeException))+         latency target = oLatency target + cFrameTimespan config + T.nudged tempo+     mapM_ (\(Cx target udp) -> E.catch (mapM_ (send target (latency target) udp) (messages target))+                       (\(_ ::E.SomeException)+                        -> putStrLn $ "Failed to send. Is the '" ++ oName target ++ "' target running?"+                       )+           ) cxs      mapM_ (doCps tempoMV) cpsChanges      return () -send :: O.Transport t => Double -> t -> (Double, O.Message) -> IO ()-send latency u (time, m) = O.sendBundle u $ O.Bundle (time + latency) [m]+send :: O.Transport t => OSCTarget -> Double -> t -> (Double, O.Message) -> IO ()+send target latency u (time, m)+  | oTimestamp target == BundleStamp = O.sendBundle u $ O.Bundle (time + latency) [m]+  | oTimestamp target == MessageStamp = O.sendMessage u m+  | otherwise = do _ <- forkIO $ do now <- O.time+                                    threadDelay $ floor $ ((time+latency) - now) * 1000000+                                    O.sendMessage u m+                   return ()  sched :: T.Tempo -> Rational -> Double sched tempo c = ((fromRational $ c - (T.atCycle tempo)) / T.cps tempo) + (T.atTime tempo)@@ -185,9 +262,8 @@   = do cMap <- readMVar (sInput st)        tempo <- readMVar (sTempoMV st)        now <- O.time-       let target = if asap-                    then (sTarget st) {oLatency = 0}-                    else sTarget st+       let latency target | asap = 0+                          | otherwise = oLatency target            fakeTempo = T.Tempo {T.cps = T.cps tempo,                                 T.atCycle = 0,                                 T.atTime = now,@@ -201,10 +277,16 @@            at e = sched fakeTempo $ start $ whole e            on e = sched tempo $ start $ whole e            cpsChanges = map (\e -> (on e - now, Map.lookup "cps" $ value e)) es-           messages = map (\e -> (at e, toMessage target fakeTempo e)) es-       E.catch (mapM_ (send (oLatency target) (sUDP st)) messages)-         (\(msg ::E.SomeException)-          -> putStrLn $ "Failed to send. Is the target (probably superdirt) running? " ++ show (msg :: E.SomeException))+           messages target =+             catMaybes $ map (\e -> do m <- toMessage (at e + (latency target)) target fakeTempo e+                                       return $ (at e, m)+                             ) es+       mapM_ (\(Cx target udp) ->+                 E.catch (mapM_ (send target (oLatency target) udp) (messages target))+                 (\(_ ::E.SomeException)+                   -> putStrLn $ "Failed to send. Is the '" ++ oName target ++ "' target running?"+                 )+             ) (sCxs st)        mapM_ (doCps $ sTempoMV st) cpsChanges        return () @@ -249,10 +331,13 @@                                        ) (Map.elems pMap)  startTidal :: OSCTarget -> Config -> IO Stream-startTidal target config =+startTidal target config = startMulti [target] config++startMulti :: [OSCTarget] -> Config -> IO Stream+startMulti targets config =   do cMapMV <- newMVar (Map.empty :: ControlMap)      listenTid <- ctrlListen cMapMV config-     (pMV, tempoMV, u) <- startStream config cMapMV target+     (pMV, tempoMV, cxs) <- startStream config cMapMV targets      pMapMV <- newMVar Map.empty      globalFMV <- newMVar id      return $ Stream {sConfig = config,@@ -262,8 +347,7 @@                       sPMapMV = pMapMV,                       sTempoMV = tempoMV,                       sGlobalFMV = globalFMV,-                      sTarget = target,-                      sUDP = u+                      sCxs = cxs                      }  ctrlListen :: MVar ControlMap -> Config -> IO (Maybe ThreadId)

@@ -16,7 +16,7 @@ import Sound.Tidal.Pattern import Sound.Tidal.Stream import Sound.Tidal.Tempo (timeToCycles)-import Sound.Tidal.UI (fadeOutFrom, fadeInFrom, spread')+import Sound.Tidal.UI (fadeOutFrom, fadeInFrom) import Sound.Tidal.Utils (enumerate)  -- Evaluation of pat is forced so exceptions are picked up here, before replacing the existing pattern.@@ -177,7 +177,7 @@ t1 (anticipateIn 4) $ sound "jvbass(5,8)" @-} anticipateIn :: Time -> Time -> [ControlPattern] -> ControlPattern-anticipateIn t now pats = washIn (spread' (_stut 8 0.2) (now `rotR` (_slow t $ (toRational . (1-)) <$> envL))) t now pats+anticipateIn t now pats = washIn (innerJoin . (\pat -> (\v -> _stut 8 0.2 v pat) <$> (now `rotR` (_slow t $ toRational <$> envLR)))) t now pats  -- wash :: (Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Time -> Time -> Time -> Time -> [Pattern a] -> Pattern a 

@@ -78,7 +78,7 @@ samples from a folder:  @-d1 $ n (irand 5) # sound "drum"+d1 $ segment 4 $ n (irand 5) # sound "drum" @ -} irand :: Num a => Int -> Pattern a@@ -364,26 +364,20 @@  -- | Degrades a pattern over the given time. fadeOut :: Time -> Pattern a -> Pattern a-fadeOut dur p = do slope <- _slow dur envL-                   _degradeBy slope p+fadeOut dur p = innerJoin $ (\slope -> _degradeBy slope p) <$> (_slow dur envL)  -- | Alternate version to @fadeOut@ where you can provide the time from which the fade starts fadeOutFrom :: Time -> Time -> Pattern a -> Pattern a-fadeOutFrom from dur p = do slope <- (from `rotR` _slow dur envL)-                            _degradeBy slope p-+fadeOutFrom from dur p = innerJoin $ (\slope -> _degradeBy slope p) <$> (from `rotR` _slow dur envL)  -- | 'Undegrades' a pattern over the given time. fadeIn :: Time -> Pattern a -> Pattern a-fadeIn dur p = do slope <- _slow dur ((1-) <$> envL)-                  _degradeBy slope p+fadeIn dur p = innerJoin $ (\slope -> _degradeBy slope p) <$> (_slow dur envLR)  -- | Alternate version to @fadeIn@ where you can provide the time from -- which the fade in starts fadeInFrom :: Time -> Time -> Pattern a -> Pattern a-fadeInFrom from dur p = do slope <- (from `rotR` _slow dur ((1-) <$> envL))-                           _degradeBy slope p-+fadeInFrom from dur p = innerJoin $ (\slope -> _degradeBy slope p) <$> (from `rotR` _slow dur envLR)  {- | The 'spread' function allows you to take a pattern transformation which takes a parameter, such as `slow`, and provide several@@ -1288,6 +1282,50 @@ -- | Shorthand alias for arpeggiate arpg :: Pattern a -> Pattern a arpg = arpeggiate+++arpWith :: ([EventF (ArcF Time) a] -> [EventF (ArcF Time) b]) -> Pattern a -> Pattern b+arpWith f p = withEvents munge p+  where munge es = concatMap (spreadOut . f) (groupBy (\a b -> whole a == whole b) es)+        spreadOut xs = mapMaybe (\(n, x) -> shiftIt n (length xs) x) $ enumerate xs+        shiftIt n d (Event (Arc s e) a' v) =+          do+            a'' <- subArc (Arc newS newE) a'+            return (Event (Arc newS newE) a'' v)+          where newS = s + (dur*(fromIntegral n))+                newE = newS + dur+                dur = (e - s) / (fromIntegral d)++arp :: Pattern String -> Pattern a -> Pattern a+arp = tParam _arp++_arp :: String -> Pattern a -> Pattern a+_arp name p = arpWith f p+  where f = fromMaybe id $ lookup name arps+        arps :: [(String, [a] -> [a])]+        arps = [("up", id),+                ("down", reverse),+                ("updown", \x -> init x ++ init (reverse x)),+                ("downup", \x -> init (reverse x) ++ init x),+                ("up&down", \x -> x ++ reverse x),+                ("down&up", \x -> reverse x ++ x),+                ("converge", converge),+                ("diverge", reverse . converge),+                ("disconverge", \x -> converge x ++ (tail $ reverse $ converge x)),+                ("pinkyup", pinkyup),+                ("pinkyupdown", \x -> init (pinkyup x) ++ init (reverse $ pinkyup x)),+                ("thumbup", thumbup),+                ("thumbupdown", \x -> init (thumbup x) ++ init (reverse $ thumbup x))+               ]+        converge [] = []+        converge (x:xs) = x:(converge' xs)+        converge' [] = []+        converge' xs = (last xs):(converge $ init xs)+        pinkyup xs = concatMap (:[pinky]) $ init xs+          where pinky = last xs+        thumbup xs = concatMap (\x -> [thumb,x]) $ tail xs+          where thumb = head xs+  {- TODO ! 

@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}++module Sound.Tidal.ControlTest where++import TestUtils+import Test.Microspec++import Prelude hiding ((<*), (*>))++import qualified Data.Map.Strict as Map++-- import Sound.Tidal.Pattern+import Sound.Tidal.Control+import Sound.Tidal.Core+import Sound.Tidal.Params+import Sound.Tidal.Pattern+import Sound.Tidal.UI++run :: Microspec ()+run =+  describe "Sound.Tidal.Control" $ do+    describe "stutWith" $ do+      it "can mimic stut" $ do+        comparePD (Arc 0 1)+          (stutWith 4 0.25 (# gain 1) $ sound "bd")+          (stut 4 1 0.25 $ sound "bd")+        

@@ -134,3 +134,8 @@         comparePD (Arc 0 1)           (struct "t*8" $ (tri :: Pattern Double) + 1)           ("1 1.25 1.5 1.75 2 1.75 1.5 1.25")+    describe "every" $ do+      it "`every n id` doesn't change the pattern's structure" $ do+        comparePD (Arc 0 4)+          (every 2 id $ "x/2" :: Pattern String)+          ("x/2")

@@ -133,3 +133,15 @@     it "parses a fast transformation applied to a simple (ie. non-param) pattern" $       "up (fast 2 \"<0 2 3 5>\")" `parsesTo`         (up (fast 2 "<0 2 3 5>"))++    it "parses a binary Num function spread over a simple Num pattern" $+      "n (spread (+) [2,3,4] \"1 2 3\")" `parsesTo`+        (n (spread (+) [2,3,4] "1 2 3"))++    it "parses an $ application spread over partially applied transformations of a non-Control Pattern" $+      "n (spread ($) [density 2, rev, slow 2] $ \"1 2 3 4\")" `parsesTo`+        (n (spread ($) [density 2, rev, slow 2] $ "1 2 3 4"))++    it "parses an $ application spread over partially applied transformations of a Control Pattern" $+      "spread ($) [density 2, rev, slow 2, striate 3] $ sound \"[bd*2 [~ bd]] [sn future]*2 cp jvbass*4\"" `parsesTo`+        (spread ($) [density 2, rev, slow 2, striate 3] $ sound "[bd*2 [~ bd]] [sn future]*2 cp jvbass*4")

@@ -6,6 +6,7 @@ import Sound.Tidal.MiniTidalTest import Sound.Tidal.ParseTest import Sound.Tidal.PatternTest+import Sound.Tidal.ControlTest import Sound.Tidal.UITest import Sound.Tidal.UtilsTest @@ -15,5 +16,6 @@   Sound.Tidal.MiniTidalTest.run   Sound.Tidal.ParseTest.run   Sound.Tidal.PatternTest.run+  Sound.Tidal.ControlTest.run   Sound.Tidal.UITest.run   Sound.Tidal.UtilsTest.run

@@ -1,5 +1,5 @@ name:                tidal-version:             1.0.5+version:             1.0.6 synopsis:            Pattern language for improvised music -- description: homepage:            http://tidalcycles.org/@@ -49,21 +49,15 @@    Build-depends:       base < 5-    , containers-    , hashable-    , colour-    , hosc == 0.17-    , text-    , random-    , time-    , parsec-    , safe-    , mtl >= 2.1-    , monad-loops-    , network-    , mwc-random-    , vector-    , bifunctors+    , containers < 0.7+    , colour < 2.4+    , hosc < 0.18+    , text < 1.3+    , parsec < 3.2+    , network < 2.9+    , mwc-random < 0.15+    , vector < 0.13+    , bifunctors < 5.6    if !impl(ghc >= 8.4.1)     build-depends: semigroups == 0.18.*@@ -74,7 +68,8 @@   hs-source-dirs:       test   ghc-options: -Wall-  other-modules: Sound.Tidal.CoreTest+  other-modules: Sound.Tidal.ControlTest+                 Sound.Tidal.CoreTest                  Sound.Tidal.MiniTidalTest                  Sound.Tidal.ParseTest                  Sound.Tidal.PatternTest

@@ -54,8 +54,7 @@   "*The version of tidal interpreter as a string.")  (defvar tidal-interpreter-arguments-  (list "-XOverloadedStrings"-        )+  ()   "*Arguments to the haskell interpreter (default=none).")  (defvar tidal-literate-p@@ -92,8 +91,9 @@   (if (string< tidal-interpreter-version "8.2.0")       (tidal-send-string ":set prompt2 \"\"")     (tidal-send-string ":set prompt-cont \"\""))-  (tidal-send-string "import Sound.Tidal.Context-tidal <- startTidal (superdirtTarget {oLatency = 0.1, oAddress = \"127.0.0.1\", oPort = 57120}) (defaultConfig {cFrameTimespan = 1/20})+  (tidal-send-string ":set -XOverloadedStrings+import Sound.Tidal.Context+tidal <- startMulti [superdirtTarget {oLatency = 0.1, oAddress = \"127.0.0.1\", oPort = 57120}] (defaultConfig {cFrameTimespan = 1/20, cCtrlListen = True}) let p = streamReplace tidal     hush = streamHush tidal     list = streamList tidal@@ -107,31 +107,31 @@     all = streamAll tidal     resetCycles = streamResetCycles tidal     setcps = asap . cps-    xfade = transition tidal (Sound.Tidal.Transition.xfadeIn 4)-    xfadeIn t = transition tidal (Sound.Tidal.Transition.xfadeIn t)-    histpan t = transition tidal (Sound.Tidal.Transition.histpan t)-    wait t = transition tidal (Sound.Tidal.Transition.wait t)-    waitT f t = transition tidal (Sound.Tidal.Transition.waitT f t)-    jump = transition tidal (Sound.Tidal.Transition.jump)-    jumpIn t = transition tidal (Sound.Tidal.Transition.jumpIn t)-    jumpIn' t = transition tidal (Sound.Tidal.Transition.jumpIn' t)-    jumpMod t = transition tidal (Sound.Tidal.Transition.jumpMod t)-    mortal lifespan release = transition tidal (Sound.Tidal.Transition.mortal lifespan release)-    interpolate = transition tidal (Sound.Tidal.Transition.interpolate)-    interpolateIn t = transition tidal (Sound.Tidal.Transition.interpolateIn t)-    clutch = transition tidal (Sound.Tidal.Transition.clutch)-    clutchIn t = transition tidal (Sound.Tidal.Transition.clutchIn t)-    anticipate = transition tidal (Sound.Tidal.Transition.anticipate)-    anticipateIn t = transition tidal (Sound.Tidal.Transition.anticipateIn t)+    xfade i = transition tidal (Sound.Tidal.Transition.xfadeIn 4) i+    xfadeIn i t = transition tidal (Sound.Tidal.Transition.xfadeIn t) i+    histpan i t = transition tidal (Sound.Tidal.Transition.histpan t) i+    wait i t = transition tidal (Sound.Tidal.Transition.wait t) i+    waitT i f t = transition tidal (Sound.Tidal.Transition.waitT f t) i+    jump i = transition tidal (Sound.Tidal.Transition.jump) i+    jumpIn i t = transition tidal (Sound.Tidal.Transition.jumpIn t) i+    jumpIn' i t = transition tidal (Sound.Tidal.Transition.jumpIn' t) i+    jumpMod i t = transition tidal (Sound.Tidal.Transition.jumpMod t) i+    mortal i lifespan release = transition tidal (Sound.Tidal.Transition.mortal lifespan release) i+    interpolate i = transition tidal (Sound.Tidal.Transition.interpolate) i+    interpolateIn i t = transition tidal (Sound.Tidal.Transition.interpolateIn t) i+    clutch i = transition tidal (Sound.Tidal.Transition.clutch) i+    clutchIn i t = transition tidal (Sound.Tidal.Transition.clutchIn t) i+    anticipate i = transition tidal (Sound.Tidal.Transition.anticipate) i+    anticipateIn i t = transition tidal (Sound.Tidal.Transition.anticipateIn t) i     d1 = p 1-    d2 = p 2-    d3 = p 3-    d4 = p 4-    d5 = p 5-    d6 = p 6-    d7 = p 7-    d8 = p 8-    d9 = p 9+    d2 = p 2 -- . (|< orbit 1)+    d3 = p 3 -- . (|< orbit 2)+    d4 = p 4 -- . (|< orbit 3)+    d5 = p 5 -- . (|< orbit 4)+    d6 = p 6 -- . (|< orbit 5)+    d7 = p 7 -- . (|< orbit 6)+    d8 = p 8 -- . (|< orbit 7)+    d9 = p 9 -- . (|< orbit 8)     d10 = p 10     d11 = p 11     d12 = p 12