tidal 0.9 → 0.9.1
raw patch · 12 files changed
+494/−284 lines, 12 filesdep +applicative-numbersdep ~base
Dependencies added: applicative-numbers
Dependency ranges changed: base
Files
- README.md +1/−1
- Sound/Tidal/Context.hs +2/−0
- Sound/Tidal/Dirt.hs +19/−11
- Sound/Tidal/Params.hs +12/−4
- Sound/Tidal/Parse.hs +21/−14
- Sound/Tidal/Pattern.hs +298/−214
- Sound/Tidal/Strategies.hs +43/−30
- Sound/Tidal/Stream.hs +84/−2
- Sound/Tidal/Transition.hs +1/−1
- Sound/Tidal/Version.hs +4/−0
- tidal.cabal +5/−3
- tidal.el +4/−4
README.md view
@@ -1,5 +1,5 @@ -Tidal [](https://travis-ci.org/tidalcycles/Tidal)+Tidal [](https://travis-ci.org/tidalcycles/Tidal) ===== Language for live coding of pattern
Sound/Tidal/Context.hs view
@@ -15,5 +15,7 @@ import Sound.Tidal.SuperCollider as C import Sound.Tidal.Params as C import Sound.Tidal.Transition as C+import Sound.Tidal.Version as C import qualified Sound.Tidal.Scales as Scales import qualified Sound.Tidal.Chords as Chords+
Sound/Tidal/Dirt.hs view
@@ -171,8 +171,12 @@ d1 $ slow 8 $ striate 128 $ sound "bev" @ -}-striate :: Int -> ParamPattern -> ParamPattern-striate n p = cat $ map (\x -> off (fromIntegral x) p) [0 .. n-1]++striate :: Pattern Int -> ParamPattern -> ParamPattern+striate = temporalParam _striate++_striate :: Int -> ParamPattern -> ParamPattern+_striate n p = fastcat $ map (\x -> off (fromIntegral x) p) [0 .. n-1] where off i p = p # begin (atom (fromIntegral i / fromIntegral n)) # end (atom (fromIntegral (i+1) / fromIntegral n))@@ -193,13 +197,13 @@ internally. This means that if you're using `striate` (or `striate'`) you probably shouldn't also specify `begin` or `end`. -} striate' :: Int -> Double -> ParamPattern -> ParamPattern-striate' n f p = cat $ map (\x -> off (fromIntegral x) p) [0 .. n-1]+striate' n f p = fastcat $ map (\x -> off (fromIntegral x) p) [0 .. n-1] where off i p = p # begin (atom (slot * i) :: Pattern Double) # end (atom ((slot * i) + f) :: Pattern Double) slot = (1 - f) / (fromIntegral n) {- | like `striate`, but with an offset to the begin and end values -} striateO :: Int -> Double -> ParamPattern -> ParamPattern-striateO n o p = striate n p |+| begin (atom o :: Pattern Double) |+| end (atom o :: Pattern Double)+striateO n o p = _striate n p |+| begin (atom o :: Pattern Double) |+| end (atom o :: Pattern Double) {- | Just like `striate`, but also loops each sample chunk a number of times specified in the second argument. The primed version is just like `striate'`, where the loop count is the third argument. For example:@@ -211,10 +215,10 @@ Like `striate`, these use the `begin` and `end` parameters internally, as well as the `loop` parameter for these versions. -} striateL :: Int -> Int -> ParamPattern -> ParamPattern-striateL n l p = striate n p # loop (atom $ fromIntegral l)+striateL n l p = _striate n p # loop (atom $ fromIntegral l) striateL' n f l p = striate' n f p # loop (atom $ fromIntegral l) -metronome = slow 2 $ sound (p "[odx, [hh]*8]")+metronome = _slow 2 $ sound (p "[odx, [hh]*8]") {-| Also degrades the current pattern and undegrades the next.@@ -262,7 +266,7 @@ xfadeIn :: Time -> Time -> [ParamPattern] -> ParamPattern xfadeIn _ _ [] = silence xfadeIn _ _ (p:[]) = p-xfadeIn t now (p:p':_) = overlay (p |*| gain (now ~> (slow t envEqR))) (p' |*| gain (now ~> (slow t (envEq))))+xfadeIn t now (p:p':_) = overlay (p |*| gain (now `rotR` (_slow t envEqR))) (p' |*| gain (now `rotR` (_slow t (envEq)))) {- | Crossfade between old and new pattern over the next two cycles.@@ -293,8 +297,12 @@ d1 $ stut 4 0.5 (-0.2) $ sound "bd sn" @ -}-stut :: Integer -> Double -> Rational -> ParamPattern -> ParamPattern-stut steps feedback time p = stack (p:(map (\x -> (((x%steps)*time) ~> (p |*| gain (pure $ scale (fromIntegral x))))) [1..(steps-1)]))++stut :: Pattern Integer -> Pattern Double -> Pattern Rational -> ParamPattern -> ParamPattern+stut n g t p = unwrap $ (\a b c -> _stut a b c p) <$> n <*> g <*> t++_stut :: Integer -> Double -> Rational -> ParamPattern -> ParamPattern+_stut steps feedback time p = stack (p:(map (\x -> (((x%steps)*time) `rotR` (p |*| gain (pure $ scale (fromIntegral x))))) [1..(steps-1)])) where scale x = ((+feedback) . (*(1-feedback)) . (/(fromIntegral steps)) . ((fromIntegral steps)-)) x @@ -308,7 +316,7 @@ -} stut' :: Integer -> Time -> (ParamPattern -> ParamPattern) -> ParamPattern -> ParamPattern stut' steps steptime f p | steps <= 0 = p- | otherwise = overlay (f (steptime ~> stut' (steps-1) steptime f p)) p+ | otherwise = overlay (f (steptime `rotR` stut' (steps-1) steptime f p)) p {-| same as `anticipate` though it allows you to specify the number of cycles until dropping to the new pattern, e.g.: @@ -318,7 +326,7 @@ t1 (anticipateIn 4) $ sound "jvbass(5,8)" @-} anticipateIn :: Time -> Time -> [ParamPattern] -> ParamPattern-anticipateIn t now = wash (spread' (stut 8 0.2) (now ~> (slow t $ (toRational . (1-)) <$> envL))) t now+anticipateIn t now = wash (spread' (_stut 8 0.2) (now `rotR` (_slow t $ (toRational . (1-)) <$> envL))) t now {- | `anticipate` is an increasing comb filter.
Sound/Tidal/Params.hs view
@@ -6,10 +6,6 @@ import Sound.Tidal.Utils import Control.Applicative -make' :: (a -> Value) -> Param -> Pattern a -> ParamPattern-make' toValue par p = fmap (\x -> Map.singleton par (defaultV x)) p- where defaultV a = toValue a- -- | group multiple params into one grp :: [Param] -> Pattern String -> ParamPattern grp [] _ = silence@@ -287,6 +283,10 @@ , scr, sld, std, stt, sus, tdecay, vcf, vco, voi :: Pattern Double -> ParamPattern att = attack+bpf = bandf+bpf_p = bandf_p+bpq = bandq+bpq_p = bandq_p chdecay = clhatdecay ctf = cutoff ctfg = cutoffegint@@ -295,6 +295,10 @@ det = detune gat = gate hg = hatgrain+hpf = hcutoff+hpf_p = hcutoff_p+hpq = hresonance+hpq_p = hresonance_p lag = lagogo lbd = lkick lch = lclhat@@ -307,6 +311,10 @@ lht = lhitom llt = llotom loh = lophat+lpf = cutoff+lpf_p = cutoff_p+lpq = resonance+lpq_p = resonance_p lsn = lsnare ohdecay = ophatdecay pit1 = pitch1
Sound/Tidal/Parse.hs view
@@ -24,7 +24,7 @@ data TPat a = TPat_Atom a | TPat_Density Time (TPat a)- -- We keep this distinct from 'density' because of divide-by-zero:+ -- We keep this distinct from '_density because of divide-by-zero: | TPat_Slow Time (TPat a) | TPat_Zoom Arc (TPat a) | TPat_DegradeBy Double (TPat a)@@ -44,14 +44,14 @@ toPat :: 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 t $ toPat x+ TPat_Slow t x -> _slow t $ toPat x TPat_Zoom arc x -> zoom arc $ toPat x- TPat_DegradeBy amt x -> degradeBy amt $ toPat x+ TPat_DegradeBy amt x -> _degradeBy amt $ toPat x TPat_Silence -> silence- TPat_Cat xs -> cat $ map toPat xs+ TPat_Cat xs -> fastcat $ map toPat xs TPat_Overlay x0 x1 -> overlay (toPat x0) (toPat x1)- TPat_ShiftL t x -> t <~ toPat x+ TPat_ShiftL t x -> t `rotL` toPat x TPat_pE n k s thing -> unwrap $ eoff <$> toPat n <*> toPat k <*> toPat s <*> pure (toPat thing) TPat_Foot -> error "Can't happen, feet (.'s) only used internally.."@@ -304,13 +304,13 @@ return (a, b, c) eoff :: Int -> Int -> Integer -> Pattern a -> Pattern a-eoff n k s p = ((s%(fromIntegral k)) <~) (e n k p)+eoff n k s p = ((s%(fromIntegral k)) `rotL`) (e n k p) -- TPat_ShiftL (s%(fromIntegral k)) (TPat_E n k p) pReplicate :: TPat a -> Parser [TPat a] pReplicate thing = do extras <- many $ do char '!'- -- if a number is given (without a space)+ -- if a number is given (without a space)slow 2 $ fast -- replicate that number of times n <- ((read <$> many1 digit) <|> return 2) spaces@@ -327,12 +327,19 @@ return $ map (\x -> TPat_Zoom (x%n,(x+1)%n) thing) [0 .. (n-1)] pRatio :: Parser (Rational)-pRatio = do n <- natural <?> "numerator"- d <- do oneOf "/%"- natural <?> "denominator"- <|>- return 1- return $ n % d+pRatio = do n <- natural+ result <- do char '%'+ d <- natural+ return (n%d)+ <|>+ do char '.'+ d <- natural+ -- A hack, but not sure if doing this+ -- numerically would be any faster..+ return (toRational $ ((read $ show n ++ "." ++ show d) :: Double))+ <|>+ return (n%1)+ return result pRational :: Parser (TPat Rational) pRational = do r <- pRatio
Sound/Tidal/Pattern.hs view
@@ -1,25 +1,28 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, CPP #-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans -fno-warn-name-shadowing #-} module Sound.Tidal.Pattern where import Control.Applicative-import Data.Monoid+-- import Data.Monoid import Data.Fixed import Data.List import Data.Maybe import Data.Ord import Data.Ratio-import Debug.Trace+-- import Debug.Trace import Data.Typeable import Data.Function import System.Random.Mersenne.Pure64-import Data.Char+-- import Data.Char import qualified Data.Text as T import Sound.Tidal.Time import Sound.Tidal.Utils import Sound.Tidal.Bjorklund +import Text.Show.Functions ()+ -- | The pattern datatype, a function from a time @Arc@ to @Event@ -- values. For discrete patterns, this returns the events which are -- active during that time. For continuous patterns, events with@@ -27,40 +30,12 @@ data Pattern a = Pattern {arc :: Arc -> [Event a]} deriving Typeable --- | Admit the pattern datatype to the Num, Fractional and Floating classes,--- to allow arithmetic on them, and for bare numbers to be automatically--- converted into patterns of numbers-instance Num a => Num (Pattern a) where- negate = fmap negate- (+) = liftA2 (+)- (*) = liftA2 (*)- fromInteger = pure . fromInteger- abs = fmap abs- signum = fmap signum--instance (Fractional a) => Fractional (Pattern a) where- fromRational = pure . fromRational- (/) = liftA2 (/)+#define INSTANCE_Eq+#define INSTANCE_Ord+#define INSTANCE_Enum -instance Floating a => Floating (Pattern a) where- pi = pure pi- exp = liftA (exp)- log = liftA (log)- sqrt = liftA (sqrt)- (**) = liftA2 (**)- logBase = liftA2 (logBase)- sin = liftA (sin)- cos = liftA (cos)- tan = liftA (tan)- asin = liftA (asin)- acos = liftA (acos)- atan = liftA (atan)- sinh = liftA (sinh)- cosh = liftA (cosh)- tanh = liftA (tanh)- asinh = liftA (asinh)- acosh = liftA (acosh)- atanh = liftA (atanh)+#define APPLICATIVE Pattern+#include "ApplicativeNumeric-inc.hs" -- | @show (p :: Pattern)@ returns a text string representing the -- event values active during the first cycle of the given pattern.@@ -78,11 +53,14 @@ -- | converts an event into human readable string, e.g. @("bd" 1/4 2/3)@ showEvent :: (Show a) => Event a -> String-showEvent (a, b, v) | a == b = concat["(",show v,- (' ':showArc a),- ")"- ]- | otherwise = show v+showEvent e@(_, b, v) = concat[on, show v, off,+ (' ':showArc b),+ "\n"+ ]+ where on | hasOnset e = ""+ | otherwise = ".."+ off | hasOffset e = ""+ | otherwise = ".." instance Functor Pattern where fmap f (Pattern a) = Pattern $ fmap (fmap (mapThd' f)) a@@ -114,31 +92,15 @@ instance Monad Pattern where return = pure- -- Pattern a -> (a -> Pattern b) -> Pattern b- -- Pattern Char -> (Char -> Pattern String) -> Pattern String p >>= f = unwrap (f <$> p)-{-Pattern (\a -> concatMap- (\((s,e), (s',e'), x) -> map (\ev -> ((s,e), (s',e'), thd' ev)) $- filter- (\(a', _, _) -> isIn a' s)- (arc (f x) (s,e))- )- (arc p a)- )--}--- join x = x >>= id ---- Take a pattern, and function from elements in the pattern to another pattern,--- and then return that pattern---bind :: Pattern a -> (a -> Pattern b) -> Pattern b---bind p f =---- this is actually join unwrap :: Pattern (Pattern a) -> Pattern a-unwrap p = Pattern $ \a -> concatMap ((\p' -> arc p' a) . thd') (arc p a)+unwrap p = Pattern $ \a -> concatMap (\(_, outerPart, p') -> catMaybes $ map (munge outerPart) $ arc p' a) (arc p a)+ where munge a (whole,part,v) = do part' <- subArc a part+ return (whole, part',v) + -- | @atom@ is a synonym for @pure@. atom :: a -> Pattern a atom = pure@@ -196,26 +158,25 @@ -- first pattern, within a single cycle append :: Pattern a -> Pattern a -> Pattern a-append a b = cat [a,b]+append a b = fastcat [a,b] -- | @append'@ does the same as @append@, but over two cycles, so that -- the cycles alternate between the two patterns. append' :: Pattern a -> Pattern a -> Pattern a-append' a b = slow 2 $ cat [a,b]+append' a b = slowcat [a,b] --- | @cat@ returns a new pattern which interlaces the cycles of the+-- | @fastcat@ returns a new pattern which interlaces the cycles of the -- given patterns, within a single cycle. It's the equivalent of -- @append@, but with a list of patterns.-cat :: [Pattern a] -> Pattern a-cat ps = density (fromIntegral $ length ps) $ slowcat ps-+fastcat :: [Pattern a] -> Pattern a+fastcat ps = _density (fromIntegral $ length ps) $ slowcat ps splitAtSam :: Pattern a -> Pattern a splitAtSam p = splitQueries $ Pattern $ \(s,e) -> mapSnds' (trimArc (sam s)) $ arc p (s,e) where trimArc s' (s,e) = (max (s') s, min (s'+1) e) --- | @slowcat@ does the same as @cat@, but maintaining the duration of+-- | @slowcat@ does the same as @fastcat@, but maintaining the duration of -- the original patterns. It is the equivalent of @append'@, but with -- a list of patterns. @@ -231,61 +192,103 @@ offset = (fromIntegral $ r - ((r - n) `div` l)) :: Time (s', e') = (s-offset, e-offset) +-- | @cat@ is an alias of @slowcat@+cat :: [Pattern a] -> Pattern a+cat = slowcat+ -- | @listToPat@ turns the given list of values to a Pattern, which -- cycles through the list. listToPat :: [a] -> Pattern a-listToPat = cat . map atom+listToPat = fastcat . map atom -- | @maybeListToPat@ is similar to @listToPat@, but allows values to -- be optional using the @Maybe@ type, so that @Nothing@ results in -- gaps in the pattern. maybeListToPat :: [Maybe a] -> Pattern a-maybeListToPat = cat . map f+maybeListToPat = fastcat . map f where f Nothing = silence f (Just x) = atom x -- | @run@ @n@ returns a pattern representing a cycle of numbers from @0@ to @n-1@.-run n = listToPat [0 .. n-1]-scan n = cat $ map run [1 .. n]+run :: (Enum a, Num a) => Pattern a -> Pattern a+run tp = tp >>= _run --- | @density@ returns the given pattern with density increased by the--- given @Time@ factor. Therefore @density 2 p@ will return a pattern--- that is twice as fast, and @density (1/3) p@ will return one three--- times as slow.-density :: Time -> Pattern a -> Pattern a-density r p = withResultTime (/ r) $ withQueryTime (* r) p+_run :: (Enum a, Num a) => a -> Pattern a+_run n = listToPat [0 .. n-1] -density' :: Pattern Time -> Pattern a -> Pattern a-density' tp p = unwrap $ (\tv -> density tv p) <$> tp+scan :: (Enum a, Num a) => Pattern a -> Pattern a+scan tp = tp >>= _scan --- | @densityGap@ is similar to @density@ but maintains its cyclic--- alignment. For example, @densityGap 2 p@ would squash the events in+_scan :: (Enum a, Num a) => a -> Pattern a+_scan n = slowcat $ map _run [1 .. n]++temporalParam :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c)+temporalParam f tv p = unwrap $ (\v -> f v p) <$> tv++temporalParam' :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c)+temporalParam' f tv p = unwrap' $ (\v -> f v p) <$> tv++-- | @fast@ (also known as @density@) returns the given pattern with speed+-- (or density) increased by the given @Time@ factor. Therefore @fast 2 p@+-- will return a pattern that is twice as fast, and @fast (1/3) p@+-- will return one three times as slow.+fast :: Pattern Time -> Pattern a -> Pattern a+fast = temporalParam _density++fast' :: Pattern Time -> Pattern a -> Pattern a+fast' = temporalParam' _density++-- | @density@ is an alias of @fast@. @fast@ is quicker to type, but+-- @density@ is its old name so is used in a lot of examples.+density :: Pattern Time -> Pattern a -> Pattern a+density = fast++_density :: Time -> Pattern a -> Pattern a+_density r p = withResultTime (/ r) $ withQueryTime (* r) p++-- | @fastGap@ (also known as @densityGap@ is similar to @fast@ but maintains its cyclic+-- alignment. For example, @fastGap 2 p@ would squash the events in -- pattern @p@ into the first half of each cycle (and the second -- halves would be empty).+fastGap :: Time -> Pattern a -> Pattern a+fastGap 0 _ = silence+fastGap r p = splitQueries $ withResultArc (\(s,e) -> (sam s + ((s - sam s)/r), (sam s + ((e - sam s)/r)))) $ Pattern (\a -> arc p $ mapArc (\t -> sam t + (min 1 (r * cyclePos t))) a)+ densityGap :: Time -> Pattern a -> Pattern a-densityGap 0 _ = silence-densityGap r p = splitQueries $ withResultArc (\(s,e) -> (sam s + ((s - sam s)/r), (sam s + ((e - sam s)/r)))) $ Pattern (\a -> arc p $ mapArc (\t -> sam t + (min 1 (r * cyclePos t))) a)+densityGap = fastGap --- | @slow@ does the opposite of @density@, i.e. @slow 2 p@ will--- return a pattern that is half the speed.-slow :: Time -> Pattern a -> Pattern a-slow 0 = id-slow t = density (1/t)+-- | @slow@ does the opposite of @fast@, i.e. @slow 2 p@ will return a+-- pattern that is half the speed.+slow :: Pattern Time -> Pattern a -> Pattern a+slow = temporalParam _slow -slow' tp p = density' (1/tp) p+sparsity :: Pattern Time -> Pattern a -> Pattern a+sparsity = slow +slow' :: Pattern Time -> Pattern a -> Pattern a+slow' = temporalParam' _slow++_slow :: Time -> Pattern a -> Pattern a+_slow t p = _density (1/t) p+ -- | The @<~@ operator shifts (or rotates) a pattern to the left (or -- counter-clockwise) by the given @Time@ value. For example -- @(1%16) <~ p@ will return a pattern with all the events moved -- one 16th of a cycle to the left.-(<~) :: Time -> Pattern a -> Pattern a-(<~) t p = withResultTime (subtract t) $ withQueryTime (+ t) p+rotL :: Time -> Pattern a -> Pattern a+rotL t p = withResultTime (subtract t) $ withQueryTime (+ t) p +(<~) :: Pattern Time -> Pattern a -> Pattern a+(<~) = temporalParam rotL+ -- | The @~>@ operator does the same as @<~@ but shifts events to the -- right (or clockwise) rather than to the left.-(~>) :: Time -> Pattern a -> Pattern a-(~>) = (<~) . (0-)+rotR :: Time -> Pattern a -> Pattern a+rotR = (rotL) . (0-) +(~>) :: Pattern Time -> Pattern a -> Pattern a+(~>) = temporalParam rotR+ {- | (The above means that `brak` is a function from patterns of any type, to a pattern of the same type.) @@ -298,7 +301,7 @@ @ -} brak :: Pattern a -> Pattern a-brak = when ((== 1) . (`mod` 2)) (((1%4) ~>) . (\x -> cat [x, silence]))+brak = when ((== 1) . (`mod` 2)) (((1%4) `rotR`) . (\x -> fastcat [x, silence])) {- | Divides a pattern into a given number of subdivisions, plays the subdivisions in order, but increments the starting subdivision each cycle. The pattern@@ -322,14 +325,20 @@ There is also `iter'`, which shifts the pattern in the opposite direction. -}-iter :: Int -> Pattern a -> Pattern a-iter n p = slowcat $ map (\i -> ((fromIntegral i)%(fromIntegral n)) <~ p) [0 .. (n-1)]+iter :: Pattern Int -> Pattern c -> Pattern c+iter = temporalParam _iter +_iter :: Int -> Pattern a -> Pattern a+_iter n p = slowcat $ map (\i -> ((fromIntegral i)%(fromIntegral n)) `rotL` p) [0 .. (n-1)]+ -- | @iter'@ is the same as @iter@, but decrements the starting -- subdivision instead of incrementing it.-iter' :: Int -> Pattern a -> Pattern a-iter' n p = slowcat $ map (\i -> ((fromIntegral i)%(fromIntegral n)) ~> p) [0 .. (n-1)]+iter' :: Pattern Int -> Pattern c -> Pattern c+iter' = temporalParam _iter' +_iter' :: Int -> Pattern a -> Pattern a+_iter' n p = slowcat $ map (\i -> ((fromIntegral i)%(fromIntegral n)) `rotR` p) [0 .. (n-1)]+ -- | @rev p@ returns @p@ with the event positions in each cycle -- reversed (or mirrored). rev :: Pattern a -> Pattern a@@ -337,6 +346,7 @@ -- | @palindrome p@ applies @rev@ to @p@ every other cycle, so that -- the pattern alternates between forwards and backwards.+palindrome :: Pattern a -> Pattern a palindrome p = append' p (rev p) {-|@@ -381,14 +391,17 @@ @ -} seqP :: [(Time, Time, Pattern a)] -> Pattern a-seqP ps = stack $ map (\(s, e, p) -> playFor s e ((sam s) ~> p)) ps+seqP ps = stack $ map (\(s, e, p) -> playFor s e ((sam s) `rotR` p)) ps -- | @every n f p@ applies the function @f@ to @p@, but only affects -- every @n@ cycles.-every :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-every 0 _ p = p-every n f p = when ((== 0) . (`mod` n)) f p+every :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+every tp f p = tp >>= \t -> _every t f p +_every :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+_every 0 _ p = p+_every n f p = when ((== 0) . (`mod` n)) f p+ -- | @every n o f'@ is like @every n f@ with an offset of @o@ cycles every' :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a every' n o f = when ((== o) . (`mod` n)) f@@ -396,7 +409,7 @@ -- | @foldEvery ns f p@ applies the function @f@ to @p@, and is applied for -- each cycle in @ns@. foldEvery :: [Int] -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-foldEvery ns f p = foldr ($) p (map (\x -> every x f) ns)+foldEvery ns f p = foldr ($) p (map (\x -> _every x f) ns) -- | @sig f@ takes a function from time to values, and turns it into a -- @Pattern@.@@ -406,90 +419,89 @@ | otherwise = [((s,e), (s,e), f s)] -- | @sinewave@ returns a @Pattern@ of continuous @Double@ values following a--- sinewave with frequency of one cycle, and amplitude from -1 to 1.+-- sinewave with frequency of one cycle, and amplitude from 0 to 1. sinewave :: Pattern Double-sinewave = sig $ \t -> sin $ pi * 2 * (fromRational t)+sinewave = sig $ \t -> ((sin $ pi * 2 * (fromRational t)) + 1) / 2+ -- | @sine@ is a synonym for @sinewave@.+sine :: Pattern Double sine = sinewave+ -- | @sinerat@ is equivalent to @sinewave@ for @Rational@ values, -- suitable for use as @Time@ offsets.+sinerat :: Pattern Rational sinerat = fmap toRational sine+ -- | @ratsine@ is a synonym for @sinerat@.+ratsine :: Pattern Rational ratsine = sinerat --- | @sinewave1@ is equivalent to @sinewave@, but with amplitude from 0 to 1.-sinewave1 :: Pattern Double-sinewave1 = fmap ((/ 2) . (+ 1)) sinewave---- | @sine1@ is a synonym for @sinewave1@.-sine1 = sinewave1---- | @sinerat1@ is equivalent to @sinerat@, but with amplitude from 0 to 1.-sinerat1 = fmap toRational sine1---- | @sineAmp1 d@ returns @sinewave1@ with its amplitude offset by @d@.-sineAmp1 :: Double -> Pattern Double-sineAmp1 offset = (+ offset) <$> sinewave1+-- | @sineAmp d@ returns @sinewave@ with its amplitude offset by @d@.+-- Deprecated, as these days you can simply do e.g. (sine + 0.5)+sineAmp :: Double -> Pattern Double+sineAmp offset = (+ offset) <$> sinewave1 -- | @sawwave@ is the equivalent of @sinewave@ for (ascending) sawtooth waves. sawwave :: Pattern Double-sawwave = ((subtract 1) . (* 2)) <$> sawwave1+sawwave = sig $ \t -> mod' (fromRational t) 1 -- | @saw@ is a synonym for @sawwave@.+saw :: Pattern Double saw = sawwave -- | @sawrat@ is the same as @sawwave@ but returns @Rational@ values -- suitable for use as @Time@ offsets.+sawrat :: Pattern Rational sawrat = fmap toRational saw --- | @sawwave1@ is the equivalent of @sinewave1@ for (ascending) sawtooth waves.-sawwave1 :: Pattern Double-sawwave1 = sig $ \t -> mod' (fromRational t) 1---- | @saw1@ is a synonym for @sawwave1@.-saw1 = sawwave1---- | @sawrat1@ is the same as @sawwave1@ but returns @Rational@ values--- suitable for use as @Time@ offsets.-sawrat1 = fmap toRational saw1- -- | @triwave@ is the equivalent of @sinewave@ for triangular waves. triwave :: Pattern Double-triwave = ((subtract 1) . (* 2)) <$> triwave1+triwave = append sawwave1 (rev sawwave1) -- | @tri@ is a synonym for @triwave@.+tri :: Pattern Double tri = triwave -- | @trirat@ is the same as @triwave@ but returns @Rational@ values -- suitable for use as @Time@ offsets.+trirat :: Pattern Rational trirat = fmap toRational tri --- | @triwave1@ is the equivalent of @sinewave1@ for triangular waves.-triwave1 :: Pattern Double-triwave1 = append sawwave1 (rev sawwave1)---- | @tri1@ is a synonym for @triwave1@.-tri1 = triwave1---- | @trirat1@ is the same as @triwave1@ but returns @Rational@ values--- suitable for use as @Time@ offsets.-trirat1 = fmap toRational tri1---- | @squarewave1@ is the equivalent of @sinewave1@ for square waves.-squarewave1 :: Pattern Double-squarewave1 = sig $- \t -> fromIntegral $ floor $ (mod' (fromRational t) 1) * 2---- | @square1@ is a synonym for @squarewave1@.-square1 = squarewave1---- | @squarewave@ is the equivalent of @sinewave@ for square waves.+-- | @squarewave1@ is the equivalent of @sinewave@ for square waves. squarewave :: Pattern Double-squarewave = ((subtract 1) . (* 2)) <$> squarewave1+squarewave = sig $+ \t -> fromIntegral $ ((floor $ (mod' (fromRational t :: Double) 1) * 2) :: Integer) -- | @square@ is a synonym for @squarewave@.+square :: Pattern Double square = squarewave +-- deprecated..+sinewave1 :: Pattern Double+sinewave1 = sinewave+sine1 :: Pattern Double+sine1 = sinewave+sinerat1 :: Pattern Rational+sinerat1 = sinerat+sineAmp1 :: Double -> Pattern Double+sineAmp1 = sineAmp+sawwave1 :: Pattern Double+sawwave1 = sawwave+saw1 :: Pattern Double+saw1 = sawwave+sawrat1 :: Pattern Rational+sawrat1 = sawrat+triwave1 :: Pattern Double+triwave1 = triwave+tri1 :: Pattern Double+tri1 = triwave+trirat1 :: Pattern Rational+trirat1 = trirat+squarewave1 :: Pattern Double+squarewave1 = squarewave+square1 :: Pattern Double+square1 = square+ -- | @envL@ is a @Pattern@ of continuous @Double@ values, representing -- a linear interpolation between 0 and 1 during the first cycle, then -- staying constant at 1 for all following cycles. Possibly only@@ -505,25 +517,27 @@ -- 'Equal power' for gain-based transitions envEq :: Pattern Double envEq = sig $ \t -> sqrt (sin (pi/2 * (max 0 $ min (fromRational (1-t)) 1)))+ -- Equal power reversed+envEqR :: Pattern Double envEqR = sig $ \t -> sqrt (cos (pi/2 * (max 0 $ min (fromRational (1-t)) 1))) fadeOut :: Time -> Pattern a -> Pattern a-fadeOut n = spread' (degradeBy) (slow n $ envL)+fadeOut n = spread' (_degradeBy) (_slow n $ envL) -- Alternate versions where you can provide the time from which the fade starts fadeOut' :: Time -> Time -> Pattern a -> Pattern a-fadeOut' from dur p = spread' (degradeBy) (from ~> slow dur envL) p+fadeOut' from dur p = spread' (_degradeBy) (from `rotR` _slow dur envL) p -- The 1 <~ is so fade ins and outs have different degredations fadeIn' :: Time -> Time -> Pattern a -> Pattern a-fadeIn' from dur p = spread' (\n p -> 1 <~ degradeBy n p) (from ~> slow dur ((1-) <$> envL)) p+fadeIn' from dur p = spread' (\n p -> 1 `rotL` _degradeBy n p) (from `rotR` _slow dur ((1-) <$> envL)) p fadeIn :: Time -> Pattern a -> Pattern a-fadeIn n = spread' (degradeBy) (slow n $ (1-) <$> envL)+fadeIn n = spread' (_degradeBy) (_slow n $ (1-) <$> envL) {- | (The above is difficult to describe, if you don't understand Haskell,-just read the description and examples..)+just ignore it and read the below..) The `spread` function allows you to take a pattern transformation which takes a parameter, such as `slow`, and provide several@@ -577,6 +591,7 @@ spread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b spread f xs p = slowcat $ map (\x -> f x p) xs +slowspread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b slowspread = spread {- | @fastspread@ works the same as @spread@, but the result is squashed into a single cycle. If you gave four values to @spread@, then the result would seem to speed up by a factor of four. Compare these two:@@ -588,7 +603,7 @@ There is also @slowspread@, which is an alias of @spread@. -} fastspread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b-fastspread f xs p = cat $ map (\x -> f x p) xs+fastspread f xs p = fastcat $ map (\x -> f x p) xs {- | There's a version of this function, `spread'` (pronounced "spread prime"), which takes a *pattern* of parameters, instead of a list: @@ -614,11 +629,16 @@ spreadChoose :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b spreadChoose f vs p = do v <- discretise 1 (choose vs) f v p++spreadr :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b spreadr = spreadChoose filterValues :: (a -> Bool) -> Pattern a -> Pattern a filterValues f (Pattern x) = Pattern $ (filter (f . thd')) . x +filterJust :: Pattern (Maybe a) -> Pattern a+filterJust p = fromJust <$> (filterValues (isJust) p)+ -- Filter out events that have had their onsets cut off filterOnsets :: Pattern a -> Pattern a filterOnsets (Pattern f) =@@ -630,6 +650,7 @@ filterStartInRange (Pattern f) = Pattern $ \(s,e) -> filter ((isIn (s,e)) . eventOnset) $ f (s,e) +filterOnsetsInRange :: Pattern a -> Pattern a filterOnsetsInRange = filterOnsets . filterStartInRange -- Samples some events from a pattern, returning a list of onsets@@ -656,6 +677,7 @@ groupByTime :: [Event a] -> [Event [a]] groupByTime es = map mrg $ groupBy ((==) `on` snd') $ sortBy (compare `on` snd') es where mrg es@((a, a', _):_) = (a, a', map thd' es)+ mrg _ = error "groupByTime" {-| Decide whether to apply one or another function depending on the result of a test function that is passed the current cycle as a number.@@ -709,17 +731,18 @@ rand :: Pattern Double rand = Pattern $ \a -> [(a, a, timeToRand $ (midPoint a))] +timeToRand :: RealFrac r => r -> Double timeToRand t = fst $ randomDouble $ pureMT $ floor $ (*1000000) t -{- | Just like `rand` but for integers, `irand n` generates a pattern of (pseudo-)random integers between `0` to `n-1` inclusive. Notably used to pick a random+{- | Just like `rand` but for whole numbers, `irand n` generates a pattern of (pseudo-) random whole numbers between `0` to `n-1` inclusive. Notably used to pick a random samples from a folder: @-d1 $ sound (samples "drum*4" (irand 5))+d1 $ n (irand 5) # sound "drum" @ -}-irand :: Int -> Pattern Int-irand i = (floor . (* (fromIntegral i))) <$> rand+irand :: Num a => Int -> Pattern a+irand i = (fromIntegral . (floor :: Double -> Int) . (* (fromIntegral i))) <$> rand {- | Randomly picks an element from the given list @@ -743,18 +766,23 @@ @ -}-degradeBy :: Double -> Pattern a -> Pattern a-degradeBy x p = unMaybe $ (\a f -> toMaybe (f > x) a) <$> p <*> rand- where toMaybe False _ = Nothing- toMaybe True a = Just a- unMaybe = (fromJust <$>) . filterValues isJust -unDegradeBy :: Double -> Pattern a -> Pattern a-unDegradeBy x p = unMaybe $ (\a f -> toMaybe (f <= x) a) <$> p <*> rand- where toMaybe False _ = Nothing- toMaybe True a = Just a- unMaybe = (fromJust <$>) . filterValues isJust+degradeBy :: Pattern Double -> Pattern a -> Pattern a+degradeBy = temporalParam _degradeBy +_degradeBy :: Double -> Pattern a -> Pattern a+_degradeBy x p = fmap fst $ filterValues ((> x) . snd) $ (,) <$> p <*> rand++unDegradeBy :: Pattern Double -> Pattern a -> Pattern a+unDegradeBy = temporalParam _unDegradeBy++_unDegradeBy :: Double -> Pattern a -> Pattern a+_unDegradeBy x p = fmap fst $ filterValues ((<= x) . snd) $ (,) <$> p <*> rand++degradeOverBy :: Int -> Pattern Double -> Pattern a -> Pattern a+degradeOverBy i tx p = unwrap $ (\x -> (fmap fst $ filterValues ((> x) . snd) $ (,) <$> p <*> repeatCycles i rand)) <$> (slow (fromIntegral i) tx)++ {- | Use @sometimesBy@ to apply a given function "sometimes". For example, the following code results in `density 2` being applied about 25% of the time: @@ -773,28 +801,44 @@ @ -} sometimesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-sometimesBy x f p = overlay (degradeBy x p) (f $ unDegradeBy x p)+sometimesBy x f p = overlay (_degradeBy x p) (f $ _unDegradeBy x p) -- | @sometimes@ is an alias for sometimesBy 0.5.+sometimes :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a sometimes = sometimesBy 0.5+ -- | @often@ is an alias for sometimesBy 0.75.+often :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a often = sometimesBy 0.75+ -- | @rarely@ is an alias for sometimesBy 0.25.+rarely :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a rarely = sometimesBy 0.25+ -- | @almostNever@ is an alias for sometimesBy 0.1+almostNever :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a almostNever = sometimesBy 0.1+ -- | @almostAlways@ is an alias for sometimesBy 0.9+almostAlways :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a almostAlways = sometimesBy 0.9++never :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a never = flip const++always :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a always = id {- | @someCyclesBy@ is a cycle-by-cycle version of @sometimesBy@. It has a `someCycles = someCyclesBy 0.5` alias -}+someCyclesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a someCyclesBy x = when (test x)- where test x c = (timeToRand $ fromIntegral c) < x+ where test x c = (timeToRand (fromIntegral c :: Double)) < x +somecyclesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a somecyclesBy = someCyclesBy +someCycles :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a someCycles = someCyclesBy 0.5 {- | `degrade` randomly removes events from a pattern 50% of the time:@@ -819,13 +863,13 @@ @ -} degrade :: Pattern a -> Pattern a-degrade = degradeBy 0.5+degrade = _degradeBy 0.5 -- | @wedge t p p'@ combines patterns @p@ and @p'@ by squashing the -- @p@ into the portion of each cycle given by @t@, and @p'@ into the -- remainer of each cycle. wedge :: Time -> Pattern a -> Pattern a -> Pattern a-wedge t p p' = overlay (densityGap (1/t) p) (t ~> densityGap (1/(1-t)) p')+wedge t p p' = overlay (densityGap (1/t) p) (t `rotR` densityGap (1/(1-t)) p') {- | @whenmod@ has a similar form and behavior to `every`, but requires an additional number. Applies the function to the pattern, when the@@ -856,6 +900,7 @@ @ -}+superimpose :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a superimpose f p = stack [p, f p] -- | @splitQueries p@ wraps `p` to ensure that it does not get@@ -873,9 +918,12 @@ d1 $ trunc 0.75 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2" @ -}-trunc :: Time -> Pattern a -> Pattern a-trunc t = compress (0,t) . zoom (0,t)+trunc :: Pattern Time -> Pattern a -> Pattern a+trunc = temporalParam _trunc +_trunc :: Time -> Pattern a -> Pattern a+_trunc t = compress (0,t) . zoom (0,t)+ {- | Plays a portion of a pattern, specified by a beginning and end arc of time. The new resulting pattern is played over the time period of the original pattern: @@ -890,12 +938,12 @@ @ -} zoom :: Arc -> Pattern a -> Pattern a-zoom a@(s,e) p = splitQueries $ withResultArc (mapCycle ((/d) . (subtract s))) $ withQueryArc (mapCycle ((+s) . (*d))) p+zoom (s,e) p = splitQueries $ withResultArc (mapCycle ((/d) . (subtract s))) $ withQueryArc (mapCycle ((+s) . (*d))) p where d = e-s compress :: Arc -> Pattern a -> Pattern a-compress a@(s,e) p | s >= e = silence- | otherwise = s ~> densityGap (1/(e-s)) p+compress (s,e) p | s >= e = silence+ | otherwise = s `rotR` densityGap (1/(e-s)) p sliceArc :: Arc -> Pattern a -> Pattern a sliceArc a@(s,e) p | s >= e = silence@@ -921,6 +969,7 @@ sliceArc (e,1) p ] +revArc :: Arc -> Pattern a -> Pattern a revArc a = within a rev {- | You can use the @e@ function to apply a Euclidean algorithm over a@@ -971,7 +1020,7 @@ e n k p = (flip const) <$> (filterValues (== True) $ listToPat $ bjorklund (n,k)) <*> p e' :: Int -> Int -> Pattern a -> Pattern a-e' n k p = cat $ map (\x -> if x then p else silence) (bjorklund (n,k))+e' n k p = fastcat $ map (\x -> if x then p else silence) (bjorklund (n,k)) index :: Real b => b -> Pattern b -> Pattern c -> Pattern c@@ -987,9 +1036,9 @@ values = fmap thd' . sortBy ecompare $ arc valuePattern (0, vlen) cycles = blen * (fromIntegral $ lcm (length beats) (length values) `div` (length beats)) in- slow cycles $ stack $ zipWith- (\( _, (start, end), v') v -> (start ~>) $ densityGap (1 / (end - start)) $ pure (f v' v))- (sortBy ecompare $ arc (density cycles $ beatPattern) (0, blen))+ _slow cycles $ stack $ zipWith+ (\( _, (start, end), v') v -> (start `rotR`) $ densityGap (1 / (end - start)) $ pure (f v' v))+ (sortBy ecompare $ arc (_density cycles $ beatPattern) (0, blen)) (drop (rot `mod` length values) $ cycle values) -- | @prr rot (blen, vlen) beatPattern valuePattern@: pattern rotate/replace.@@ -1024,6 +1073,7 @@ preplace = preplaceWith $ flip const -- | @prep@ is an alias for preplace.+prep :: (Time, Time) -> Pattern String -> Pattern b -> Pattern b prep = preplace preplace1 :: Pattern String -> Pattern b -> Pattern b@@ -1032,11 +1082,13 @@ preplaceWith :: (a -> b -> c) -> (Time, Time) -> Pattern a -> Pattern b -> Pattern c preplaceWith f (blen, plen) = prrw f 0 (blen, plen) +prw :: (a -> b -> c) -> (Time, Time) -> Pattern a -> Pattern b -> Pattern c prw = preplaceWith preplaceWith1 :: (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c preplaceWith1 f = prrw f 0 (1, 1) +prw1 :: (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c prw1 = preplaceWith1 (<~>) :: Pattern String -> Pattern b -> Pattern b@@ -1048,7 +1100,10 @@ protate :: Time -> Int -> Pattern a -> Pattern a protate len rot p = prrw (flip const) rot (len, len) p p +prot :: Time -> Int -> Pattern a -> Pattern a prot = protate++prot1 :: Int -> Pattern a -> Pattern a prot1 = protate 1 {-| The @<<~@ operator rotates a unit pattern to the left, similar to @<~@,@@ -1074,13 +1129,16 @@ -- | @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 :: 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' (<~) (discretise 1 $ ((%1) . fromIntegral) <$> irand (length ps - 1)) (slowcat ps)+randcat ps = spread' (rotL) (discretise 1 $ ((%1) . fromIntegral) <$> (irand (length ps - 1) :: 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@@ -1135,7 +1193,7 @@ 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) x)) $ perms n total+ permsort n total = map fst $ sortBy (comparing snd) $ map (\x -> (x,deviance (fromIntegral total / (fromIntegral n :: Double)) x)) $ perms n total perms 0 _ = [] perms 1 n = [[n]] perms n total = concatMap (\x -> map (x:) $ perms (n-1) (total-x)) [1 .. (total-(n-1))]@@ -1244,37 +1302,46 @@ which uses `chop` to break a single sample into individual pieces, which `fit'` then puts into a list (using the `run 4` pattern) and reassembles according to the complicated integer pattern. -}+fit' :: Pattern Time -> Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a fit' cyc n from to p = unwrap' $ fit n (mapMasks n from' p') to where mapMasks n from p = [stretch $ mask (filterValues (== i) from) p | i <- [0..n-1]] p' = density cyc $ p from' = density cyc $ from -{-| @runWith n f p@ treats the given pattern @p@ as having @n@ sections, and applies the function @f@ to one of those sections per cycle, running from left to right.+{-| @chunk n f p@ treats the given pattern @p@ as having @n@ chunks, and applies the function @f@ to one of those sections per cycle, running from left to right. @-d1 $ runWith 4 (density 4) $ sound "cp sn arpy [mt lt]"+d1 $ chunk 4 (density 4) $ sound "cp sn arpy [mt lt]" @ -}-runWith :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b-runWith n f p = do i <- slow (toRational n) $ run (fromIntegral n)- within (i%(fromIntegral n),(i+)1%(fromIntegral n)) f p+chunk :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b+chunk n f p = do i <- _slow (toRational n) $ run (fromIntegral n)+ within (i%(fromIntegral n),(i+)1%(fromIntegral n)) f p +-- deprecated (renamed to chunk)+runWith :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b+runWith = chunk -{-| @runWith'@ works much the same as `runWith`, but runs from right to left.+{-| @chunk'@ works much the same as `chunk`, but runs from right to left. -}+chunk' :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b+chunk' n f p = do i <- _slow (toRational n) $ rev $ run (fromIntegral n)+ within (i%(fromIntegral n),(i+)1%(fromIntegral n)) f p++-- deprecated (renamed to chunk') runWith' :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b-runWith' n f p = do i <- slow (toRational n) $ rev $ run (fromIntegral n)- within (i%(fromIntegral n),(i+)1%(fromIntegral n)) f p+runWith' = chunk' inside :: Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a-inside n f p = density n $ f (slow n p)+inside n f p = _density n $ f (_slow n p) outside :: Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a outside n = inside (1/n) +loopFirst :: Pattern a -> Pattern a loopFirst p = splitQueries $ Pattern f- where f a@(s,e) = mapSnds' plus $ mapFsts' plus $ arc p (minus a)+ where f a@(s,_) = mapSnds' plus $ mapFsts' plus $ arc p (minus a) where minus = mapArc (subtract (sam s)) plus = mapArc (+ (sam s)) @@ -1282,7 +1349,7 @@ timeLoop n = outside n loopFirst seqPLoop :: [(Time, Time, Pattern a)] -> Pattern a-seqPLoop ps = timeLoop (maxT - minT) $ minT <~ seqP ps+seqPLoop ps = timeLoop (maxT - minT) $ minT `rotL` seqP ps where minT = minimum $ map fst' ps maxT = maximum $ map snd' ps @@ -1305,8 +1372,9 @@ for `swingBy (1%3)` -} swingBy::Time -> Time -> Pattern a -> Pattern a -swingBy x n = inside n (within (0.5,1) (x ~>))+swingBy x n = inside n (within (0.5,1) (x `rotR`)) +swing :: Time -> Pattern a -> Pattern a swing = swingBy (1%3) {- | `cycleChoose` is like `choose` but only picks a new item from the list@@ -1314,7 +1382,7 @@ cycleChoose::[a] -> Pattern a cycleChoose xs = Pattern $ \(s,e) -> [((s,e),(s,e), xs!!(floor $ (dlen xs)*(ctrand s) ))] where dlen xs = fromIntegral $ length xs- ctrand s = timeToRand $ fromIntegral $ floor $ sam s+ ctrand s = (timeToRand :: Time -> Double) $ fromIntegral $ (floor :: Time -> Int) $ sam s {- | `shuffle n p` evenly divides one cycle of the pattern `p` into `n` parts, and returns a random permutation of the parts each cycle. For example, @@ -1323,8 +1391,12 @@ is not a permutation of the parts. -} shuffle::Int -> Pattern a -> Pattern a-shuffle n = fit' 1 n (run n) (unwrap $ cycleChoose $ map listToPat $ - permutations [0..n-1])+shuffle n = fit' 1 n (_run n) (randpat n)+ where randpat n = Pattern $ \(s,e) -> arc (p n $ sam s) (s,e)+ p n c = listToPat $ map snd $ sort $ zip + [timeToRand (c+i/n') | i <- [0..n'-1]] [0..n-1]+ n' :: Time+ n' = fromIntegral n {- | `scramble n p` is like `shuffle` but randomly selects from the parts of `p` instead of making permutations. @@ -1332,34 +1404,46 @@ `"a"` `"b"` and `"c"`, possibly repeating a single part. -} scramble::Int -> Pattern a -> Pattern a-scramble n = fit' 1 n (run n) (density (fromIntegral n) $ +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)+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+ 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 ~> (f (e-s) 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' 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'- ps' = map (fmap (density t)) ps+ ps' = map (fmap (_density t)) ps adjust (a, (p, f)) = f a p transform (x:_) a = transform' x a transform _ _ = id- transform' str (s,e) p = s ~> (inside (1/(e-s)) (matchF str) p)+ transform' str (s,e) p = s `rotR` (inside (1/(e-s)) (matchF str) p) matchF str = fromMaybe id $ lookup str fs- twiddle f (s,e) p = s ~> (f (e-s) p) inhabit :: [(String, Pattern a)] -> Pattern String -> Pattern a inhabit ps p = unwrap' $ (\s -> fromMaybe silence $ lookup s ps) <$> p++repeatCycles :: Int -> Pattern a -> Pattern a+repeatCycles n p = fastcat (replicate n p)++{- | @spaceOut xs p@ repeats a pattern @p@ at different durations given by the list of time values in @xs@ -}+spaceOut :: [Time] -> Pattern a -> Pattern a+spaceOut xs p = _slow (toRational $ sum xs) $ stack $ map (\a -> compress a p) $ spaceArcs xs+ where markOut :: Time -> [Time] -> [(Time, Time)]+ markOut _ [] = []+ markOut offset (x:xs) = (offset,offset+x):(markOut (offset+x) xs)+ spaceArcs xs = map (\(a,b) -> (a/s,b/s)) $ markOut 0 xs+ s = sum xs+
Sound/Tidal/Strategies.hs view
@@ -19,7 +19,7 @@ import Data.List (transpose) stutter :: Integral i => i -> Time -> Pattern a -> Pattern a-stutter n t p = stack $ map (\i -> (t * (fromIntegral i)) ~> p) [0 .. (n-1)]+stutter n t p = stack $ map (\i -> (t * (fromIntegral i)) `rotR` p) [0 .. (n-1)] echo, triple, quad, double :: Time -> Pattern a -> Pattern a echo = stutter 2@@ -127,9 +127,9 @@ {- | an altenative form to `smash` is `smash'` which will use `chop` instead of `striate`. -} smash' n xs p = slowcat $ map (\n -> slow n p') xs- where p' = chop n p+ where p' = _chop n p --- samples "jvbass [~ latibro] [jvbass [latibro jvbass]]" ((1%2) <~ slow 6 "[1 6 8 7 3]")+-- samples "jvbass [~ latibro] [jvbass [latibro jvbass]]" ((1%2) `rotL` slow 6 "[1 6 8 7 3]") samples :: Applicative f => f String -> f Int -> f String samples p p' = pick <$> p <*> p'@@ -139,7 +139,7 @@ {- scrumple :: Time -> Pattern a -> Pattern a -> Pattern a-scrumple o p p' = p'' -- overlay p (o ~> p'')+scrumple o p p' = p'' -- overlay p (o `rotR` p'') where p'' = Pattern $ \a -> concatMap (\((s,d), vs) -> map (\x -> ((s,d), snd x@@ -164,10 +164,13 @@ d1 $ slow 3 $ spin 4 $ sound "drum*3 tabla:4 [arpy:2 ~ arpy] [can:2 can:3]" @ -}-spin :: Int -> ParamPattern -> ParamPattern-spin copies p =+spin :: Pattern Int -> ParamPattern -> ParamPattern+spin = temporalParam _spin++_spin :: Int -> ParamPattern -> ParamPattern+_spin copies p = stack $ map (\n -> let offset = toInteger n % toInteger copies in- offset <~ p+ offset `rotL` p # pan (pure $ fromRational offset) ) [0 .. (copies - 1)]@@ -185,7 +188,7 @@ rand4 = ((*4) <$> rand) stackwith p ps | null ps = silence- | otherwise = stack $ map (\(i, p') -> p' # (((fromIntegral i) % l) <~ p)) (zip [0 ..] ps)+ | otherwise = stack $ map (\(i, p') -> p' # (((fromIntegral i) % l) `rotL` p)) (zip [0 ..] ps) where l = fromIntegral $ length ps {-@@ -226,15 +229,18 @@ d1 $ chop 256 $ sound "bd*4 [sn cp] [hh future]*2 [cp feel]" @ -}-chop :: Int -> ParamPattern -> ParamPattern-chop n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA- where f queryA a = concatMap (chopEvent queryA) (arc p a)- chopEvent (queryS, queryE) (a,_a',v) = map (newEvent v) $ filter (\(_, (s,e)) -> not $ or [e < queryS, s >= queryE]) (enumerate $ chopArc a n)- newEvent :: ParamMap -> (Int, Arc) -> Event ParamMap- newEvent v (i, a) = (a,a,Map.insert (param dirt "end") (VF ((fromIntegral $ i+1)/(fromIntegral n))) $ Map.insert (param dirt "begin") (VF ((fromIntegral i)/(fromIntegral n))) v) -chop' tp p = unwrap $ (\tv -> chop tv p) <$> tp+chop :: Pattern Int -> ParamPattern -> ParamPattern+chop = temporalParam _chop +_chop :: Int -> ParamPattern -> ParamPattern+_chop n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA+ where f queryA a = concatMap (chopEvent queryA) (arc p a)+ chopEvent (queryS, queryE) (a,_a',v) = map (newEvent v) $ filter (\(_, (s,e)) -> not $ or [e < queryS, s >= queryE]) (enumerate $ chopArc a n)+ newEvent :: ParamMap -> (Int, Arc) -> Event ParamMap+ newEvent v (i, a) = (a,a,Map.insert (param dirt "end") (VF ((fromIntegral $ i+1)/(fromIntegral n))) $ Map.insert (param dirt "begin") (VF ((fromIntegral i)/(fromIntegral n))) v)++ {- | `gap` is similar to `chop` in that it granualizes every sample in place as it is played, but every other grain is silent. Use an integer value to specify how many granules each sample is chopped into:@@ -243,8 +249,12 @@ d1 $ gap 8 $ sound "jvbass" d1 $ gap 16 $ sound "[jvbass drum:4]" @-}-gap :: Int -> ParamPattern -> ParamPattern-gap n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA++gap :: Pattern Int -> ParamPattern -> ParamPattern+gap = temporalParam _gap++_gap :: Int -> ParamPattern -> ParamPattern+_gap n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA where f queryA a = concatMap (chopEvent queryA) (arc p a) chopEvent (queryS, queryE) (a,_a',v) = map (newEvent v) $ filter (\(_, (s,e)) -> not $ or [e < queryS, s >= queryE]) (enumerate $ everyOther $ chopArc a n) newEvent :: ParamMap -> (Int, Arc) -> Event ParamMap@@ -297,7 +307,7 @@ -} weave' :: Rational -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a weave' t p fs | l == 0 = silence- | otherwise = slow t $ stack $ map (\(i, f) -> (fromIntegral i % l) <~ (density t $ f (slow t p))) (zip [0 ..] fs)+ | otherwise = _slow t $ stack $ map (\(i, f) -> (fromIntegral i % l) `rotL` (_density t $ f (_slow t p))) (zip [0 ..] fs) where l = fromIntegral $ length fs {- | @@ -318,7 +328,7 @@ -- | Step sequencing step :: String -> String -> Pattern String-step s steps = cat $ map f steps+step s steps = fastcat $ map f steps where f c | c == 'x' = atom s | c >= '0' && c <= '9' = atom $ s ++ ":" ++ [c] | otherwise = silence@@ -328,17 +338,20 @@ -- | like `step`, but allows you to specify an array of strings to use for 0,1,2... step' :: [String] -> String -> Pattern String-step' ss steps = cat $ map f steps+step' ss steps = fastcat $ map f steps where f c | c == 'x' = atom $ ss!!0 | c >= '0' && c <= '9' = atom $ ss!!(Char.digitToInt c) | otherwise = silence -off :: Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-off t f p = superimpose (f . (t ~>)) p+off :: Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+off tp f p = unwrap $ (\tv -> _off tv f p) <$> tp -offadd :: Num a => Time -> a -> Pattern a -> Pattern a-offadd t n p = off t ((+n) <$>) p+_off :: Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+_off t f p = superimpose (f . (t `rotR`)) p +offadd :: Num a => Pattern Time -> Pattern a -> Pattern a -> Pattern a+offadd tp pn p = off tp (+pn) p+ {- | `up` does a poor man's pitchshift by semitones via `speed`. You can easily produce melodies from a single sample with up:@@ -352,7 +365,7 @@ up :: Pattern Double -> ParamPattern up = speed . ((1.059466**) <$>) -ghost'' a f p = superimpose (((a*2.5) ~>) . f) $ superimpose (((a*1.5) ~>) . f) $ p+ghost'' a f p = superimpose (((a*2.5) `rotR`) . f) $ superimpose (((a*1.5) `rotR`) . f) $ p ghost' a p = ghost'' 0.125 ((|*| gain (pure 0.7)) . (|=| end (pure 0.2)) . (|*| speed (pure 1.25))) p ghost p = ghost' 0.125 p @@ -376,8 +389,8 @@ d1 $ juxBy 0.6 (|*| speed "2") $ slowspread (loopAt) [4,6,2,3] $ chop 12 $ sound "fm:14" @ -}-loopAt :: Time -> ParamPattern -> ParamPattern-loopAt n p = slow n p |*| speed (pure $ fromRational $ 1/n) # unit (pure "c")+loopAt :: Pattern Time -> ParamPattern -> ParamPattern+loopAt n p = slow n p |*| speed (fromRational <$> (1/n)) # unit (pure "c") {- |@@ -391,8 +404,8 @@ where weft n = concatMap (\x -> [[0..n-1],(reverse [0..n-1])]) [0 .. (n `div` 2) - 1] warp = transpose . weft- thread xs n p = slow (n%1) $ cat $ map (\i -> zoom (i%n,(i+1)%n) p) (concat xs)+ thread xs n p = _slow (n%1) $ fastcat $ map (\i -> zoom (i%n,(i+1)%n) p) (concat xs) weftP n p = thread (weft n) n p warpP n p = thread (warp n) n p- maskedWeft n p = Sound.Tidal.Pattern.mask (every 2 rev $ density ((n)%2) "~ 1" :: Pattern Int) $ weftP n p- maskedWarp n p = mask (every 2 rev $ density ((n)%2) "1 ~" :: Pattern Int) $ warpP n p+ maskedWeft n p = Sound.Tidal.Pattern.mask (every 2 rev $ _density ((n)%2) "~ 1" :: Pattern Int) $ weftP n p+ maskedWarp n p = mask (every 2 rev $ _density ((n)%2) "1 ~" :: Pattern Int) $ warpP n p
Sound/Tidal/Stream.hs view
@@ -39,18 +39,43 @@ instance Show Param where show p = name p + data Shape = Shape {params :: [Param], latency :: Double, cpsStamp :: Bool} data Value = VS { svalue :: String } | VF { fvalue :: Double } | VI { ivalue :: Int }- deriving (Show,Eq,Ord,Typeable)+ deriving (Eq,Ord,Typeable) +instance Show Value where+ show (VS s) = s+ show (VF f) = show f+ show (VI i) = show i++class ParamType a where+ fromV :: Value -> Maybe a+ toV :: a -> Value++instance ParamType String where+ fromV (VS s) = Just s+ fromV _ = Nothing+ toV s = VS s++instance ParamType Double where+ fromV (VF f) = Just f+ fromV _ = Nothing+ toV f = VF f++instance ParamType Int where+ fromV (VI i) = Just i+ fromV _ = Nothing+ toV i = VI i+ type ParamMap = Map.Map Param Value type ParamPattern = Pattern ParamMap- + ticksPerCycle = 8 defaultValue :: Param -> Value@@ -162,6 +187,12 @@ defaultV a = toValue a --defaultV Nothing = defaultValue nParam +make' :: ParamType a => (a -> Value) -> Param -> Pattern a -> ParamPattern+make' toValue par p = fmap (\x -> Map.singleton par (toValue x)) p++makeP :: ParamType a => Param -> Pattern a -> ParamPattern+makeP par p = coerce par $ fmap (\x -> Map.singleton par (toV x)) p+ makeS = make VS makeF :: Shape -> String -> Pattern Double -> ParamPattern@@ -244,4 +275,55 @@ copyParam fromParam toParam pat = f <$> pat where f m = maybe m (updateValue m) (Map.lookup fromParam m) updateValue m v = Map.union m (Map.fromList [(toParam,v)])++get :: ParamType a => Param -> ParamPattern -> Pattern a+get param p = filterJust $ fromV <$> (filterJust $ Map.lookup param <$> p)++getI :: Param -> ParamPattern -> Pattern Int+getI = get+getF :: Param -> ParamPattern -> Pattern Double+getF = get+getS :: Param -> ParamPattern -> Pattern String+getS = get++with :: (ParamType a) => Param -> (Pattern a -> Pattern a) -> ParamPattern -> ParamPattern+with param f p = p # (makeP param) ((\x -> f (get param x)) p)+withI :: Param -> (Pattern Int -> Pattern Int) -> ParamPattern -> ParamPattern+withI = with+withF :: Param -> (Pattern Double -> Pattern Double) -> ParamPattern -> ParamPattern+withF = with+withS :: Param -> (Pattern String -> Pattern String) -> ParamPattern -> ParamPattern+withS = with++follow :: ParamType a => Param -> Param -> (Pattern a -> Pattern a) -> ParamPattern -> ParamPattern+follow source dest f p = p # (makeP dest $ f (get source p))++-- follow :: ParamType a => Param -> (Pattern a -> ParamPattern) -> ParamPattern -> ParamPattern+-- follow source dest p = p # (dest $ get source p)++follow' :: ParamType a => Param -> Param -> (Pattern a -> Pattern a) -> ParamPattern -> ParamPattern+follow' source dest f p = p # (makeP dest $ f (get source p))++followI :: Param -> Param -> (Pattern Int -> Pattern Int) -> ParamPattern -> ParamPattern+followI = follow'+followF :: Param -> Param -> (Pattern Double -> Pattern Double) -> ParamPattern -> ParamPattern+followF = follow'+followS :: Param -> Param -> (Pattern String -> Pattern String) -> ParamPattern -> ParamPattern+followS = follow'++-- with :: ParamType a => Param -> (Pattern a -> Pattern a) -> ParamPattern -> ParamPattern+-- with source f p = p # (makeP source $ f (get source p))+coerce :: Param -> ParamPattern -> ParamPattern+coerce par@(S _ _) p = (Map.update f par) <$> p+ where f (VS s) = Just (VS s)+ f (VI i) = Just (VS $ show i)+ f (VF f) = Just (VS $ show f)+coerce par@(I _ _) p = (Map.update f par) <$> p+ where f (VS s) = Just (VI $ read s)+ f (VI i) = Just (VI i)+ f (VF f) = Just (VI $ floor f)+coerce par@(F _ _) p = (Map.update f par) <$> p+ where f (VS s) = Just (VF $ read s)+ f (VI i) = Just (VF $ fromIntegral i)+ f (VF f) = Just (VF f)
Sound/Tidal/Transition.hs view
@@ -124,5 +124,5 @@ interpolateIn :: Time -> Time -> [ParamPattern] -> ParamPattern interpolateIn _ _ [] = silence interpolateIn _ _ (p:[]) = p-interpolateIn t now (p:p':_) = do n <- now ~> (slow t envL)+interpolateIn t now (p:p':_) = do n <- now `rotR` (_slow t envL) combineV (mixNums n) <$> p <*> p'
+ Sound/Tidal/Version.hs view
@@ -0,0 +1,4 @@++module Sound.Tidal.Version where++tidal_version = "0.9.1"
tidal.cabal view
@@ -1,14 +1,14 @@ name: tidal-version: 0.9+version: 0.9.1 synopsis: Pattern language for improvised music -- description:-homepage: http://tidal.lurk.org/+homepage: http://tidalcycles.org/ license: GPL-3 license-file: LICENSE author: Alex McLean maintainer: Alex McLean <alex@slab.org>, Mike Hodnick <mike.hodnick@gmail.com> Stability: Experimental-Copyright: (c) Alex McLean and other contributors, 2016+Copyright: (c) Tidal contributors, 2017 category: Sound build-type: Simple cabal-version: >=1.6@@ -35,6 +35,7 @@ Sound.Tidal.Transition Sound.Tidal.Scales Sound.Tidal.Chords+ Sound.Tidal.Version Build-depends: base < 5@@ -49,6 +50,7 @@ , safe , websockets > 0.8 , mtl >= 2.1+ , applicative-numbers source-repository head type: git
tidal.el view
@@ -59,7 +59,7 @@ (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")- (tidal-send-string "(cps, getNow) <- cpsUtils")+ (tidal-send-string "(cps, nudger, getNow) <- cpsUtils'") (tidal-send-string "(d1,t1) <- superDirtSetters getNow") (tidal-send-string "(d2,t2) <- superDirtSetters getNow") (tidal-send-string "(d3,t3) <- superDirtSetters getNow")@@ -144,9 +144,9 @@ (interactive) (tidal-send-string "now' <- getNow") (tidal-send-string "let now = nextSam now'")- (tidal-send-string "let retrig = (now ~>)")- (tidal-send-string "let fadeOut n = spread' (degradeBy) (retrig $ slow n $ envL)")- (tidal-send-string "let fadeIn n = spread' (degradeBy) (retrig $ slow n $ (1-) <$> envL)")+ (tidal-send-string "let retrig = (now `rotR`)")+ (tidal-send-string "let fadeOut n = spread' (_degradeBy) (retrig $ slow n $ envL)")+ (tidal-send-string "let fadeIn n = spread' (_degradeBy) (retrig $ slow n $ (1-) <$> envL)") )