diff --git a/BootTidal.hs b/BootTidal.hs --- a/BootTidal.hs +++ b/BootTidal.hs @@ -5,12 +5,11 @@ import Sound.Tidal.Context -- total latency = oLatency + cFrameTimespan -tidal <- startTidal (superdirtTarget {oLatency = 0.15, oAddress = "127.0.0.1", oPort = 57120}) (defaultConfig {cFrameTimespan = 1/20}) -- , cSendParts = False}) ---tidal <- startTidal (dirtTarget {oLatency = 0.1}) (defaultConfig {cFrameTimespan = 1/20, cSendParts = True}) +tidal <- startTidal (superdirtTarget {oLatency = 0.1, oAddress = "127.0.0.1", oPort = 57120}) (defaultConfig {cFrameTimespan = 1/20}) :{ let p = streamReplace tidal - --hush = streamHush tidal + hush = streamHush tidal list = streamList tidal mute = streamMute tidal unmute = streamUnmute tidal @@ -39,39 +38,30 @@ anticipate i = transition tidal True (Sound.Tidal.Transition.anticipate) i anticipateIn i t = transition tidal True (Sound.Tidal.Transition.anticipateIn t) i forId i t = transition tidal False (Sound.Tidal.Transition.mortalOverlay t) i - munge i = selectF (cF 0 (show $ 50 + i)) [id, (# (delayfb (cF 0 (show $ 30 + i)) # delayt (select (cF 0 (show $ 70+i)) [1/3, 1/6]) # lock 1 # delay (cF 0 (show $ 20 + i))))] . selectF (cF 0 (show $ 90 + i)) [id, (# (room (cF 0 (show $ 40 + i)) # sz 0.8))] . selectF (cF 0 (show $ 80 + i)) [id, (# djf (cF 0.5 (show $ 40 + i)))] - d1 = p 1 . munge 1 . (|< orbit 0) - d2 = p 2 . munge 2 . (|< orbit 1) - d3 = p 3 . munge 3 . (|< orbit 2) - d4 = p 4 . munge 4 . (|< orbit 3) - d5 = p 5 . munge 5 . (|< orbit 4) - d6 = p 6 . munge 6 . (|< orbit 5) - d7 = p 7 . munge 7 . (|< orbit 6) - d8 = p 8 . munge 8 . (|< orbit 7) + d1 = p 1 . (|< orbit 0) + d2 = p 2 . (|< orbit 1) + d3 = p 3 . (|< orbit 2) + d4 = p 4 . (|< orbit 3) + d5 = p 5 . (|< orbit 4) + d6 = p 6 . (|< orbit 5) + d7 = p 7 . (|< orbit 6) + d8 = p 8 . (|< orbit 7) d9 = p 9 . (|< orbit 8) d10 = p 10 . (|< orbit 9) d11 = p 11 . (|< orbit 10) - d12 = p 12 + d12 = p 12 . (|< orbit 11) d13 = p 13 d14 = p 14 d15 = p 15 d16 = p 16 - jux' fs p = stack $ map (\n -> (fs !! n) p |+ pan (pure $ fromIntegral n / fromIntegral ((length fs)-1))) [0 .. (length fs)-1] - hush = mapM_ ($ silence) [d1,d2,d3,d4,d5,d6,d7,d8,d9,d10,d11,d12,d13,d14,d15,d16] - only = (hush >>) - gtfo = (const silence) - pd = phaserdepth - pr = phaserrate - setI = streamSetI tidal +:} + +:{ +let setI = streamSetI tidal setF = streamSetF tidal setS = streamSetS tidal setR = streamSetI tidal setB = streamSetB tidal - metre = cB True "metre" - setMetre = setB "metre" - vowelF = pF "vowel" :} -let within' = curry within -let within = within' :set prompt "tidal> " diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,9 +1,5 @@ # TidalCycles log of changes -## 1.2.0 - Hunters Bar - -* Simplify <* and *>, removing any distinction between analogue and digital patterns - ## 1.1.2 - Eccy Road * Usability fix for `binary` / `binaryN` (use squeezeJoin on input pattern) diff --git a/src/Sound/Tidal/Control.hs b/src/Sound/Tidal/Control.hs --- a/src/Sound/Tidal/Control.hs +++ b/src/Sound/Tidal/Control.hs @@ -392,10 +392,10 @@ _getP d f pat = (fromMaybe d . f) <$> pat _cX :: a -> (Value -> Maybe a) -> String -> Pattern a -_cX d f s = Pattern $ \(State a m) -> queryArc (maybe (pure d) (_getP d f) $ Map.lookup s m) a +_cX d f s = Pattern Analog $ \(State a m) -> queryArc (maybe (pure d) (_getP d f) $ Map.lookup s m) a _cX_ :: (Value -> Maybe a) -> String -> Pattern a -_cX_ f s = Pattern $ \(State a m) -> queryArc (maybe silence (_getP_ f) $ Map.lookup s m) a +_cX_ f s = Pattern Analog $ \(State a m) -> queryArc (maybe silence (_getP_ f) $ Map.lookup s m) a cF :: Double -> String -> Pattern Double cF d = _cX d getF diff --git a/src/Sound/Tidal/Core.hs b/src/Sound/Tidal/Core.hs --- a/src/Sound/Tidal/Core.hs +++ b/src/Sound/Tidal/Core.hs @@ -17,7 +17,7 @@ -- | Takes a function from time to values, and turns it into a 'Pattern'. sig :: (Time -> a) -> Pattern a -sig f = Pattern q +sig f = Pattern Analog q where q (State (Arc s e) _) | s > e = [] | otherwise = [Event (Arc s e) (Arc s e) (f (s+((e-s)/2)))] @@ -190,7 +190,8 @@ -- in turn, then the second cycle from each, and so on. cat :: [Pattern a] -> Pattern a cat [] = silence -cat ps = Pattern $ q +-- TODO I *guess* it would be digital.. +cat ps = Pattern Digital q where n = length ps q st = concatMap (f st) $ arcCyclesZW (arc st) f st a = query (withResultTime (+offset) p) $ st {arc = Arc (subtract offset (start a)) (subtract offset (stop a))} @@ -233,7 +234,10 @@ -- | 'overlay' combines two 'Pattern's into a new pattern, so that -- their events are combined over time. overlay :: Pattern a -> Pattern a -> Pattern a -overlay !p !p' = Pattern $ \st -> query p st ++ query p' st +-- Analog if they're both analog +overlay !p@(Pattern Analog _) !p'@(Pattern Analog _) = Pattern Analog $ \st -> query p st ++ query p' st +-- Otherwise digital. Won't really work to have a mixture.. Hmm +overlay !p !p' = Pattern Digital $ \st -> query p st ++ query p' st -- | An infix alias of @overlay@ (<>) :: Pattern a -> Pattern a -> Pattern a diff --git a/src/Sound/Tidal/Pattern.hs b/src/Sound/Tidal/Pattern.hs --- a/src/Sound/Tidal/Pattern.hs +++ b/src/Sound/Tidal/Pattern.hs @@ -223,9 +223,14 @@ -- | A function that represents events taking place over time type Query a = (State -> [Event a]) --- | A datatype that's basically a query -data Pattern a = Pattern {query :: Query a} +-- | Also known as Continuous vs Discrete/Amorphous vs Pulsating etc. +data Nature = Analog | Digital + deriving (Eq, Show) +-- | A datatype that's basically a query, plus a hint about whether its events +-- are Analogue or Digital by nature +data Pattern a = Pattern {nature :: Nature, query :: Query a} + data Value = VS { svalue :: String } | VF { fvalue :: Double } | VR { rvalue :: Rational } @@ -301,40 +306,97 @@ instance NFData a => NFData (Pattern a) where - rnf (Pattern q) = rnf $ \s -> q s + rnf (Pattern _ q) = rnf $ \s -> q s instance Functor Pattern where -- | apply a function to all the values in a pattern fmap f p = p {query = fmap (fmap f) . query p} -applyPatToPat :: (Arc -> Arc -> Maybe Arc) -> Pattern (a -> b) -> Pattern a -> Pattern b -applyPatToPat combineWholes pf px = Pattern q +instance Applicative Pattern where + -- | Repeat the given value once per cycle, forever + pure v = Pattern Digital $ \(State a _) -> + map (\a' -> Event a' (sect a a') v) $ cycleArcsInArc a + + (<*>) pf@(Pattern Digital _) px@(Pattern Digital _) = Pattern Digital q where q st = catMaybes $ concatMap match $ query pf st where match (Event fWhole fPart f) = map (\(Event xWhole xPart x) -> - do whole' <- combineWholes fWhole xWhole + do whole' <- subArc xWhole fWhole part' <- subArc fPart xPart return (Event whole' part' (f x)) ) (query px $ st {arc = fPart}) + (<*>) pf@(Pattern Digital _) px@(Pattern Analog _) = Pattern Digital q + where q st = concatMap match $ query pf st + where + match (Event fWhole fPart f) = + map + (Event fWhole fPart . f . value) + (query px $ st {arc = pure (start fPart)}) -instance Applicative Pattern where - -- | Repeat the given value once per cycle, forever - pure v = Pattern $ \(State a _) -> - map (\a' -> Event a' (sect a a') v) $ cycleArcsInArc a + (<*>) pf@(Pattern Analog _) px@(Pattern Digital _) = Pattern Digital q + where q st = concatMap match $ query px st + where + match (Event xWhole xPart x) = + map + (\e -> Event xWhole xPart (value e x)) + (query pf st {arc = pure (start xPart)}) - (<*>) = applyPatToPat subArc + (<*>) pf px = Pattern Analog q + where q st = concatMap match $ query pf st + where + match ef = + map + (Event (arc st) (arc st) . value ef . value) + (query px st) --- | Like <*>, but the 'wholes' come from the left +-- | Like <*>, but the structure only comes from the left (<*) :: Pattern (a -> b) -> Pattern a -> Pattern b -(<*) = applyPatToPat (\a _ -> Just a) +(<*) pf@(Pattern Analog _) px@(Pattern Analog _) = Pattern Analog q + where q st = concatMap match $ query pf st + where + match (Event fWhole fPart f) = + map + (Event fWhole fPart . f . value) $ + query px st -- for continuous events, use the original query --- | Like <*>, but the 'wholes' come from the right +-- If one of the patterns is digital, treat both as digital.. (TODO - needs extra thought) +(<*) pf px = Pattern Digital q + where q st = catMaybes $ concatMap match $ query pf st + where + match (Event fWhole fPart f) = + map + (\(Event _ xPart x) -> + do let whole' = fWhole + part' <- subArc fPart xPart + return (Event whole' part' (f x)) + ) + (query px $ st {arc = fPart}) + +-- | Like <*>, but the structure only comes from the right (*>) :: Pattern (a -> b) -> Pattern a -> Pattern b -(*>) = applyPatToPat (\_ b -> Just b) +(*>) pf@(Pattern Analog _) px@(Pattern Analog _) = Pattern Analog q + where q st = concatMap match $ query px st + where + match (Event xWhole xPart x) = + map + (\e -> Event xWhole xPart (value e x)) $ + query pf st -- for continuous events, use the original query +(*>) pf px = Pattern Digital q + where q st = catMaybes $ concatMap match $ query pf st + where + match (Event _ fPart f) = + map + (\(Event xWhole xPart x) -> + do let whole' = xWhole + part' <- subArc fPart xPart + return (Event whole' part' (f x)) + ) + (query px $ st {arc = fPart}) + infixl 4 <*, *> instance Monad Pattern where @@ -597,10 +659,16 @@ -- * Internal functions empty :: Pattern a -empty = Pattern {query = const []} +empty = Pattern {nature = Digital, query = const []} queryArc :: Pattern a -> Arc -> [Event a] queryArc p a = query p $ State a Map.empty + +isDigital :: Pattern a -> Bool +isDigital = (== Digital) . nature + +isAnalog :: Pattern a -> Bool +isAnalog = not . isDigital -- | Splits queries that span cycles. For example `query p (0.5, 1.5)` would be -- turned into two queries, `(0.5,1)` and `(1,1.5)`, and the results diff --git a/src/Sound/Tidal/UI.hs b/src/Sound/Tidal/UI.hs --- a/src/Sound/Tidal/UI.hs +++ b/src/Sound/Tidal/UI.hs @@ -79,7 +79,7 @@ @ -} rand :: Fractional a => Pattern a -rand = Pattern (\(State a@(Arc s e) _) -> [Event a a (realToFrac $ timeToRand $ (e + s)/2)]) +rand = Pattern Analog (\(State a@(Arc s e) _) -> [Event a a (realToFrac $ timeToRand $ (e + s)/2)]) {- | 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: @@ -987,7 +987,7 @@ -- TODO - what does this do? Something for @stripe@ .. randStruct :: Int -> Pattern Int -randStruct n = splitQueries $ Pattern {query = f} +randStruct n = splitQueries $ Pattern {nature = Digital, query = f} where f st = map (\(a,b,c) -> Event a (fromJust b) c) $ filter (\(_,x,_) -> isJust x) as where as = map (\(i, Arc s' e') -> (Arc (s' + sam s) (e' + sam s), @@ -1088,7 +1088,7 @@ markovPat = tParam2 _markovPat _markovPat :: Int -> Int -> [[Double]] -> Pattern Int -_markovPat n xi tp = splitQueries $ Pattern (\(State a@(Arc s e) _) -> +_markovPat n xi tp = splitQueries $ Pattern Digital (\(State a@(Arc s e) _) -> queryArc (listToPat $ runMarkov n tp xi (sam s)) a) {-| @@ -1281,7 +1281,7 @@ randrun :: Int -> Pattern Int randrun 0 = silence randrun n' = - splitQueries $ Pattern (\(State a@(Arc s _) _) -> events a $ sam s) + splitQueries $ Pattern Digital (\(State a@(Arc s _) _) -> events a $ sam s) where events a seed = mapMaybe toEv $ zip arcs shuffled where shuffled = map snd $ sortOn fst $ zip rs [0 .. (n'-1)] rs = timeToRands seed n' @@ -1718,7 +1718,7 @@ -- | Serialises a pattern so there's only one event playing at any one -- time, making it 'monophonic'. Events which start/end earlier are given priority. mono :: Pattern a -> Pattern a -mono p = Pattern $ \(State a cm) -> flatten $ query p (State a cm) where +mono p = Pattern Digital $ \(State a cm) -> flatten $ query p (State a cm) where flatten :: [Event a] -> [Event a] flatten = mapMaybe constrainPart . truncateOverlaps . sortOn whole truncateOverlaps [] = [] @@ -1739,7 +1739,7 @@ -- smooth :: Pattern Double -> Pattern Double smooth :: Fractional a => Pattern a -> Pattern a -smooth p = Pattern $ \st@(State a cm) -> tween st a $ query monoP (State (midArc a) cm) +smooth p = Pattern Analog $ \st@(State a cm) -> tween st a $ query monoP (State (midArc a) cm) where midArc a = Arc (mid (start a, stop a)) (mid (start a, stop a)) tween _ _ [] = [] diff --git a/src/Sound/Tidal/Version.hs b/src/Sound/Tidal/Version.hs --- a/src/Sound/Tidal/Version.hs +++ b/src/Sound/Tidal/Version.hs @@ -1,4 +1,4 @@ module Sound.Tidal.Version where tidal_version :: String -tidal_version = "1.2.1" +tidal_version = "1.3.0" diff --git a/test/Sound/Tidal/CoreTest.hs b/test/Sound/Tidal/CoreTest.hs --- a/test/Sound/Tidal/CoreTest.hs +++ b/test/Sound/Tidal/CoreTest.hs @@ -105,14 +105,14 @@ (map value $ queryArc ((+1) <$> saw) (Arc 0.5 0.5)) `shouldBe` [1.5 :: Float] it "works on the left of <*>" $ do (queryArc ((+) <$> saw <*> pure 3) (Arc 0 1)) - `shouldBe` fmap toEvent [(((0,1), (0,1)), 3.5 :: Float)] + `shouldBe` fmap toEvent [(((0,1), (0,1)), 3 :: Float)] it "works on the right of <*>" $ do (queryArc ((fast 4 $ pure (+3)) <*> saw) (Arc 0 1)) `shouldBe` fmap toEvent - [(((0,0.25), (0,0.25)), 3.125 :: Float), - (((0.25,0.5), (0.25,0.5)), 3.375), - (((0.5,0.75), (0.5,0.75)), 3.625), - (((0.75,1), (0.75,1)), 3.875) + [(((0,0.25), (0,0.25)), 3 :: Float), + (((0.25,0.5), (0.25,0.5)), 3.25), + (((0.5,0.75), (0.5,0.75)), 3.5), + (((0.75,1), (0.75,1)), 3.75) ] it "can be reversed" $ do it "works with whole cycles" $ diff --git a/test/Sound/Tidal/UITest.hs b/test/Sound/Tidal/UITest.hs --- a/test/Sound/Tidal/UITest.hs +++ b/test/Sound/Tidal/UITest.hs @@ -44,7 +44,7 @@ it "can hold a value over multiple cycles" $ do comparePD (Arc 0 8) (segment 0.5 saw) - (slow 2 "0" :: Pattern Double) + (slow 2 "0.5" :: Pattern Double) {- -- not sure what this is supposed to do! it "holding values over multiple cycles works in combination" $ do diff --git a/tidal.cabal b/tidal.cabal --- a/tidal.cabal +++ b/tidal.cabal @@ -1,5 +1,5 @@ name: tidal -version: 1.2.1 +version: 1.3.0 synopsis: Pattern language for improvised music -- description: homepage: http://tidalcycles.org/ diff --git a/tidal.el b/tidal.el --- a/tidal.el +++ b/tidal.el @@ -95,7 +95,7 @@ nil tidal-interpreter-arguments) (tidal-see-output)) - (tidal-send-string (concat ":script /home/alex/src/tidal/BootTidal.hs")) + (tidal-send-string (concat ":script " tidal-boot-script-path)) ) (defun tidal-see-output ()