packages feed

tidal 1.0.10 → 1.0.11

raw patch · 15 files changed

+340/−111 lines, 15 filesdep +bytestringdep +clock

Dependencies added: bytestring, clock

Files

+ BootTidal.hs view
@@ -0,0 +1,57 @@+:set -XOverloadedStrings+:set prompt ""+:set prompt-cont ""++import Sound.Tidal.Context++-- total latency = oLatency + cFrameTimespan+tidal <- startTidal (superdirtTarget {oLatency = 0.1, oAddress = "127.0.0.1", oPort = 57120}) (defaultConfig {cFrameTimespan = 1/20})++let p = streamReplace tidal+let hush = streamHush tidal+let list = streamList tidal+let mute = streamMute tidal+let unmute = streamUnmute tidal+let solo = streamSolo tidal+let unsolo = streamUnsolo tidal+let once = streamOnce tidal+let asap = once+let nudgeAll = streamNudgeAll tidal+let all = streamAll tidal+let resetCycles = streamResetCycles tidal+let setcps = asap . cps+let xfade i = transition tidal True (Sound.Tidal.Transition.xfadeIn 4) i+let xfadeIn i t = transition tidal True (Sound.Tidal.Transition.xfadeIn t) i+let histpan i t = transition tidal True (Sound.Tidal.Transition.histpan t) i+let wait i t = transition tidal True (Sound.Tidal.Transition.wait t) i+let waitT i f t = transition tidal True (Sound.Tidal.Transition.waitT f t) i+let jump i = transition tidal True (Sound.Tidal.Transition.jump) i+let jumpIn i t = transition tidal True (Sound.Tidal.Transition.jumpIn t) i+let jumpIn' i t = transition tidal True (Sound.Tidal.Transition.jumpIn' t) i+let jumpMod i t = transition tidal True (Sound.Tidal.Transition.jumpMod t) i+let mortal i lifespan release = transition tidal True (Sound.Tidal.Transition.mortal lifespan release) i+let interpolate i = transition tidal True (Sound.Tidal.Transition.interpolate) i+let interpolateIn i t = transition tidal True (Sound.Tidal.Transition.interpolateIn t) i+let clutch i = transition tidal True (Sound.Tidal.Transition.clutch) i+let clutchIn i t = transition tidal True (Sound.Tidal.Transition.clutchIn t) i+let anticipate i = transition tidal True (Sound.Tidal.Transition.anticipate) i+let anticipateIn i t = transition tidal True (Sound.Tidal.Transition.anticipateIn t) i+let forId i t = transition tidal False (Sound.Tidal.Transition.mortalOverlay t) i+let d1 = p 1+let d2 = p 2+let d3 = p 3+let d4 = p 4+let d5 = p 5+let d6 = p 6+let d7 = p 7+let d8 = p 8+let d9 = p 9+let d10 = p 10+let d11 = p 11+let d12 = p 12+let d13 = p 13+let d14 = p 14+let d15 = p 15+let d16 = p 16++:set prompt "tidal> "
CHANGELOG.md view
@@ -1,5 +1,24 @@ # TidalCycles log of changes +## 1.0.11 - as yet unnamed++2019-04-17  Alex McLean  <alex@slab.org>+	* Add `bite` function for slicing patterns (rather than samples)+	* Tweak tidal.el to attempt to infer location of default BootTidal.hs+	* Skip time (forward or backward) if the reference clock jumps suddenly+	* Fix `fit` - @bgold-cosmos+	* Remove 'asap'+	* Add cB for boolean control input+	* `pickF` for choosing between functions with a pattern of integers+	* `select` for choosing between list of patterns with a floating point pattern+	* `squeeze` for choosing between list of patterns with a pattern of integers, where patterns are squeezed into the integer event duration+	* `splice` for choosing between slices of a pattern, where the slices are squeezed into event duration+	* Ord and Eq instances for value type @bgold-cosmos+	* `trigger` - support for resetting envelopes on evaluation+	* Support for rational event values+	* Tweak how `*>` and `<*` deal with analog patterns+	* Caribiner link bridge support+ ## 1.0.10 - This machine also kills fascists * Add exports to Sound.Tidal.Scales for `getScale` and `scaleTable`
+ src/Sound/Tidal/Carabiner.hs view
@@ -0,0 +1,66 @@+module Sound.Tidal.Carabiner where++import Network.Socket hiding (send, sendTo, recv, recvFrom)+import Network.Socket.ByteString (send, recv)+import qualified Data.ByteString.Char8 as B8+import Control.Concurrent (forkIO, threadDelay, takeMVar, putMVar)+import qualified Sound.Tidal.Stream as S+import Sound.Tidal.Tempo+import System.Clock+import Text.Read (readMaybe)+import Control.Monad (when, forever)+import Data.Maybe (isJust, fromJust)+import qualified Sound.OSC.FD as O++port = 17000++carabiner :: S.Stream -> Int -> Double -> IO Socket+carabiner tidal bpc latency = do sock <- client tidal bpc latency "127.0.0.1" 17000+                                 sendMsg sock "status\n"+                                 return sock++client :: S.Stream -> Int -> Double -> String -> Int -> IO Socket+client tidal bpc latency host port = withSocketsDo $+                       do addrInfo <- getAddrInfo Nothing (Just host) (Just $ show port)+                          let serverAddr = head addrInfo+                          sock <- socket (addrFamily serverAddr) Stream defaultProtocol+                          connect sock (addrAddress serverAddr)+                          _ <- forkIO $ listener tidal bpc latency sock+                          -- sendMsg sock "status\n"+                          -- threadDelay 10000000+                          return sock++listener :: S.Stream -> Int -> Double -> Socket -> IO ()+listener tidal bpc latency sock =+  forever $ do rMsg <- recv sock 1024+               let msg = B8.unpack rMsg+                   (name:_:ws) = words msg+                   pairs = pairs' ws+                   pairs' (a:b:xs) = (a,b):(pairs' xs)+                   pairs' _ = []+               act tidal bpc latency name pairs++act :: S.Stream -> Int -> Double -> String -> [(String, String)] -> IO ()+act tidal bpc latency "status" pairs+  = do let start = (lookup ":start" pairs >>= readMaybe) :: Maybe Integer+           bpm   = (lookup ":bpm"   pairs >>= readMaybe) :: Maybe Double+           beat  = (lookup ":beat"  pairs >>= readMaybe) :: Maybe Double+       when (and [isJust start, isJust bpm, isJust beat]) $ do+         nowM <- getTime Monotonic+         nowO <- O.time+         let m = (fromIntegral $ sec nowM) + ((fromIntegral $ nsec nowM)/1000000000)+             d = nowO - m+             start' = ((fromIntegral $ fromJust start) / 1000000)+             startO = start' + d+             cyc = toRational $ (fromJust beat) / (fromIntegral bpc)+         tempo <- takeMVar (S.sTempoMV tidal)+         let tempo' = tempo {atTime = startO + latency,+                             atCycle = 0,+                             cps = ((fromJust bpm) / 60) / (fromIntegral bpc)+                            }+         putMVar (S.sTempoMV tidal) $ tempo'+act _ _ _ name _ = putStr $ "Unhandled thingie " ++ name++sendMsg :: Socket -> String -> IO ()+sendMsg sock msg = do send sock $ B8.pack msg+                      return ()
src/Sound/Tidal/Context.hs view
@@ -4,6 +4,7 @@  import Data.Ratio as C +import Sound.Tidal.Carabiner as C import Sound.Tidal.Config as C import Sound.Tidal.Control as C import Sound.Tidal.Core as C
src/Sound/Tidal/Control.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings, FlexibleContexts #-}  module Sound.Tidal.Control where @@ -367,10 +367,17 @@ msec :: Fractional a => Pattern a -> Pattern a msec p = ((realToFrac . (/1000)) <$> cF 1 "_cps") *| p +trigger :: Show a => a -> Pattern b -> Pattern b+trigger k pat = pat {query = q}+  where q st = query (rotR (offset st) pat) st+        offset st = fromMaybe 0 $ Map.lookup ctrl (controls st) >>= getR+        ctrl = "_t_" ++ show k+ cI :: String -> Pattern Int cI s = Pattern Analog $ \(State a m) -> maybe [] (f a) $ Map.lookup s m   where f a (VI v) = [Event a a v]         f a (VF v) = [Event a a (floor v)]+        f a (VR v) = [Event a a (floor v)]         f a (VS v) = maybe [] (\v' -> [Event a a v']) (readMaybe v)  _cX :: (Arc -> Value -> [Event a]) -> [a] -> String -> Pattern a@@ -380,6 +387,7 @@ _cF :: [Double] -> String -> Pattern Double _cF = _cX f   where f a (VI v) = [Event a a (fromIntegral v)]+        f a (VR v) = [Event a a (fromRational v)]         f a (VF v) = [Event a a v]         f a (VS v) = maybe [] (\v' -> [Event a a v']) (readMaybe v) @@ -390,6 +398,15 @@ cF_ :: String -> Pattern Double cF_ = _cF [] +cB :: Bool -> String -> Pattern Bool+cB b = _cB [b]+_cB :: [Bool] -> String -> Pattern Bool+_cB = _cX f+  where f a (VI v) = [Event a a (v /= 0)]+        f a (VF v) = [Event a a (v >= 0.5)]+        f a (VR v) = [Event a a (v >= (1%2))]+        f a (VS v) = maybe [] (\v' -> [Event a a (v' == "t")]) (readMaybe v)+ cT :: Time -> String -> Pattern Time cT d = (toRational <$>) . cF (fromRational d) cT0 :: String -> Pattern Time@@ -409,6 +426,7 @@ _cS = _cX f   where f a (VI v) = [Event a a (show v)]         f a (VF v) = [Event a a (show v)]+        f a (VR v) = [Event a a (show v)]         f a (VS v) = [Event a a v] cS :: String -> String -> Pattern String cS d = _cS [d]@@ -419,7 +437,9 @@ _cP ds s = innerJoin $ _cX f ds s   where f a (VI v) = [Event a a (parseBP_E $ show v)]         f a (VF v) = [Event a a (parseBP_E $ show v)]+        f a (VR v) = [Event a a (parseBP_E $ show v)]         f a (VS v) = [Event a a (parseBP_E v)]+ cP :: (Enumerable a, Parseable a) => Pattern a -> String -> Pattern a cP d = _cP [d] cP_ :: (Enumerable a, Parseable a) => String -> Pattern a@@ -682,3 +702,9 @@ in126 = cF 0 "126" in127 :: Pattern Double in127 = cF 0 "127"++splice :: Int -> Pattern Int -> ControlPattern -> Pattern (Map.Map String Value)+splice bits ipat pat = withEvent f (slice (pure bits) ipat pat) # P.unit "c"+  where f ev = ev {value = Map.insert "speed" (VF d) (value ev)}+          where d = sz / (fromRational $ (wholeStop ev) - (wholeStart ev))+                sz = 1/(fromIntegral bits)
src/Sound/Tidal/Params.hs view
@@ -58,6 +58,11 @@ accelerate :: Pattern Double -> ControlPattern accelerate       = pF "accelerate" ++-- | Amplitude; like @gain@, but linear.+amp :: Pattern Double -> ControlPattern+amp = pF "amp"+ -- | a pattern of numbers to specify the attack time (in seconds) of an envelope applied to each sample. Only takes effect if `release` is also specified. attack :: Pattern Double -> ControlPattern attack = pF "attack"@@ -160,9 +165,13 @@ -} end :: Pattern Double -> ControlPattern end = pF "end"--- | a pattern of numbers that specify volume. Values less than 1 make the sound quieter. Values greater than 1 make the sound louder.++-- | a pattern of numbers that specify volume. Values less than 1 make+-- the sound quieter. Values greater than 1 make the sound louder. For+-- the linear equivalent, see @amp@. gain :: Pattern Double -> ControlPattern gain = pF "gain"+ gate :: Pattern Double -> ControlPattern gate = pF "gate" hatgrain :: Pattern Double -> ControlPattern
src/Sound/Tidal/Pattern.hs view
@@ -88,6 +88,10 @@ timeToCycleArc :: Time -> Arc timeToCycleArc t = Arc (sam t) (sam t + 1) +-- | Shifts an arc to the equivalent one that starts during cycle zero+cycleArc :: Arc -> Arc+cycleArc (Arc s e) = Arc (cyclePos s) (cyclePos s + (e-s))+ -- | A list of cycle numbers which are included in the given arc cyclesInArc :: Integral a => Arc -> [a] cyclesInArc (Arc s e)@@ -219,9 +223,43 @@  data Value = VS { svalue :: String }            | VF { fvalue :: Double }+           | VR { rvalue :: Rational }            | VI { ivalue :: Int }-           deriving (Eq,Ord,Typeable,Data)+           deriving (Typeable,Data) +instance Eq Value where+  (VS x) == (VS y) = x == y+  (VF x) == (VF y) = x == y+  (VI x) == (VI y) = x == y+  (VR x) == (VR y) = x == y+  +  (VF x) == (VI y) = x == (fromIntegral y)+  (VI y) == (VF x) = x == (fromIntegral y)++  (VF x) == (VR y) = (toRational x) == y+  (VR y) == (VF x) = (toRational x) == y+  (VI x) == (VR y) = (toRational x) == y+  (VR y) == (VI x) = (toRational x) == y++  (VS _) == _ = False+  _ == (VS _) = False+  +instance Ord Value where+  compare (VS x) (VS y) = compare x y+  compare (VF x) (VF y) = compare x y+  compare (VI x) (VI y) = compare x y+  compare (VR x) (VR y) = compare x y+  compare (VS _) _ = LT+  compare _ (VS _) = GT+  compare (VF x) (VI y) = compare x (fromIntegral y)+  compare (VI x) (VF y) = compare (fromIntegral x) y++  compare (VR x) (VI y) = compare x (fromIntegral y)+  compare (VI x) (VR y) = compare (fromIntegral x) y++  compare (VF x) (VR y) = compare x (fromRational y)+  compare (VR x) (VF y) = compare (fromRational x) y+ type ControlMap = Map.Map String Value type ControlPattern = Pattern ControlMap @@ -274,41 +312,42 @@  -- | Like <*>, but the structure only comes from the left (<*) :: Pattern (a -> b) -> Pattern a -> Pattern b-(<*) pf@(Pattern Digital _) px = Pattern Digital q+(<*) pf@(Pattern Analog _) px@(Pattern Analog _) = Pattern Analog q   where q st = concatMap match $ query pf st-         where+          where             match (Event fWhole fPart f) =               map               (Event fWhole fPart . f . value) $-              query px $ st {arc = xQuery fWhole}-            xQuery (Arc s _) = pure s -- for discrete events, match with the onset+              query px st -- for continuous events, use the original query -(<*) pf px = Pattern Analog q+-- If one of the patterns is digital, treat both as digital.. (TODO - needs extra thought)+(<*) pf px = Pattern Digital q   where q st = concatMap match $ query pf st-          where+         where             match (Event fWhole fPart f) =               map               (Event fWhole fPart . f . value) $-              query px st -- for continuous events, use the original query+              query px $ st {arc = xQuery fWhole}+            xQuery (Arc s _) = pure s -- for discrete events, match with the onset  -- | Like <*>, but the structure only comes from the right (*>) :: Pattern (a -> b) -> Pattern a -> Pattern b-(*>) pf px@(Pattern Digital _) = Pattern Digital q+(*>) pf@(Pattern Analog _) px@(Pattern Analog _) = Pattern Analog q   where q st = concatMap match $ query px st-         where+          where             match (Event xWhole xPart x) =               map               (\e -> Event xWhole xPart (value e x)) $-              query pf $ fQuery xWhole-            fQuery (Arc s _) = st {arc = pure s} -- for discrete events, match with the onset+              query pf st -- for continuous events, use the original query -(*>) pf px = Pattern Analog q+(*>) pf px = Pattern Digital q   where q st = concatMap match $ query px st-          where+         where             match (Event xWhole xPart x) =               map               (\e -> Event xWhole xPart (value e x)) $-              query pf st -- for continuous events, use the original query+              query pf $ fQuery xWhole+            fQuery (Arc s _) = st {arc = pure s} -- for discrete events, match with the onset  infixl 4 <*, *> @@ -380,7 +419,6 @@           do w' <- subArc oWhole iWhole              p' <- subArc oPart iPart              return (Event w' p' v)-        cycleArc (Arc s e) = Arc (cyclePos s) (cyclePos s + (e-s))  noOv :: String -> a noOv meth = error $ meth ++ ": not supported for patterns"@@ -391,6 +429,7 @@ instance TolerantEq Value where          (VS a) ~== (VS b) = a == b          (VI a) ~== (VI b) = a == b+         (VR a) ~== (VR b) = a == b          (VF a) ~== (VF b) = abs (a - b) < 0.000001          _ ~== _ = False @@ -508,6 +547,7 @@   show (VS s) = ('"':s) ++ "\""   show (VI i) = show i   show (VF f) = show f ++ "f"+  show (VR r) = show r ++ "r"  instance {-# OVERLAPPING #-} Show ControlMap where   show m = intercalate ", " $ map (\(name, v) -> name ++ ": " ++ show v) $ Map.toList m@@ -626,9 +666,10 @@ applyFIS f _ _ (VF f') = VF $ f f' applyFIS _ f _ (VI i ) = VI $ f i applyFIS _ _ f (VS s ) = VS $ f s+applyFIS _ _ _ v = v  -- | Apply one of two functions to a Value, depending on its type (int--- or float; strings are ignored)+-- or float; strings and rationals are ignored) fNum2 :: (Int -> Int -> Int) -> (Double -> Double -> Double) -> Value -> Value -> Value fNum2 fInt _      (VI a) (VI b) = VI $ fInt a b fNum2 _    fFloat (VF a) (VF b) = VF $ fFloat a b@@ -647,6 +688,10 @@ getS :: Value -> Maybe String getS (VS s) = Just s getS _  = Nothing++getR :: Value -> Maybe Rational+getR (VR r) = Just r+getR _  = Nothing  compressArc :: Arc -> Pattern a -> Pattern a compressArc (Arc s e) p | s > e = empty
src/Sound/Tidal/Stream.hs view
@@ -14,6 +14,7 @@ -- import qualified Data.Bifunctor as BF -- import qualified Data.Bool as B -- import qualified Data.Char as C+import           System.IO (hPutStrLn, stderr)  import qualified Sound.OSC.FD as O @@ -232,16 +233,24 @@ streamReplace :: Show a => Stream -> a -> ControlPattern -> IO () streamReplace s k pat   = E.catch (do let x = queryArc pat (Arc 0 0)+                tempo <- readMVar $ sTempoMV s+                input <- takeMVar $ sInput s+                -- put change time in control input+                now <- O.time+                let cycle = T.timeToCycles tempo now+                putMVar (sInput s) $+                  Map.insert ("_t_all") (VR cycle) $ Map.insert ("_t_" ++ show k) (VR cycle) input+                -- update the pattern itself                 pMap <- seq x $ takeMVar $ sPMapMV s                 let playState = updatePS $ Map.lookup (show k) pMap                 putMVar (sPMapMV s) $ Map.insert (show k) playState pMap                 calcOutput s                 return ()           )-    (\(e :: E.SomeException) -> putStrLn $ "Error in pattern: " ++ show e+    (\(e :: E.SomeException) -> hPutStrLn stderr $ "Error in pattern: " ++ show e     )   where updatePS (Just playState) = do playState {pattern = pat, history = pat:(history playState)}-        updatePS Nothing = PlayState pat False False []+        updatePS Nothing = PlayState pat False False [pat]  streamMute :: Show a => Stream -> a -> IO () streamMute s k = withPatId s (show k) (\x -> x {mute = True})@@ -258,14 +267,12 @@ streamUnsolo :: Show a => Stream -> a -> IO () streamUnsolo s k = withPatId s (show k) (\x -> x {solo = False}) -streamOnce :: Stream -> Bool -> ControlPattern -> IO ()-streamOnce st asap p+streamOnce :: Stream -> ControlPattern -> IO ()+streamOnce st p   = do cMap <- readMVar (sInput st)        tempo <- readMVar (sTempoMV st)        now <- O.time-       let latency target | asap = 0-                          | otherwise = oLatency target-           fakeTempo = T.Tempo {T.cps = T.cps tempo,+       let fakeTempo = T.Tempo {T.cps = T.cps tempo,                                 T.atCycle = 0,                                 T.atTime = now,                                 T.paused = False,@@ -280,7 +287,7 @@            on e = sched tempo $ start $ whole e            cpsChanges = map (\e -> (on e - now, Map.lookup "cps" $ value e)) es            messages target =-             catMaybes $ map (\e -> do m <- toMessage (at e + (latency target)) target fakeTempo e+             catMaybes $ map (\e -> do m <- toMessage (at e + (oLatency target)) target fakeTempo e                                        return $ (at e, m)                              ) es        mapM_ (\(Cx target udp) ->@@ -310,7 +317,7 @@  streamHush :: Stream -> IO () streamHush s = do modifyMVar_ (sOutput s) $ return . const silence-                  modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {pattern = silence})+                  modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {pattern = silence, history = silence:history x})  streamUnmuteAll :: Stream -> IO () streamUnmuteAll s = do modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {mute = False})
src/Sound/Tidal/Tempo.hs view
@@ -98,19 +98,24 @@              tempo <- readMVar tempoMV                             t <- O.time              let frameTimespan = cFrameTimespan config-                 delta = logicalNow - t-                 -- 'now' comes from clock ticks, nothing to do with cycles                  logicalT ticks' = start st + fromIntegral ticks' * frameTimespan                  logicalNow = logicalT $ ticks st + 1-                 -- the tempo is just used to convert logical time to cycles+                 -- Wait maximum of two frames+                 delta = min (frameTimespan * 2) (logicalNow - t)                  e = timeToCycles tempo logicalNow                  s = if starting st && synched tempo                      then timeToCycles tempo (logicalT $ ticks st)                      else P.stop $ nowArc st-                 st' = st {ticks = ticks st + 1, nowArc = P.Arc s e,+             when (t < logicalNow) $ threadDelay (floor $ delta * 1000000)+             t' <- O.time+             let actualTick = floor $ (t' - start st) / frameTimespan+                 -- reset ticks if ahead/behind by 4 or more+                 newTick | (abs $ actualTick - ticks st) > 4 = actualTick+                         | otherwise = (ticks st) + 1+                 st' = st {ticks = newTick,+                           nowArc = P.Arc s e,                            starting = not (synched tempo)                           }-             when (t < logicalNow) $ threadDelay (floor $ delta * 1000000)              callback tempoMV st'              loop tempoMV st'
src/Sound/Tidal/Transition.hs view
@@ -20,27 +20,36 @@ import Sound.Tidal.Utils (enumerate)  -- Evaluation of pat is forced so exceptions are picked up here, before replacing the existing pattern.-transition :: Show a => Stream -> (Time -> [ControlPattern] -> ControlPattern) -> a -> ControlPattern -> IO ()-transition stream f patId !pat = do pMap <- takeMVar (sPMapMV stream)-                                    let playState = updatePS $ Map.lookup (show patId) pMap-                                    pat' <- transition' $ history playState-                                    let pMap' =-                                          Map.insert (show patId) (playState {pattern = pat'}) pMap-                                    putMVar (sPMapMV stream) pMap'-                                    calcOutput stream-                                    return ()+-- the "historyFlag" determines if the new pattern should be placed on the history stack or not+transition :: Show a => Stream -> Bool -> (Time -> [ControlPattern] -> ControlPattern) -> a -> ControlPattern -> IO ()+transition stream historyFlag f patId !pat =+  do pMap <- takeMVar (sPMapMV stream)+     let playState = updatePS $ Map.lookup (show patId) pMap+     pat' <- transition' $ appendPat (not historyFlag) (history playState)+     let pMap' = Map.insert (show patId) (playState {pattern = pat'}) pMap+     putMVar (sPMapMV stream) pMap'+     calcOutput stream+     return ()   where-    updatePS (Just playState) = playState {history = pat:(history playState)}+    appendPat flag = if flag then (pat:) else id+    updatePS (Just playState) = playState {history = (appendPat historyFlag) (history playState)}     updatePS Nothing = PlayState {pattern = silence,                                   mute = False,                                   solo = False,-                                  history = pat:silence:[]+                                  history = (appendPat historyFlag) (silence:[])                                  }     transition' context = do tempo <- readMVar $ sTempoMV stream                              now <- O.time                              let c = timeToCycles tempo now                              return $ f c context +mortalOverlay :: Time -> Time -> [Pattern a] -> Pattern a+mortalOverlay _ _ [] = silence+mortalOverlay t now (pat:ps) = overlay (pop ps) (playFor s (s+t) pat) where+  pop [] = silence+  pop (x:xs) = x+  s = sam (now - fromIntegral (floor now `mod` floor t)) + sam t+ {-| Washes away the current pattern after a certain delay by applying a     function to it over time, then switching over to the next pattern to     which another function is applied.@@ -114,7 +123,7 @@  -- | Sharp `jump` transition at next cycle boundary where cycle mod n == 0 jumpMod :: Int -> Time -> [ControlPattern] -> ControlPattern-jumpMod n now = jumpIn ((n-1) - ((floor now) `mod` n)) now+jumpMod n now = jumpIn' ((n-1) - ((floor now) `mod` n)) now  -- | Degrade the new pattern over time until it ends in silence mortal :: Time -> Time -> Time -> [ControlPattern] -> ControlPattern
src/Sound/Tidal/UI.hs view
@@ -161,7 +161,7 @@ {- | Like @choose@, but works on an a list of tuples of values and weights  @-sound "superpiano(3,8)" # note (choose [("a",1), ("e",0.5), ("g",2), ("c",1)])+sound "superpiano(3,8)" # note (wchoose [("a",1), ("e",0.5), ("g",2), ("c",1)]) @  In the above example, the "a" and "c" notes are twice as likely to@@ -1101,7 +1101,7 @@ stretch :: Pattern a -> Pattern a -- TODO - should that be whole or part? stretch p = splitQueries $ p {query = q}-  where q st = query (zoomArc (enclosingArc $ map whole $ query p (st {arc = Arc (sam s) (nextSam s)})) p) st+  where q st = query (zoomArc (cycleArc $ enclosingArc $ map whole $ query p (st {arc = Arc (sam s) (nextSam s)})) p) st           where s = start $ arc st  {- | `fit'` is a generalization of `fit`, where the list is instead constructed by using another integer pattern to slice up a given pattern.  The first argument is the number of cycles of that latter pattern to use when slicing.  It's easier to understand this with a few examples:@@ -1388,7 +1388,6 @@   where a = filterValues id stitch         b = filterValues not stitch - stutter :: Integral i => i -> Time -> Pattern a -> Pattern a stutter n t p = stack $ map (\i -> (t * fromIntegral i) `rotR` p) [0 .. (n-1)] @@ -1599,13 +1598,12 @@     maskedWeft = mask (every 2 rev $ _fast (n % 2) $ fastCat [silence, pure True]) weftP     maskedWarp = mask (every 2 rev $ _fast (n % 2) $ fastCat [pure True, silence]) warpP -_select :: Double -> [Pattern a] -> Pattern a-_select f ps =  ps !! floor (max 0 (min 1 f) * fromIntegral (length ps - 1))- -- | chooses between a list of patterns, using a pattern of floats (from 0-1) select :: Pattern Double -> [Pattern a] -> Pattern a select = tParam _select +_select :: Double -> [Pattern a] -> Pattern a+_select f ps =  ps !! floor (max 0 (min 1 f) * fromIntegral (length ps - 1))  -- | chooses between a list of functions, using a pattern of floats (from 0-1) selectF :: Pattern Double -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a@@ -1614,6 +1612,13 @@ _selectF :: Double -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a _selectF f ps p =  (ps !! floor (max 0 (min 0.999999 f) * fromIntegral (length ps))) p +-- | chooses between a list of functions, using a pattern of integers+pickF :: Pattern Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a+pickF pi fs pat = innerJoin $ (\i -> _pickF i fs pat) <$> pi++_pickF :: Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a+_pickF i fs p =  (fs !!! i) p+ -- | @contrast p f f' p'@ splits controlpattern @p'@ in two, applying -- the function @f@ to one and @f'@ to the other. This depends on -- whether events in it contains values matching with those in @p@.@@ -1729,7 +1734,7 @@ swap :: Eq a => [(a, b)] -> Pattern a -> Pattern b swap things p = filterJust $ (`lookup` things) <$> p -{- @coat@ | +{- @soak@ |      applies a function to a pattern and cats the resulting pattern,     then continues applying the function until the depth is reached     this can be used to create a pattern that wanders away from @@ -1740,14 +1745,30 @@ soak depth f pattern = cat $ take depth $ iterate f pattern  deconstruct :: Int -> Pattern String -> String-deconstruct n p = intercalate " " $ map showStep $ toList n p+deconstruct n p = intercalate " " $ map showStep $ toList p   where      showStep :: [String] -> String     showStep [] = "~"     showStep [x] = x     showStep xs = "[" ++ (intercalate ", " xs) ++ "]"-    toList :: Int -> Pattern a -> [[a]]-    toList n pat = map (\(s,e) -> map value $ queryArc (_segment n' pat) (Arc s e)) arcs+    toList :: Pattern a -> [[a]]+    toList pat = map (\(s,e) -> map value $ queryArc (_segment n' pat) (Arc s e)) arcs       where breaks = [0, (1/n') ..]             arcs = zip (take n breaks) (drop 1 breaks)             n' = fromIntegral n++{- @bite@ n ipat pat |+  slices a pattern `pat` into `n` pieces, then uses the `ipat` pattern of integers to index into those slices.+  So `bite 4 "0 2*2" (run 8)` is the same as `"[0 1] [4 5]*2"`.+-}++bite :: Int -> Pattern Int -> Pattern a -> Pattern a+bite n ipat pat = squeezeJoin $ zoompat <$> ipat+  where zoompat i = zoom (i'/(fromIntegral n), (i'+1)/(fromIntegral n)) pat+           where i' = fromIntegral $ i `mod` n++{- @squeeze@ ipat pats | uses a pattern of integers to index into a list of patterns.+-}+squeeze :: Pattern Int -> [Pattern a] -> Pattern a+squeeze _ [] = silence+squeeze ipat pats = squeezeJoin $ (pats !!!) <$> ipat
src/Sound/Tidal/Version.hs view
@@ -1,4 +1,4 @@ module Sound.Tidal.Version where  tidal_version :: String-tidal_version = "1.0.7"+tidal_version = "1.0.11"
test/Sound/Tidal/UITest.hs view
@@ -237,3 +237,8 @@           (wedge (0) (s "ho ho:2 ho:3 hc") (rev $ s "ho ho:2 ho:3 hc"))           (rev $ s "ho ho:2 ho:3 hc") +    describe "bite" $ do+      it "can slice a pattern into bits" $ do+        compareP (Arc 0 4)+          (bite 4 "0 2*2" (Sound.Tidal.Core.run 8))+          ("[0 1] [4 5]*2" :: Pattern Int)
tidal.cabal view
@@ -1,5 +1,5 @@ name:                tidal-version:             1.0.10+version:             1.0.11 synopsis:            Pattern language for improvised music -- description: homepage:            http://tidalcycles.org/@@ -13,6 +13,7 @@ build-type:          Simple cabal-version:       >=1.10 tested-with:         GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3+data-files:          BootTidal.hs  Extra-source-files: README.md CHANGELOG.md tidal.el @@ -26,6 +27,7 @@   default-language:    Haskell2010    Exposed-modules:     Sound.Tidal.Bjorklund+                       Sound.Tidal.Carabiner                        Sound.Tidal.Chords                        Sound.Tidal.Config                        Sound.Tidal.Control@@ -59,6 +61,8 @@     , bifunctors < 5.6     , transformers < 0.5.7     , template-haskell >= 2.10.0.0 && < 2.15+    , bytestring < 0.11+    , clock < 0.8    if !impl(ghc >= 8.4.1)     build-depends: semigroups == 0.18.*
tidal.el view
@@ -57,6 +57,14 @@   ()   "*Arguments to the haskell interpreter (default=none).") +(defvar tidal-boot-script-path+  (concat (substring+           (shell-command-to-string+            "ghc-pkg describe $(ghc-pkg latest tidal) | grep data-dir | cut -f2 -d' '") 0 -1)+          "/BootTidal.hs")+  "*Full path to BootTidal.hs (inferred by introspecting ghc-pkg package db)."+  )+ (defvar tidal-literate-p   t   "*Flag to indicate if we are in literate mode (default=t).")@@ -87,60 +95,7 @@      nil      tidal-interpreter-arguments)     (tidal-see-output))-  (tidal-send-string ":set prompt \"\"")-  (if (string< tidal-interpreter-version "8.2.0")-      (tidal-send-string ":set prompt2 \"\"")-    (tidal-send-string ":set prompt-cont \"\""))-  (tidal-send-string ":set -XOverloadedStrings-import Sound.Tidal.Context-tidal <- startMulti [superdirtTarget {oLatency = 0.1, oAddress = \"127.0.0.1\", oPort = 57120}] (defaultConfig {cFrameTimespan = 1/20, cCtrlListen = True})-let p = streamReplace tidal-let hush = streamHush tidal-let list = streamList tidal-let mute = streamMute tidal-let unmute = streamUnmute tidal-let solo = streamSolo tidal-let unsolo = streamUnsolo tidal-let once = streamOnce tidal False-let asap = streamOnce tidal True-let nudgeAll = streamNudgeAll tidal-let all = streamAll tidal-let resetCycles = streamResetCycles tidal-let setcps = asap . cps-let xfade i = transition tidal (Sound.Tidal.Transition.xfadeIn 4) i-let xfadeIn i t = transition tidal (Sound.Tidal.Transition.xfadeIn t) i-let histpan i t = transition tidal (Sound.Tidal.Transition.histpan t) i-let wait i t = transition tidal (Sound.Tidal.Transition.wait t) i-let waitT i f t = transition tidal (Sound.Tidal.Transition.waitT f t) i-let jump i = transition tidal (Sound.Tidal.Transition.jump) i-let jumpIn i t = transition tidal (Sound.Tidal.Transition.jumpIn t) i-let jumpIn' i t = transition tidal (Sound.Tidal.Transition.jumpIn' t) i-let jumpMod i t = transition tidal (Sound.Tidal.Transition.jumpMod t) i-let mortal i lifespan release = transition tidal (Sound.Tidal.Transition.mortal lifespan release) i-let interpolate i = transition tidal (Sound.Tidal.Transition.interpolate) i-let interpolateIn i t = transition tidal (Sound.Tidal.Transition.interpolateIn t) i-let clutch i = transition tidal (Sound.Tidal.Transition.clutch) i-let clutchIn i t = transition tidal (Sound.Tidal.Transition.clutchIn t) i-let anticipate i = transition tidal (Sound.Tidal.Transition.anticipate) i-let anticipateIn i t = transition tidal (Sound.Tidal.Transition.anticipateIn t) i-let d1 = p 1-let d2 = p 2 . (|< orbit 1)-let d3 = p 3 . (|< orbit 2)-let d4 = p 4 . (|< orbit 3)-let d5 = p 5 . (|< orbit 4)-let d6 = p 6 . (|< orbit 5)-let d7 = p 7 . (|< orbit 6)-let d8 = p 8 . (|< orbit 7)-let d9 = p 9 . (|< orbit 8)-let d10 = p 10-let d11 = p 11-let d12 = p 12-let d13 = p 13-let d14 = p 14-let d15 = p 15-let d16 = p 16-  ")-  (tidal-send-string ":set prompt \"tidal> \"")+  (tidal-send-string (concat ":script " tidal-boot-script-path)) )  (defun tidal-see-output ()