tidal 0.9.9 → 0.9.10
raw patch · 15 files changed
+463/−124 lines, 15 filesdep +monad-loops
Dependencies added: monad-loops
Files
- README.md +1/−1
- Sound/Tidal/Chords.hs +5/−0
- Sound/Tidal/Context.hs +2/−1
- Sound/Tidal/Dirt.hs +2/−1
- Sound/Tidal/EspGrid.hs +114/−0
- Sound/Tidal/MultiMode.hs +106/−0
- Sound/Tidal/Params.hs +3/−0
- Sound/Tidal/Parse.hs +6/−3
- Sound/Tidal/Pattern.hs +128/−70
- Sound/Tidal/Simple.hs +39/−0
- Sound/Tidal/Strategies.hs +28/−21
- Sound/Tidal/Stream.hs +3/−3
- Sound/Tidal/Tempo.hs +20/−22
- Sound/Tidal/Version.hs +1/−1
- tidal.cabal +5/−1
README.md view
@@ -5,7 +5,7 @@ Language for live coding of pattern For documentation, mailing list and more info see here:- http://tidal.lurk.org/+ https://tidalcycles.org/ (c) Alex McLean and contributors, 2016
Sound/Tidal/Chords.hs view
@@ -159,3 +159,8 @@ -- numbers, representing note value offsets for the chords chord :: Num a => Pattern String -> Pattern a chord p = flatpat $ chordL p++-- | @arpg p@ turns a pattern of chord names into a pattern of arpeggios+-- of the those chords respectively+arpg :: Num a => Pattern String -> Pattern a+arpg p = breakUp $ chord p
Sound/Tidal/Context.hs view
@@ -17,10 +17,11 @@ import Sound.Tidal.SuperCollider as C import Sound.Tidal.Params as C import Sound.Tidal.Transition as C+import Sound.Tidal.EspGrid as C+import Sound.Tidal.MultiMode as C import Sound.Tidal.Version as C import Sound.Tidal.Chords as C (chord) import Sound.Tidal.Scales as C (scaleP) import qualified Sound.Tidal.Scales as C.Scales import qualified Sound.Tidal.Chords as C.Chords-
Sound/Tidal/Dirt.hs view
@@ -55,7 +55,8 @@ n_p, attack_p, hold_p,- release_p+ release_p,+ orbit_p ], cpsStamp = True, latency = 0.3
+ Sound/Tidal/EspGrid.hs view
@@ -0,0 +1,114 @@+module Sound.Tidal.EspGrid where + +import Control.Concurrent.MVar +import Control.Concurrent +import Control.Monad (forever) +import Control.Monad.Loops (iterateM_) +import Sound.OSC.FD +import Data.Time.Clock +import Data.Time.Clock.POSIX +import Data.Time.Calendar (fromGregorian) + +import Sound.Tidal.Tempo +import Sound.Tidal.Time as T +import Sound.Tidal.Stream +import Sound.Tidal.Dirt +import Sound.Tidal.Transition (transition) +import Sound.Tidal.Pattern (silence) + +parseEspTempo :: [Datum] -> Maybe Tempo +parseEspTempo d = do + on <- datum_integral (d!!0) + bpm <- datum_floating (d!!1) + t1 <- datum_integral (d!!2) + t2 <- datum_integral (d!!3) + n <- datum_integral (d!!4) + let nanos = (t1*1000000000) + t2 + let utc = posixSecondsToUTCTime ((realToFrac nanos)/1000000000) + return (Tempo utc (fromIntegral n) (bpm/60) (on==0) 0.04) + +changeTempo :: MVar Tempo -> Packet -> IO () +changeTempo mvar (Packet_Message msg) = do + case parseEspTempo (messageDatum msg) of + Just t -> tryTakeMVar mvar >> putMVar mvar t + Nothing -> putStrLn "Unable to parse message as Tempo" +changeTempo _ _ = putStrLn "Can only process Packet_Message" + +getTempo :: MVar Tempo -> IO Tempo +getTempo = readMVar + +runClientEsp :: IO (MVar Tempo,MVar Double) +runClientEsp = do + mTempo <- newEmptyMVar + mCps <- newEmptyMVar + socket <- openUDP "127.0.0.1" 5510 + forkIO $ forever $ do + sendOSC socket $ Message "/esp/tempo/q" [] + response <- waitAddress socket "/esp/tempo/r" + changeTempo mTempo response + threadDelay 100000 + return (mTempo, mCps) + +sendEspTempo :: Real t => t -> IO () +sendEspTempo t = do + socket <- openUDP "127.0.0.1" 5510 + sendOSC socket $ Message "/esp/beat/tempo" [float (t*60)] + +cpsUtilsEsp :: IO (Double -> IO (), IO Rational, IO Tempo) +cpsUtilsEsp = do + (mTempo,mCps) <- runClientEsp + return (sendEspTempo,getCurrentBeat mTempo,getTempo mTempo) + +clockedTickEsp :: Int -> (Tempo -> Int -> IO ()) -> IO () +clockedTickEsp tpb callback = do + (mTempo, _) <- runClientEsp + nowBeat <- getCurrentBeat mTempo + let nextTick = ceiling (nowBeat * (fromIntegral tpb)) + iterateM_ (clockedTickLoopEsp tpb callback mTempo) nextTick + +clockedTickLoopEsp :: Int -> (Tempo -> Int -> IO ()) -> MVar Tempo -> Int -> IO Int +clockedTickLoopEsp tpb callback mTempo tick = do + tempo <- readMVar mTempo + if (paused tempo) + then do -- TODO - do this via blocking read on the mvar somehow rather than polling + let pause = 0.01 + threadDelay $ floor (pause * 1000000) + return $ if cps tempo < 0 then 0 else tick -- reset tick to 0 if cps is negative + else do + now <- getCurrentTime + let beatsFromAtToTick = fromIntegral tick / fromIntegral tpb - beat tempo + delayUntilTick = beatsFromAtToTick / cps tempo - realToFrac (diffUTCTime now (at tempo)) + threadDelay $ floor (delayUntilTick * 1000000) + callback tempo tick + return $ tick + 1 + +streamEsp :: Backend a -> Shape -> IO (ParamPattern -> IO ()) +streamEsp backend shape = do + patternM <- newMVar silence + forkIO $ clockedTickEsp ticksPerCycle (onTick backend shape patternM) + return $ \p -> do swapMVar patternM p + return () + +dirtStreamEsp :: IO (ParamPattern -> IO ()) +dirtStreamEsp = do + backend <- dirtBackend + streamEsp backend dirt + +stateEsp :: Backend a -> Shape -> IO (MVar (ParamPattern, [ParamPattern])) +stateEsp backend shape = do + patternsM <- newMVar (silence, []) + let ot = (onTick' backend shape patternsM) :: Tempo -> Int -> IO () + forkIO $ clockedTickEsp ticksPerCycle ot + return patternsM + +dirtSettersEsp :: IO T.Time -> IO (ParamPattern -> IO (), (T.Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ()) +dirtSettersEsp getNow = do + backend <- dirtBackend + ds <- stateEsp backend dirt + return (setter ds, transition getNow ds) + +superDirtSettersEsp :: IO T.Time -> IO (ParamPattern -> IO (), (T.Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ()) +superDirtSettersEsp getNow = do + backend <- superDirtBackend 57120 + ds <- stateEsp backend dirt + return (setter ds, transition getNow ds)
+ Sound/Tidal/MultiMode.hs view
@@ -0,0 +1,106 @@+module Sound.Tidal.MultiMode where + +import Control.Concurrent.MVar +import Control.Concurrent +import Control.Monad (forever) +import Control.Monad.Loops (iterateM_) +import Sound.OSC.FD +import Data.Time.Clock +import Data.Time.Clock.POSIX +import Data.Time.Calendar (fromGregorian) + +import Sound.Tidal.Tempo +import Sound.Tidal.Time as T +import Sound.Tidal.Stream +import Sound.Tidal.Dirt +import Sound.Tidal.EspGrid +import Sound.Tidal.Transition (transition) +import Sound.Tidal.Pattern (silence) + +data StreamType = Dirt | SuperDirt + +data SyncType = NoSync | Esp + +initializeStreamType :: IO (MVar StreamType) +initializeStreamType = newMVar SuperDirt + +changeStreamType :: MVar StreamType -> StreamType -> IO (IO StreamType) +changeStreamType mvar t = return (swapMVar mvar t) + +initializeSyncType :: IO (MVar SyncType) +initializeSyncType = newMVar NoSync + +changeSyncType :: MVar SyncType -> SyncType -> IO (IO SyncType) +changeSyncType mvar t = return (swapMVar mvar t) + +type CpsUtils = (Double -> IO(), IO Rational) + +multiModeCpsUtils :: CpsUtils -> CpsUtils -> MVar SyncType -> IO CpsUtils +multiModeCpsUtils (cpsNone,getNowNone) (cpsEsp,getNowEsp) mSync = return (cps,getNow) + where cps x = do s <- readMVar mSync + case s of NoSync -> cpsNone x + Esp -> cpsEsp x + getNow = do s <- readMVar mSync + case s of NoSync -> getNowNone + Esp -> getNowEsp + +multiModeSetters :: IO Rational -> IO Rational -> MVar SyncType -> MVar StreamType -> IO (ParamPattern -> IO ()) +multiModeSetters getNowNone getNowEsp mSync mStream = do + (classicDirt,tClassic) <- dirtSetters getNowNone + (espDirt,tEsp) <- dirtSettersEsp getNowEsp + (superDirt,tSuper) <- superDirtSetters getNowNone + (espSuperDirt,tEspSuper) <- superDirtSettersEsp getNowEsp + let f NoSync Dirt p = do classicDirt p + espDirt silence + superDirt silence + espSuperDirt silence + f Esp Dirt p = do espDirt p + classicDirt silence + superDirt silence + espSuperDirt silence + f NoSync SuperDirt p = do superDirt p + classicDirt silence + espDirt silence + espSuperDirt silence + f Esp SuperDirt p = do espSuperDirt p + classicDirt silence + espDirt silence + superDirt silence + return $ \p -> readMVar mSync >>= \s -> readMVar mStream >>= \t -> f s t p + +{- + +Example of using the above definitions: +(note: if using Atom, evaluate each of the lines below one by one using shift-Enter) + +syncType <- initializeSyncType +nosync <- changeSyncType syncType NoSync +esp <- changeSyncType syncType Esp +(cpsNone,getNowNone) <- cpsUtils +(cpsEsp,getNowEsp,getTempoEsp) <- cpsUtilsEsp +(cps,getNow) <- multiModeCpsUtils (cpsNone,getNowNone) (cpsEsp,getNowEsp) syncType + +streamType <- initializeStreamType +classicDirt <- changeStreamType streamType Dirt +superDirt <- changeStreamType streamType SuperDirt +d1 <- multiModeSetters getNowNone getNowEsp syncType streamType +d2 <- multiModeSetters getNowNone getNowEsp syncType streamType +d3 <- multiModeSetters getNowNone getNowEsp syncType streamType +d4 <- multiModeSetters getNowNone getNowEsp syncType streamType +d5 <- multiModeSetters getNowNone getNowEsp syncType streamType +d6 <- multiModeSetters getNowNone getNowEsp syncType streamType +d7 <- multiModeSetters getNowNone getNowEsp syncType streamType +d8 <- multiModeSetters getNowNone getNowEsp syncType streamType +d9 <- multiModeSetters getNowNone getNowEsp syncType streamType +d10 <- multiModeSetters getNowNone getNowEsp syncType streamType + +let bps x = cps (x/2) +let hush = mapM_ ($ silence) [d1,d2,d3,d4,d5,d6,d7,d8,d9,d10] +let solo = (>>) hush + +then you can evaluate "classicDirt" to switch to classic Dirt +and "superDirt" to switch back to SuperDirt (the default) +and "esp" to turn on EspGrid-aware synchronization +and "nosync" to switch off EspGrid-aware synchronization (the default) +(switching between sync types is only noticeable after the next time a pattern is redefined right now) +-}
Sound/Tidal/Params.hs view
@@ -157,6 +157,9 @@ (lclaves, lclaves_p) = pF "lclaves" (Just 0) (lclhat, lclhat_p) = pF "lclhat" (Just 0) (lcrash, lcrash_p) = pF "lcrash" (Just 0)+(leslie, leslie_p) = pF "leslie" (Just 0)+(lrate, lrate_p) = pF "lrate" (Just 0)+(lsize, lsize_p) = pF "lsize" (Just 0) (lfo, lfo_p) = pF "lfo" (Just 0) (lfocutoffint, lfocutoffint_p) = pF "lfocutoffint" (Just 0) (lfodelay, lfodelay_p) = pF "lfodelay" (Just 0)
Sound/Tidal/Parse.hs view
@@ -74,7 +74,7 @@ TPat_Overlay x0 x1 -> overlay (toPat x0) (toPat x1) 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)+ unwrap $ _eoff <$> toPat n <*> toPat k <*> toPat s <*> pure (toPat thing) TPat_Foot -> error "Can't happen, feet (.'s) only used internally.." TPat_EnumFromTo a b -> unwrap $ fromTo <$> (toPat a) <*> (toPat b) -- TPat_EnumFromThenTo a b c -> unwrap $ fromThenTo <$> (toPat a) <*> (toPat b) <*> (toPat c)@@ -382,8 +382,11 @@ <|> return (TPat_Atom 0) return (a, b, c) -eoff :: Int -> Int -> Integer -> Pattern a -> Pattern a-eoff n k s p = ((s%(fromIntegral k)) `rotL`) (e n k p)+eoff :: Pattern Int -> Pattern Int -> Pattern Integer -> Pattern a -> Pattern a+eoff = temporalParam3 _eoff++_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) pReplicate :: Parseable a => TPat a -> Parser [TPat a]
Sound/Tidal/Pattern.hs view
@@ -14,7 +14,7 @@ import Data.Typeable import Data.Function import System.Random.Mersenne.Pure64--- import Data.Char+import Data.Char (digitToInt) import qualified Data.Text as T import Sound.Tidal.Time@@ -34,7 +34,7 @@ -- values. For discrete patterns, this returns the events which are -- active during that time. For continuous patterns, events with -- values for the midpoint of the given @Arc@ is returned.-data Pattern a = Pattern {arc :: Arc -> [Event a]}+newtype Pattern a = Pattern {arc :: Arc -> [Event a]} deriving Typeable noOv :: String -> a@@ -123,7 +123,7 @@ -- | @show (p :: Pattern)@ returns a text string representing the -- event values active during the first cycle of the given pattern. instance (Show a) => Show (Pattern a) where- show p@(Pattern _) = intercalate " " $ map showEvent $ arc p (0, 1)+ show p@(Pattern _) = unwords $ map showEvent $ arc p (0, 1) -- | converts a ratio into human readable string, e.g. @1/3@ showTime :: (Show a, Integral a) => Ratio a -> String@@ -132,7 +132,7 @@ -- | converts a time arc into human readable string, e.g. @1/3 3/4@ showArc :: Arc -> String-showArc a = concat[showTime $ fst a, (' ':showTime (snd a))]+showArc a = (showTime $ fst a) ++ (' ':showTime (snd a)) -- | converts an event into human readable string, e.g. @("bd" 1/4 2/3)@ showEvent :: (Show a) => Event a -> String@@ -191,7 +191,7 @@ p >>= f = unwrap (f <$> p) unwrap :: Pattern (Pattern a) -> Pattern a-unwrap p = Pattern $ \a -> concatMap (\(_, outerPart, p') -> catMaybes $ map (munge outerPart) $ arc p' a) (arc p a)+unwrap p = Pattern $ \a -> concatMap (\(_, outerPart, p') -> mapMaybe (munge outerPart) $ arc p' a) (arc p a) where munge a (whole,part,v) = do part' <- subArc a part return (whole, part',v) @@ -246,7 +246,7 @@ -- | @stack@ combines a list of @Pattern@s into a new pattern, so that -- their events are combined over time. stack :: [Pattern a] -> Pattern a-stack ps = foldr overlay silence ps+stack = foldr overlay silence -- | @append@ combines two patterns @Pattern@s into a new pattern, so -- that the events of the second pattern are appended to those of the@@ -269,7 +269,7 @@ 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)+ where trimArc s' (s,e) = (max s' s, min (s'+1) e) -- | @slowcat@ does the same as @fastcat@, but maintaining the duration of -- the original patterns. It is the equivalent of @append'@, but with@@ -297,7 +297,7 @@ listToPat = fastcat . map atom patToList :: Pattern a -> [a]-patToList p = map (thd') $ sortBy (\a b -> compare (snd' a) (snd' b)) $ filter ((\x -> x >= 0 && x < 1) . fst . snd' ) (arc p (0,1))+patToList p = map thd' $ sortBy (\a b -> compare (snd' a) (snd' b)) $ filter ((\x -> x >= 0 && x < 1) . fst . snd' ) (arc p (0,1)) -- | @maybeListToPat@ is similar to @listToPat@, but allows values to -- be optional using the @Maybe@ type, so that @Nothing@ results in@@ -321,7 +321,7 @@ _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 f tv p = unwrap $ (`f` p) <$> tv temporalParam2 :: (a -> b -> Pattern c -> Pattern d) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d) temporalParam2 f a b p = unwrap $ (\x y -> f x y p) <$> a <*> b@@ -330,7 +330,7 @@ temporalParam3 f a b c p = unwrap $ (\x y z -> f x y z p) <$> a <*> b <*> c temporalParam' :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c)-temporalParam' f tv p = unwrap' $ (\v -> f v p) <$> tv+temporalParam' f tv p = unwrap' $ (`f` p) <$> tv temporalParam2' :: (a -> b -> Pattern c -> Pattern d) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d) temporalParam2' f a b p = unwrap' $ (\x y -> f x y p) <$> a <*> b@@ -358,7 +358,7 @@ _density :: Time -> Pattern a -> Pattern a _density r p | r == 0 = silence- | r < 0 = rev $ _density (0-r) p+ | r < 0 = rev $ _density (negate r) p | otherwise = withResultTime (/ r) $ withQueryTime (* r) p -- | @fastGap@ (also known as @densityGap@ is similar to @fast@ but maintains its cyclic@@ -399,7 +399,7 @@ -- | The @~>@ operator does the same as @<~@ but shifts events to the -- right (or clockwise) rather than to the left. rotR :: Time -> Pattern a -> Pattern a-rotR = (rotL) . (0-)+rotR = rotL . (0-) (~>) :: Pattern Time -> Pattern a -> Pattern a (~>) = temporalParam rotR@@ -539,92 +539,75 @@ where f' (s,e) | s > e = [] | otherwise = [((s,e), (s,e), f s)] --- | @sinewave@ returns a @Pattern@ of continuous @Double@ values following a+-- | @sinewave@ returns a @Pattern@ of continuous @Fractional@ values following a -- sinewave with frequency of one cycle, and amplitude from 0 to 1.-sinewave :: Pattern Double-sinewave = sig $ \t -> ((sin $ pi * 2 * (fromRational t)) + 1) / 2+sinewave :: Fractional a => Pattern a+sinewave = sig $ \t -> ((sin_rat $ pi * 2 * (fromRational t)) + 1) / 2+ where sin_rat = fromRational . toRational . sin -- | @sine@ is a synonym for @sinewave@.-sine :: Pattern Double+sine :: Fractional a => Pattern a sine = sinewave -- | @sine@ is a synonym for @0.25 ~> sine@.-cosine :: Pattern Double+cosine :: Fractional a => Pattern a cosine = 0.25 ~> sine --- | @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- -- | @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 :: Fractional a => a -> Pattern a sineAmp offset = (+ offset) <$> sinewave1 -- | @sawwave@ is the equivalent of @sinewave@ for (ascending) sawtooth waves.-sawwave :: Pattern Double+sawwave :: (Fractional a, Real a) => Pattern a sawwave = sig $ \t -> mod' (fromRational t) 1 -- | @saw@ is a synonym for @sawwave@.-saw :: Pattern Double+saw :: (Fractional a, Real a) => Pattern a 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- -- | @triwave@ is the equivalent of @sinewave@ for triangular waves.-triwave :: Pattern Double+triwave :: (Fractional a, Real a) => Pattern a triwave = append sawwave1 (rev sawwave1) -- | @tri@ is a synonym for @triwave@.-tri :: Pattern Double+tri :: (Fractional a, Real a) => Pattern a 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- -- | @squarewave1@ is the equivalent of @sinewave@ for square waves.-squarewave :: Pattern Double+squarewave :: (Fractional a, Real a) => Pattern a squarewave = sig $ \t -> fromIntegral $ ((floor $ (mod' (fromRational t :: Double) 1) * 2) :: Integer) -- | @square@ is a synonym for @squarewave@.-square :: Pattern Double+square :: (Fractional a, Real a) => Pattern a square = squarewave -- deprecated..-sinewave1 :: Pattern Double+sinewave1 :: Fractional a => Pattern a sinewave1 = sinewave-sine1 :: Pattern Double+sine1 :: Fractional a => Pattern a sine1 = sinewave-sinerat1 :: Pattern Rational-sinerat1 = sinerat-sineAmp1 :: Double -> Pattern Double+sinerat = sine+ratsine = sine+sinerat1 = sine+sineAmp1 :: Fractional a => a -> Pattern a sineAmp1 = sineAmp-sawwave1 :: Pattern Double+sawwave1 :: (Fractional a, Real a) => Pattern a sawwave1 = sawwave-saw1 :: Pattern Double+saw1 :: (Fractional a, Real a) => Pattern a saw1 = sawwave-sawrat1 :: Pattern Rational-sawrat1 = sawrat-triwave1 :: Pattern Double+sawrat = saw+sawrat1 = saw+triwave1 :: (Fractional a, Real a) => Pattern a triwave1 = triwave-tri1 :: Pattern Double+tri1 :: (Fractional a, Real a) => Pattern a tri1 = triwave-trirat1 :: Pattern Rational-trirat1 = trirat-squarewave1 :: Pattern Double+trirat = tri+trirat1 = tri+squarewave1 :: (Fractional a, Real a) => Pattern a squarewave1 = squarewave-square1 :: Pattern Double+square1 :: (Fractional a, Real a) => Pattern a square1 = square -- | @envL@ is a @Pattern@ of continuous @Double@ values, representing@@ -714,7 +697,7 @@ After `(# speed "0.8")`, the transforms will repeat and start at `density 2` again. -} spread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b-spread f xs p = slowcat $ map (\x -> f x p) xs+spread f xs p = slowcat $ map (`f` p) xs slowspread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b slowspread = spread@@ -967,6 +950,9 @@ someCycles :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a someCycles = someCyclesBy 0.5 +somecycles :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a+somecycles = someCycles+ {- | `degrade` randomly removes events from a pattern 50% of the time: @@@ -1113,6 +1099,45 @@ playWhen (\t -> not $ cyclePos t >= s && cyclePos t < e) $ p ] +{- |+For many cases, @within'@ will function exactly as within. +The difference between the two occurs when applying functions that change the timing of notes such as 'fast' or '<~'. +within first applies the function to all notes in the cycle, then keeps the results in the specified interval, and then combines it with the old cycle (an "apply split combine" paradigm). +within' first keeps notes in the specified interval, then applies the function to these notes, and then combines it with the old cycle (a "split apply combine" paradigm).+++For example, whereas using the standard version of within++@+d1 $ within (0, 0.25) (fast 2) $ sound "bd hh cp sd"+@++sounds like:++@+d1 $ sound "[bd hh] hh cp sd"+@++using this alternative version, within'++@+d1 $ within' (0, 0.25) (fast 2) $ sound "bd hh cp sd"+@++sounds like: ++@+d1 $ sound "[bd bd] hh cp sd"+@++-}++within' :: Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+within' (s,e) f p = stack [playWhen (\t -> cyclePos t >= s && cyclePos t < e) $ compress (s,e) $ f $ zoom (s,e) $ p, + playWhen (\t -> not $ cyclePos t >= s && cyclePos t < e) $ p + ]++ revArc :: Arc -> Pattern a -> Pattern a revArc a = within a rev @@ -1160,14 +1185,25 @@ - (13,24,5) : Another rhythm necklace of the Aka Pygmies of the upper Sangha. @ -}-e :: Int -> Int -> Pattern a -> Pattern a-e n k p = (flip const) <$> (filterValues (== True) $ listToPat $ bjorklund (n,k)) <*> p+e :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a+e = temporalParam2 _e -e' :: Int -> Int -> Pattern a -> Pattern a-e' n k p = fastcat $ map (\x -> if x then p else silence) (bjorklund (n,k))+_e :: Int -> Int -> Pattern a -> Pattern a+_e n k p = (flip const) <$> (filterValues (== True) $ listToPat $ bjorklund (n,k)) <*> p -distrib :: [Int] -> Pattern a -> Pattern a-distrib xs p = boolsToPat (foldr (distrib') (replicate (head $ reverse xs) True) (reverse $ layers xs)) p+e' :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a+e' = temporalParam2 _e'++_e' :: Int -> Int -> Pattern a -> Pattern a+_e' n k p = fastcat $ map (\x -> if x then p else silence) (bjorklund (n,k))+++distrib :: [Pattern Int] -> Pattern a -> Pattern a+distrib steps p = do steps' <- sequence steps+ _distrib steps' p++_distrib :: [Int] -> Pattern a -> Pattern a+_distrib xs p = boolsToPat (foldr (distrib') (replicate (last xs) True) (reverse $ layers xs)) p where distrib' :: [Bool] -> [Bool] -> [Bool] distrib' [] _ = []@@ -1183,11 +1219,14 @@ @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+einv :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a+einv = temporalParam2 _einv +_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 :: Pattern Int -> Pattern 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@@ -1453,6 +1492,11 @@ ++ (lindenmayer 1 r cs) lindenmayer n r s = iterate (lindenmayer 1 r) s !! n +{- | @lindenmayerI@ converts the resulting string into a a list of integers+with @fromIntegral@ applied (so they can be used seamlessly where floats or+rationals are required) -}+lindenmayerI n r s = fmap fromIntegral $ fmap digitToInt $ lindenmayer n r s+ -- support for fit' unwrap' :: Pattern (Pattern a) -> Pattern a unwrap' pp = Pattern $ \a -> arc (stack $ map scalep (arc pp a)) a@@ -1668,7 +1712,7 @@ breakUp :: Pattern a -> Pattern a breakUp p = Pattern $ \a -> munge $ arc p a where munge es = concatMap spreadOut (groupBy (\a b -> fst' a == fst' b) es)- spreadOut xs = catMaybes $ map (\(n, x) -> shiftIt n (length xs) x) $ enumerate xs+ spreadOut xs = mapMaybe (\(n, x) -> shiftIt n (length xs) x) $ enumerate xs shiftIt n d ((s,e), a', v) = do a'' <- subArc (newS, newE) a' return ((newS, newE), a'', v) where newS = s + (dur*(fromIntegral n))@@ -1689,6 +1733,20 @@ | otherwise = [(s',e')] -- miss arcToEvent a = (a,a,"x") removeTolerance (s,e) es = concatMap (expand) $ mapSnds' f es- where f (a) = concatMap (remove' (e,e+tolerance)) $ remove' (s-tolerance,s) a+ where f a = concatMap (remove' (e,e+tolerance)) $ remove' (s-tolerance,s) a expand (a,xs,c) = map (\x -> (a,x,c)) xs tolerance = 0.01++-- Repeats each event @n@ times within its arc+ply :: Pattern Int -> Pattern a -> Pattern a+ply = temporalParam _ply++_ply :: Int -> Pattern a -> Pattern a+_ply n p = breakUp $ stack (replicate n p)++-- Uses the first (binary) pattern to switch between the following two+-- patterns. +sew :: Pattern Bool -> Pattern a -> Pattern a -> Pattern a+sew stitch p1 p2 = overlay (const <$> p1 <*> a) (const <$> p2 <*> b)+ where a = filterValues (id) stitch+ b = filterValues (not . id) stitch
+ Sound/Tidal/Simple.hs view
@@ -0,0 +1,39 @@+module Sound.Tidal.Simple where++import Sound.Tidal.Context++crunch :: ParamPattern -> ParamPattern+crunch = (# crush 3)++scratch :: ParamPattern -> ParamPattern+scratch = rev . chop 32++louder :: ParamPattern -> ParamPattern+louder = (|*| gain 1.2)++quieter :: ParamPattern -> ParamPattern+quieter = (|*| gain 0.8)++mute :: ParamPattern -> ParamPattern+mute = const silence++jump :: ParamPattern -> ParamPattern+jump = (0.25 <~)++left :: ParamPattern -> ParamPattern+left = (# pan 0)++right :: ParamPattern -> ParamPattern+right = (# pan 1)++higher :: ParamPattern -> ParamPattern+higher = (|*| speed 1.5)++lower :: ParamPattern -> ParamPattern+lower = (|*| speed 0.75)++faster :: ParamPattern -> ParamPattern+faster = hurry 2++slower :: ParamPattern -> ParamPattern+slower = hurry 0.5
Sound/Tidal/Strategies.hs view
@@ -51,7 +51,7 @@ juxcut' fs p = stack $ map (\n -> ((fs !! n) p |+| cut (pure $ 1-n)) # pan (pure $ fromIntegral n / fromIntegral l)) [0 .. l-1] where l = length fs- + {- | In addition to `jux`, `jux'` allows using a list of pattern transform. resulting patterns from each transformation will be spread via pan from left to right. For example:@@ -65,17 +65,17 @@ One could also write: @-d1 $ stack [ - iter 4 $ sound "bd sn" # pan "0", - chop 16 $ sound "bd sn" # pan "0.25", - sound "bd sn" # pan "0.5", - rev $ sound "bd sn" # pan "0.75", - palindrome $ sound "bd sn" # pan "1", - ] +d1 $ stack [+ iter 4 $ sound "bd sn" # pan "0",+ chop 16 $ sound "bd sn" # pan "0.25",+ sound "bd sn" # pan "0.5",+ rev $ sound "bd sn" # pan "0.75",+ palindrome $ sound "bd sn" # pan "1",+ ] @ -}-jux' fs p = stack $ map (\n -> ((fs !! n) p) # pan (pure $ fromIntegral n / fromIntegral l)) [0 .. l-1]+jux' fs p = stack $ map (\n -> ((fs !! n) p) |+| pan (pure $ fromIntegral n / fromIntegral l)) [0 .. l-1] where l = length fs -- | Multichannel variant of `jux`, _not sure what it does_@@ -95,7 +95,7 @@ In the above, the two versions of the pattern would be panned at 0.25 and 0.75, rather than 0 and 1. -}-juxBy n f p = stack [p |+| pan (pure $ 0.5 - (n/2)), f $ p |+| pan (pure $ 0.5 + (n/2))]+juxBy n f p = stack [p |+| pan 0.5 |-| pan (n/2), f $ p |+| pan 0.5 |+| pan (n/2)] {- | Smash is a combination of `spread` and `striate` - it cuts the samples into the given number of bits, and then cuts between playing the loop@@ -285,7 +285,7 @@ en :: [(Int, Int)] -> Pattern String -> Pattern String-en ns p = stack $ map (\(i, (k, n)) -> e k n (samples p (pure i))) $ enumerate ns+en ns p = stack $ map (\(i, (k, n)) -> _e k n (samples p (pure i))) $ enumerate ns {- | `weave` applies a function smoothly over an array of different patterns. It uses an `OscPattern` to@@ -310,7 +310,7 @@ | 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 -{- | +{- | (A function that takes two OscPatterns, and blends them together into a new OscPattern. An OscPattern is basically a pattern of messages to a synthesiser.)@@ -330,7 +330,7 @@ step :: String -> String -> Pattern String step s steps = fastcat $ map f steps where f c | c == 'x' = atom s- | c >= '0' && c <= '9' = atom $ s ++ ":" ++ [c]+ | Char.isDigit c = atom $ s ++ ":" ++ [c] | otherwise = silence steps :: [(String, String)] -> Pattern String@@ -339,8 +339,8 @@ -- | 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 = fastcat $ map f steps- where f c | c == 'x' = atom $ ss!!0- | c >= '0' && c <= '9' = atom $ ss!!(Char.digitToInt c)+ where f c | c == 'x' = atom $ head ss+ | Char.isDigit c = atom $ ss!!(Char.digitToInt c) | otherwise = silence off :: Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a@@ -367,16 +367,23 @@ 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 +ghost p = ghost' 0.125 p -slice :: Int -> Int -> ParamPattern -> ParamPattern-slice i n p = ++slice :: Pattern Int -> Pattern Int -> ParamPattern -> ParamPattern+slice pi pn p = begin b # end e # p+ where b = (\i n -> (div' i n)) <$> pi <*> pn+ e = (\i n -> (div' i n) + (div' 1 n)) <$> pi <*> pn+ div' a b = fromIntegral (a `mod` b) / fromIntegral b++_slice :: Int -> Int -> ParamPattern -> ParamPattern+_slice i n p = p # begin (pure $ fromIntegral i / fromIntegral n) # end (pure $ fromIntegral (i+1) / fromIntegral n) randslice :: Int -> ParamPattern -> ParamPattern-randslice n p = unwrap $ (\i -> slice i n p) <$> irand n+randslice n p = unwrap $ (\i -> _slice i n p) <$> irand n {- | `loopAt` makes a sample fit the given number of cycles. Internally, it@@ -387,7 +394,7 @@ @ d1 $ loopAt 4 $ sound "breaks125" d1 $ juxBy 0.6 (|*| speed "2") $ slowspread (loopAt) [4,6,2,3] $ chop 12 $ sound "fm:14"-@ +@ -} loopAt :: Pattern Time -> ParamPattern -> ParamPattern loopAt n p = slow n p |*| speed (fromRational <$> (1/n)) # unit (pure "c")@@ -401,7 +408,7 @@ tabby n p p' = stack [maskedWarp n p, maskedWeft n p' ]- where + 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) $ fastcat $ map (\i -> zoom (i%n,(i+1)%n) p) (concat xs)
Sound/Tidal/Stream.hs view
@@ -13,9 +13,10 @@ import Data.Typeable import Sound.Tidal.Pattern import qualified Sound.Tidal.Parse as P-import Sound.Tidal.Tempo (Tempo, logicalTime, clocked,clockedTick,cps)+import Sound.Tidal.Tempo (Tempo, logicalTime, clockedTick,cps) import Sound.Tidal.Utils import qualified Sound.Tidal.Time as T+import System.IO (stderr, hPutStrLn) import qualified Data.Map.Strict as Map @@ -162,7 +163,7 @@ messages = mapMaybe (toMessage backend shape change ticks) (seqToRelOnsetDeltas (a, b) p)- E.catch (sequence_ messages) (\msg -> putStrLn $ "oops " ++ show (msg :: E.SomeException))+ E.catch (sequence_ messages) (\msg -> hPutStrLn stderr $ "failed " ++ show (msg :: E.SomeException)) flush backend shape change ticks return () @@ -326,4 +327,3 @@ where f (VS s) = Just (VF $ read s) f (VI i) = Just (VF $ fromIntegral i) f (VF f) = Just (VF f)-
Sound/Tidal/Tempo.hs view
@@ -70,27 +70,27 @@ readTempo x = Tempo (read a) (read b) (read c) (read d) (read e) where (a:b:c:d:e:_) = wordsBy (== ',') x +-- given a Tempo and a cycle position (aka "a beat")+-- returns the POSIX time of that cycle position (aka beat) logicalTime :: Tempo -> Double -> Double logicalTime t b = changeT + timeDelta where beatDelta = b - (beat t) timeDelta = beatDelta / (cps t) changeT = realToFrac $ utcTimeToPOSIXSeconds $ at t -tempoMVar :: IO (MVar (Tempo))-tempoMVar = do now <- getCurrentTime- l <- getLatency- mv <- newMVar (Tempo now 0 0.5 False l)- forkIO $ clocked $ f mv- return mv- where f mv change _ = do swapMVar mv change- return () +-- beatNow: accesses a clock and returns the time now in terms of+-- beats relative to metrical grid of a given Tempo beatNow :: Tempo -> IO (Double) beatNow t = do now <- getCurrentTime let delta = realToFrac $ diffUTCTime now (at t)- let beatDelta = cps t * delta + let beatDelta = cps t * delta return $ beat t + beatDelta +-- getCurrentBeat: given current Tempo grid, gets the current beat+getCurrentBeat :: MVar Tempo -> IO Rational+getCurrentBeat t = (readMVar t) >>= (beatNow) >>= (return . toRational)+ clientApp :: MVar Tempo -> MVar Double -> MVar Double -> WS.ClientApp () clientApp mTempo mCps mNudge conn = do liftIO $ forkIO $ sendCps conn mCps@@ -120,12 +120,12 @@ WS.sendTextData conn (T.pack m) connectClient :: Bool -> String -> MVar Tempo -> MVar Double -> MVar Double -> IO ()-connectClient secondTry ip mTempo mCps mNudge = do +connectClient secondTry ip mTempo mCps mNudge = do let errMsg = "Failed to connect to tidal server. Try specifying a " ++ "different port (default is 9160) setting the " ++ "environment variable TIDAL_TEMPO_PORT" serverPort <- getServerPort- WS.runClient ip serverPort "/tempo" (clientApp mTempo mCps mNudge) `E.catch` + WS.runClient ip serverPort "/tempo" (clientApp mTempo mCps mNudge) `E.catch` \(_ :: E.SomeException) -> do case secondTry of True -> error errMsg@@ -138,11 +138,11 @@ connectClient True ip mTempo mCps mNudge runClient :: IO ((MVar Tempo, MVar Double, MVar Double))-runClient = +runClient = do clockip <- getClockIp- mTempo <- newEmptyMVar - mCps <- newEmptyMVar - mNudge <- newEmptyMVar + mTempo <- newEmptyMVar+ mCps <- newEmptyMVar+ mNudge <- newEmptyMVar forkIO $ connectClient False clockip mTempo mCps mNudge return (mTempo, mCps, mNudge) @@ -166,11 +166,12 @@ cpsSetter :: IO (Double -> IO ()) cpsSetter = do (f, _) <- cpsUtils return f+ clocked :: (Tempo -> Int -> IO ()) -> IO () clocked = clockedTick 1 clockedTick :: Int -> (Tempo -> Int -> IO ()) -> IO ()-clockedTick tpb callback = +clockedTick tpb callback = do (mTempo, _, mCps) <- runClient t <- readMVar mTempo now <- getCurrentTime@@ -180,7 +181,7 @@ nextTick = ceiling (nowBeat * (fromIntegral tpb)) -- next4 = nextBeat + (4 - (nextBeat `mod` 4)) loop mTempo nextTick- where loop mTempo tick = + where loop mTempo tick = do tempo <- readMVar mTempo tick' <- doTick tempo tick loop mTempo tick'@@ -214,7 +215,7 @@ -- unpause do now <- getCurrentTime return $ t {at = addUTCTime (realToFrac $ clockLatency t) now, cps = cps', paused = False}- | otherwise = + | otherwise = do now <- getCurrentTime let delta = realToFrac $ diffUTCTime now (at t) beat' = (beat t) + ((cps t) * delta)@@ -304,7 +305,7 @@ serverAct (T.unpack msg) mode tempoState clientState -- --tempo <- liftIO $ readMVar tempoState- -- liftIO $ readMVar clientState >>= broadcast (T.pack $ show tempo) + -- liftIO $ readMVar clientState >>= broadcast (T.pack $ show tempo) where catchDisconnect e = case E.fromException e of Just WS.ConnectionClosed -> liftIO $ modifyMVar_ clientState $ \s -> do@@ -312,7 +313,6 @@ return s' _ -> return () - serverAct :: String -> ServerMode -> MVar Tempo -> MVar ClientState -> IO () serverAct ('c':'p':'s':' ':n) mode tempoState clientState = setCps (read n) mode tempoState clientState serverAct ('n':'u':'d':'g':'e':' ':n) mode tempoState clientState = setNudge (read n) mode tempoState clientState@@ -339,5 +339,3 @@ return () setNudge n (Slave sock) tempoState clientState = sendOSC sock $ Message "/nudge" [Float (realToFrac n)]--
Sound/Tidal/Version.hs view
@@ -1,4 +1,4 @@ module Sound.Tidal.Version where -tidal_version = "0.9.6"+tidal_version = "0.9.10"
tidal.cabal view
@@ -1,5 +1,5 @@ name: tidal-version: 0.9.9+version: 0.9.10 synopsis: Pattern language for improvised music -- description: homepage: http://tidalcycles.org/@@ -38,10 +38,13 @@ Sound.Tidal.SuperCollider Sound.Tidal.Params Sound.Tidal.Transition+ Sound.Tidal.EspGrid+ Sound.Tidal.MultiMode Sound.Tidal.Scales Sound.Tidal.Chords Sound.Tidal.Sieve Sound.Tidal.Version+ Sound.Tidal.Simple -- Sound.Tidal.PatternList Build-depends:@@ -57,6 +60,7 @@ , safe , websockets > 0.8 , mtl >= 2.1+ , monad-loops if !impl(ghc >= 8.4.1) build-depends: semigroups == 0.18.*