tidal 0.9.6 → 0.9.7
raw patch · 8 files changed
+143/−69 lines, 8 filesdep +semigroupsdep ~basedep ~tasty
Dependencies added: semigroups
Dependency ranges changed: base, tasty
Files
- CHANGELOG.md +10/−1
- Sound/Tidal/Params.hs +35/−8
- Sound/Tidal/Parse.hs +32/−20
- Sound/Tidal/Pattern.hs +48/−31
- Sound/Tidal/Scales.hs +3/−3
- tests/test.hs +2/−2
- tidal.cabal +6/−3
- tidal.el +7/−1
CHANGELOG.md view
@@ -1,10 +1,19 @@ # TidalCycles log of changes -## 0.96+## 0.9.7 ### Enhancements +* The `note` pattern parameter is no longer an alias for `midinote`,+ but an independent parameter for supercollider to handle (in a manner+ similar to `up`)+ +## 0.9.6++### Enhancements+ * Added `chord` for chord patterns and `scaleP` for scale patterns+* The `n` pattern parameter is now floating point ## 0.9.5
Sound/Tidal/Params.hs view
@@ -66,7 +66,7 @@ (attack, attack_p) = pF "attack" (Just (-1)) -- | a pattern of numbers from 0 to 1. Sets the center frequency of the band-pass filter. (bandf, bandf_p) = pF "bandf" (Just 0)--- | a pattern of numbers from 0 to 1. Sets the q-factor of the band-pass filter.+-- | a pattern of numbers from 0 to 1. Sets the q-factor of the band-pass filter.y (bandq, bandq_p) = pF "bandq" (Just 0) {- | a pattern of numbers from 0 to 1. Skips the beginning of each sample, e.g. `0.25` to cut off the first quarter from each sample. @@ -174,8 +174,9 @@ (loop, loop_p) = pF "loop" (Just 1) (lophat, lophat_p) = pF "lophat" (Just 0) (lsnare, lsnare_p) = pF "lsnare" (Just 0)--- | specifies the sample variation to be used-(n, n_p) = pI "n" (Just 0)+-- | specifies the sample or note number to be used+(n, n_p) = pF "n" (Just 0)+(note, note_p) = pF "note" (Just 0) {- | Pushes things forward (or backwards within built-in latency) in time. Allows for nice things like _swing_ feeling: @@ -340,14 +341,13 @@ vco = vcoegint voi = voice -note, midinote :: Pattern Int -> ParamPattern-note = n-midinote = n . ((subtract 60) <$>)+midinote :: Pattern Double -> ParamPattern+midinote = note . ((subtract 60) <$>) drum :: Pattern String -> ParamPattern-drum = midinote . (drumN <$>)+drum = n . ((subtract 60) . drumN <$>) -drumN :: String -> Int+drumN :: Num a => String -> a drumN "bd" = 36 drumN "sn" = 38 drumN "lt" = 43@@ -359,3 +359,30 @@ drumN "ag" = 67 drumN "cr" = 49 drumN _ = 0+++-- SuperDirt MIDI Params++(array, array_p) = pF "array" Nothing+(midichan, midichan_p) = pF "midichan" Nothing+(control, control_p) = pF "control" Nothing++(ccn, ccn_p) = pF "ccn" Nothing+(ccv, ccv_p) = pF "ccv" Nothing+cc = grp [ccn_p, ccv_p]++(ctlNum, ctlNum_p) = pF "ctlNum" Nothing++(frameRate, frameRate_p) = pF "frameRate" Nothing+(frames, frames_p) = pF "frames" Nothing+(hours, hours_p) = pF "hours" Nothing++(midicmd, midicmd_p) = pS "midicmd" Nothing+command = midicmd++(minutes, minutes_p) = pF "minutes" Nothing+(progNum, progNum_p) = pF "progNum" Nothing+(seconds, seconds_p) = pF "seconds" Nothing+(songPtr, songPtr_p) = pF "songPtr" Nothing+(uid, uid_p) = pF "uid" Nothing+(val, val_p) = pF "val" Nothing
Sound/Tidal/Parse.hs view
@@ -12,6 +12,7 @@ import Data.Colour.SRGB import GHC.Exts( IsString(..) ) import Data.Monoid+import qualified Data.Semigroup as Sem import Control.Exception as E import Control.Applicative ((<$>), (<*>), pure) import Data.Maybe@@ -23,8 +24,8 @@ -- | AST representation of patterns data TPat a = TPat_Atom a- | TPat_Density Time (TPat a)- | TPat_Slow Time (TPat a)+ | TPat_Density (TPat Time) (TPat a)+ | TPat_Slow (TPat Time) (TPat a) | TPat_Zoom Arc (TPat a) | TPat_DegradeBy Double (TPat a) | TPat_Silence@@ -39,15 +40,18 @@ | TPat_pE (TPat Int) (TPat Int) (TPat Integer) (TPat a) deriving (Show) +instance Sem.Semigroup (TPat a) where+ (<>) = TPat_Overlay+ instance Parseable a => Monoid (TPat a) where mempty = TPat_Silence- mappend = TPat_Overlay+ mappend = (<>) -toPat :: Parseable a => TPat a -> Pattern a+toPat :: Enumerable a => TPat a -> Pattern a toPat = \case TPat_Atom x -> atom x- TPat_Density t x -> _density t $ toPat x- TPat_Slow t x -> _slow t $ toPat x+ TPat_Density t x -> density (toPat t) $ toPat x+ TPat_Slow t x -> slow (toPat t) $ toPat x TPat_Zoom arc x -> zoom arc $ toPat x TPat_DegradeBy amt x -> _degradeBy amt $ toPat x TPat_Silence -> silence@@ -67,41 +71,49 @@ durations (a:(TPat_Elongate n):xs) = (n+1,a):(durations xs) durations (a:xs) = (1,a):(durations xs) -p :: Parseable a => String -> Pattern a+p :: (Enumerable a, Parseable a) => String -> Pattern a p = toPat . parseTPat class Parseable a where parseTPat :: String -> TPat a++class Enumerable a where fromTo :: a -> a -> Pattern a fromThenTo :: a -> a -> a -> Pattern a instance Parseable Double where parseTPat = parseRhythm pDouble+instance Enumerable Double where fromTo a b = enumFromTo' a b fromThenTo a b c = enumFromThenTo' a b c instance Parseable String where parseTPat = parseRhythm pVocable+instance Enumerable String where fromTo a b = listToPat [a,b] fromThenTo a b c = listToPat [a,b,c] instance Parseable Bool where parseTPat = parseRhythm pBool+instance Enumerable Bool where fromTo a b = listToPat [a,b] fromThenTo a b c = listToPat [a,b,c] instance Parseable Int where parseTPat = parseRhythm pIntegral+instance Enumerable Int where fromTo a b = enumFromTo' a b fromThenTo a b c = enumFromThenTo' a b c instance Parseable Integer where parseTPat s = parseRhythm pIntegral s+instance Enumerable Integer where fromTo a b = enumFromTo' a b fromThenTo a b c = enumFromThenTo' a b c instance Parseable Rational where parseTPat = parseRhythm pRational+instance Enumerable Rational where fromTo a b = enumFromTo' a b fromThenTo a b c = enumFromThenTo' a b c @@ -115,10 +127,11 @@ instance Parseable ColourD where parseTPat = parseRhythm pColour+instance Enumerable ColourD where fromTo a b = listToPat [a,b] fromThenTo a b c = listToPat [a,b,c] -instance (Parseable a) => IsString (Pattern a) where+instance (Enumerable a, Parseable a) => IsString (Pattern a) where fromString = toPat . parseTPat --instance (Parseable a, Pattern p) => IsString (p a) where@@ -158,15 +171,15 @@ return Positive <|> return Positive -intOrFloat :: Parser (Either Integer Double)+intOrFloat :: Parser Double intOrFloat = do s <- sign num <- naturalOrFloat return (case num of- Right x -> Right (applySign s x)- Left x -> Left (applySign s x)+ Right x -> applySign s x+ Left x -> fromIntegral $ applySign s x ) -r :: Parseable a => String -> Pattern a -> IO (Pattern a)+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 @@ -253,7 +266,7 @@ spaces pMult $ mconcat $ scale (Just 1) ps where scale _ [] = []- scale base (ps@((n,_):_)) = map (\(n',p) -> TPat_Density (fromIntegral (fromMaybe n base)/ fromIntegral n') p) ps+ scale base (ps@((n,_):_)) = map (\(n',p) -> TPat_Density (TPat_Atom $ fromIntegral (fromMaybe n base)/ fromIntegral n') p) ps pString :: Parser (String) pString = do c <- (letter <|> oneOf "0123456789") <?> "charnum"@@ -265,8 +278,7 @@ return $ TPat_Atom v pDouble :: Parser (TPat Double)-pDouble = do nf <- intOrFloat <?> "float"- let f = either fromIntegral id nf+pDouble = do f <- choice [intOrFloat, parseNote] <?> "float" return $ TPat_Atom f pBool :: Parser (TPat Bool)@@ -276,7 +288,7 @@ do oneOf "f0" return $ TPat_Atom False -parseIntNote :: Integral i => Parser i+parseIntNote :: Integral i => Parser i parseIntNote = do s <- sign i <- choice [integer, parseNote] return $ applySign s $ fromIntegral i@@ -289,7 +301,7 @@ pIntegral :: Parseable a => Integral a => Parser (TPat a) pIntegral = TPat_Atom <$> parseIntNote -parseNote :: Integral a => Parser a+parseNote :: Num a => Parser a parseNote = do n <- notenum modifiers <- many noteModifier octave <- option 5 natural@@ -311,7 +323,7 @@ char 'n' >> return 0 ] -fromNote :: Integral c => Pattern String -> Pattern c+fromNote :: Num a => Pattern String -> Pattern a fromNote p = (\s -> either (const 0) id $ parse parseNote "" s) <$> p pColour :: Parser (TPat ColourD)@@ -322,12 +334,12 @@ pMult :: Parseable a => TPat a -> Parser (TPat a) pMult thing = do char '*' spaces- r <- pRatio+ r <- (pRational <|> pPolyIn pRational <|> pPolyOut pRational) return $ TPat_Density r thing <|> do char '/' spaces- r <- pRatio+ r <- (pRational <|> pPolyIn pRational <|> pPolyOut pRational) return $ TPat_Slow r thing <|> return thing
Sound/Tidal/Pattern.hs view
@@ -23,6 +23,7 @@ import Text.Show.Functions () import qualified Control.Exception as E+import qualified Data.Semigroup as Sem -- | The pattern datatype, a function from a time @Arc@ to @Event@ -- values. For discrete patterns, this returns the events which are@@ -161,11 +162,14 @@ (xs (s',e')) ) +-- | @mappend@ a.k.a. @<>@ is a synonym for @overlay@.+instance Sem.Semigroup (Pattern a) where+ (<>) = overlay+ -- | @mempty@ is a synonym for @silence@.--- | @mappend@ is a synonym for @overlay@. instance Monoid (Pattern a) where- mempty = silence- mappend = overlay+ mempty = silence+ mappend = (<>) instance Monad Pattern where return = pure@@ -442,7 +446,7 @@ rev p = splitQueries $ Pattern $ \a -> map makeWholeAbsolute $ mapSnds' (mirrorArc (mid a)) $ map makeWholeRelative (arc p (mirrorArc (mid a) a)) where makeWholeRelative ((s,e), part@(s',e'), v) = ((s'-s, e-e'), part, v) makeWholeAbsolute ((s,e), part@(s',e'), v) = ((s'-e,e'+s), part, v)- mid (s,e) = (sam s) + 0.5+ mid (s,_) = (sam s) + 0.5 -- | @palindrome p@ applies @rev@ to @p@ every other cycle, so that -- the pattern alternates between forwards and backwards.@@ -734,7 +738,7 @@ shorter alias `spreadr`. -} spreadChoose :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b-spreadChoose f vs p = do v <- discretise 1 (choose vs)+spreadChoose f vs p = do v <- _discretise 1 (choose vs) f v p spreadr :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b@@ -1148,7 +1152,30 @@ e' :: Int -> Int -> Pattern a -> Pattern a e' n k p = fastcat $ map (\x -> if x then p else silence) (bjorklund (n,k)) +distrib :: [Int] -> Pattern a -> Pattern a+distrib xs p = boolsToPat (foldr (distrib') (replicate (head $ reverse xs) True) (reverse $ layers xs)) p+ where+ distrib' :: [Bool] -> [Bool] -> [Bool]+ distrib' [] _ = []+ distrib' (_:a) [] = False:(distrib' a [])+ distrib' (True:a) (x:b) = x:(distrib' a b)+ distrib' (False:a) (b) = False:(distrib' a b)+ layers = map bjorklund . (zip<*>tail)+ boolsToPat p p' = (flip const) <$> (filterValues (== True) $ listToPat $ p) <*> p' +{- | `einv` fills in the blanks left by `e`+ -+ @e 3 8 "x"@ -> @"x ~ ~ x ~ ~ x ~"@++ @einv 3 8 "x"@ -> @"~ x x ~ x x ~ x"@+-}+einv :: Int -> Int -> Pattern a -> Pattern a+einv n k p = (flip const) <$> (filterValues (== False) $ listToPat $ bjorklund (n,k)) <*> p++{- | `efull n k pa pb` stacks @e n k pa@ with @einv n k pb@ -}+efull :: Int -> Int -> Pattern a -> Pattern a -> Pattern a+efull n k pa pb = stack [ e n k pa, einv n k pb ]+ index :: Real b => b -> Pattern b -> Pattern c -> Pattern c index sz indexpat pat = spread' (zoom' $ toRational sz) (toRational . (*(1-sz)) <$> indexpat) pat where zoom' sz start = zoom (start, start+sz)@@ -1255,17 +1282,19 @@ -- | @discretise n p@: 'samples' the pattern @p@ at a rate of @n@ -- events per cycle. Useful for turning a continuous pattern into a -- discrete one.- discretise :: Time -> Pattern a -> Pattern a-discretise n p = (_density n $ atom (id)) <*> p+discretise = _discretise -discretise' = discretise-_discretise = discretise+discretise' :: Pattern Time -> Pattern a -> Pattern a+discretise' n p = (density n $ atom (id)) <*> p +_discretise :: Time -> Pattern a -> Pattern a+_discretise n p = (_density n $ atom (id)) <*> p+ -- | @randcat ps@: does a @slowcat@ on the list of patterns @ps@ but -- randomises the order in which they are played. randcat :: [Pattern a] -> Pattern a-randcat ps = spread' (rotL) (discretise 1 $ ((%1) . fromIntegral) <$> (irand (length ps) :: Pattern Int)) (slowcat ps)+randcat ps = spread' (rotL) (_discretise 1 $ ((%1) . fromIntegral) <$> (irand (length ps) :: Pattern Int)) (slowcat ps) -- @fromNote p@: converts a pattern of human-readable pitch names -- into pitch numbers. For example, @"cs2"@ will be parsed as C Sharp@@ -1317,7 +1346,7 @@ where cyclePos perCycle e = perCycle * (floor $ eventStart e) permstep :: RealFrac b => Int -> [a] -> Pattern b -> Pattern a-permstep steps things p = unwrap $ (\n -> listToPat $ concatMap (\x -> replicate (fst x) (snd x)) $ zip (ps !! (floor (n * (fromIntegral $ (length ps - 1))))) things) <$> (discretise 1 p)+permstep steps things p = unwrap $ (\n -> listToPat $ concatMap (\x -> replicate (fst x) (snd x)) $ zip (ps !! (floor (n * (fromIntegral $ (length ps - 1))))) things) <$> (_discretise 1 p) where ps = permsort (length things) steps deviance avg xs = sum $ map (abs . (avg-) . fromIntegral) xs permsort n total = map fst $ sortBy (comparing snd) $ map (\x -> (x,deviance (fromIntegral total / (fromIntegral n :: Double)) x)) $ perms n total@@ -1348,10 +1377,11 @@ where pairUp [] = [] pairUp xs = (0,head xs):(pairUp' xs) pairUp' [] = []- pairUp' (a:[]) = []- pairUp' (a:b:[]) = [(a,1)]+ pairUp' (_:[]) = []+ pairUp' (a:_:[]) = [(a,1)] pairUp' (a:b:xs) = (a,b):(pairUp' (b:xs)) +randStruct :: Int -> Pattern Int randStruct n = splitQueries $ Pattern f where f (s,e) = mapSnds' fromJust $ filter (\(_,x,_) -> isJust x) $ as where as = map (\(n, (s',e')) -> ((s' + sam s, e' + sam s),@@ -1535,12 +1565,12 @@ to change this use `toScale' size`. Example: `toScale' 24 [0,4,7,10,14,17] (run 8)` turns into `"0 4 7 10 14 17 24 28"` -}-toScale' :: Int -> [Int] -> Pattern Int -> Pattern Int+toScale' :: Num a => Int -> [a] -> Pattern Int -> Pattern a toScale' o s = fmap noteInScale where octave x = x `div` length s- noteInScale x = (s !!! x) + o * octave x+ noteInScale x = (s !!! x) + (fromIntegral $ o * octave x) -toScale :: [Int] -> Pattern Int -> Pattern Int+toScale :: Num a => [a] -> Pattern Int -> Pattern a toScale = toScale' 12 {- | `swingBy x n` divides a cycle into `n` slices and delays the notes in@@ -1583,21 +1613,8 @@ scramble n = fit' 1 n (_run n) (_density (fromIntegral n) $ liftA2 (+) (pure 0) $ irand n) -ur :: Time -> Pattern String -> [Pattern a] -> Pattern a-ur t outer_p ps = _slow t $ unwrap $ adjust <$> (timedValues $ (getPat . split) <$> outer_p)- where split s = wordsBy (==':') s- getPat (n:xs) = (ps' !!! read n, transform xs)- ps' = map (_density t) ps- adjust (a, (p, f)) = f a p- transform (x:_) a = transform' x a- transform _ _ = id- transform' "in" (s,e) p = twiddle (fadeIn) (s,e) p- transform' "out" (s,e) p = twiddle (fadeOut) (s,e) p- transform' _ _ p = p- twiddle f (s,e) p = s `rotR` (f (e-s) p)--ur' :: Time -> Pattern String -> [(String, Pattern a)] -> [(String, Pattern a -> Pattern a)] -> Pattern a-ur' t outer_p ps fs = _slow t $ unwrap $ adjust <$> (timedValues $ (getPat . split) <$> outer_p)+ur :: Time -> Pattern String -> [(String, Pattern a)] -> [(String, Pattern a -> Pattern a)] -> Pattern a+ur t outer_p ps fs = _slow t $ unwrap $ adjust <$> (timedValues $ (getPat . split) <$> outer_p) where split s = wordsBy (==':') s getPat (s:xs) = (match s, transform xs) match s = fromMaybe silence $ lookup s ps'
Sound/Tidal/Scales.hs view
@@ -154,10 +154,10 @@ chromatic :: Num a => [a] chromatic = [0,1,2,3,4,5,6,7,8,9,10,11] -scaleP :: Pattern String -> Pattern Int -> Pattern Int+scaleP :: Num a => Pattern String -> Pattern Int -> Pattern a scaleP sp p = (\n scaleName -> noteInScale (fromMaybe [0] $ lookup scaleName scaleTable) n) <$> p <*> sp- where octave s x = x `div` (length s)- noteInScale s x = (s !!! x) + (12 * octave s x)+ where octave s x = x `div` length s+ noteInScale s x = (s !!! x) + (fromIntegral $ 12 * octave s x) scaleTable :: Num a => [(String, [a])] scaleTable = [("minPent", minPent),
tests/test.hs view
@@ -13,8 +13,8 @@ main = defaultMain tests tests :: TestTree-tests = testGroup "Tests" [basic1,- patternsOfPatterns+tests = testGroup "Tests" [basic1+ -- patternsOfPatterns ] basic1 = testGroup "fast / slow"
tidal.cabal view
@@ -1,5 +1,5 @@ name: tidal-version: 0.9.6+version: 0.9.7 synopsis: Pattern language for improvised music -- description: homepage: http://tidalcycles.org/@@ -12,7 +12,7 @@ category: Sound build-type: Simple cabal-version: >=1.10-tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1+tested-with: GHC == 7.10.3, GHC == 8.0.1, GHC == 8.4.1 Extra-source-files: README.md CHANGELOG.md tidal.el doc/tidal.md @@ -55,6 +55,9 @@ , websockets > 0.8 , mtl >= 2.1 + if !impl(ghc >= 8.0)+ build-depends: semigroups == 0.18.*+ source-repository head type: git location: https://github.com/tidalcycles/Tidal@@ -70,6 +73,6 @@ test.hs build-depends: base >= 4 && < 5- , tasty >= 0.11+ , tasty , tasty-hunit , tidal
tidal.el view
@@ -49,6 +49,10 @@ "ghci" "*The haskell interpeter to use (default=ghci).") +(defvar tidal-interpreter-version+ (substring (shell-command-to-string (concat tidal-interpreter " --numeric-version")) 0 -1)+ "*The version of tidal interpreter as a string.")+ (defvar tidal-interpreter-arguments (list "-XOverloadedStrings" )@@ -85,7 +89,9 @@ tidal-interpreter-arguments) (tidal-see-output)) (tidal-send-string ":set prompt \"\"")- (tidal-send-string ":set prompt2 \"\"")+ (if (string< tidal-interpreter-version "8.2.0")+ (tidal-send-string ":set prompt2 \"\"")+ (tidal-send-string ":set prompt-cont \"\"")) (tidal-send-string ":module Sound.Tidal.Context") (tidal-send-string "import qualified Sound.Tidal.Scales as Scales") (tidal-send-string "import qualified Sound.Tidal.Chords as Chords")