tidal 1.3.0 → 1.4.0
raw patch · 13 files changed
+293/−275 lines, 13 filesdep +primitive
Dependencies added: primitive
Files
- CHANGELOG.md +10/−0
- src/Sound/Tidal/Carabiner.hs +4/−6
- src/Sound/Tidal/Control.hs +11/−9
- src/Sound/Tidal/Core.hs +10/−12
- src/Sound/Tidal/Pattern.hs +100/−105
- src/Sound/Tidal/Simple.hs +1/−0
- src/Sound/Tidal/Stream.hs +15/−12
- src/Sound/Tidal/UI.hs +49/−40
- src/Sound/Tidal/Version.hs +1/−1
- test/Sound/Tidal/CoreTest.hs +13/−13
- test/Sound/Tidal/PatternTest.hs +54/−53
- test/Sound/Tidal/UITest.hs +23/−23
- tidal.cabal +2/−1
CHANGELOG.md view
@@ -1,5 +1,15 @@ # TidalCycles log of changes +## 1.4.0 - Padley Gorge++* fix representation to handle continuous and analog events properly @yaxu++## 1.3.0 - rolled back to 1.1.2++## 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)
src/Sound/Tidal/Carabiner.hs view
@@ -1,9 +1,10 @@+{-# OPTIONS_GHC -fno-warn-dodgy-imports -fno-warn-name-shadowing #-} 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 Control.Concurrent (forkIO, takeMVar, putMVar) import qualified Sound.Tidal.Stream as S import Sound.Tidal.Tempo import System.Clock@@ -12,9 +13,6 @@ import Data.Maybe (isJust, fromJust) import qualified Sound.OSC.FD as O -port :: Int-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"@@ -53,7 +51,7 @@ d = nowO - m start' = ((fromIntegral $ fromJust start) / 1000000) startO = start' + d- cyc = toRational $ (fromJust beat) / (fromIntegral bpc)+ -- cyc = toRational $ (fromJust beat) / (fromIntegral bpc) tempo <- takeMVar (S.sTempoMV tidal) let tempo' = tempo {atTime = startO + latency, atCycle = 0,@@ -63,5 +61,5 @@ act _ _ _ name _ = putStr $ "Unhandled thingie " ++ name sendMsg :: Socket -> String -> IO ()-sendMsg sock msg = do send sock $ B8.pack msg+sendMsg sock msg = do _ <- send sock $ B8.pack msg return ()
src/Sound/Tidal/Control.hs view
@@ -65,7 +65,9 @@ _chop n = withEvents (concatMap chopEvent) where -- for each part, chopEvent :: Event ControlMap -> [Event ControlMap]- chopEvent (Event w p' v) = map (chomp v (length $ chopArc w n)) $ arcs w p'+ chopEvent (Event (Just w) p' v) = map (chomp v (length $ chopArc w n)) $ arcs w p'+ -- ignoring 'analog' events (those without wholes),+ chopEvent _ = [] -- cut whole into n bits, and number them arcs w' p' = numberedArcs p' $ chopArc w' n -- each bit is a new whole, with part that's the intersection of old part and new whole@@ -77,7 +79,7 @@ -- begin and end values by the old difference (end-begin), and -- add the old begin chomp :: ControlMap -> Int -> (Int, (Arc, Arc)) -> Event ControlMap- chomp v n' (i, (w,p')) = Event w p' (Map.insert "begin" (VF b') $ Map.insert "end" (VF e') v)+ chomp v n' (i, (w,p')) = Event (Just w) p' (Map.insert "begin" (VF b') $ Map.insert "end" (VF e') v) where b = fromMaybe 0 $ do v' <- Map.lookup "begin" v getF v' e = fromMaybe 1 $ do v' <- Map.lookup "end" v@@ -368,12 +370,12 @@ msec p = ((realToFrac . (/1000)) <$> cF 1 "_cps") *| p _trigger :: Show a => Bool -> a -> Pattern b -> Pattern b-_trigger quantise k pat = pat {query = q}+_trigger quant k pat = pat {query = q} where q st = query ((offset st) ~> pat) st- f | quantise = fromIntegral . round+ f | quant = (fromIntegral :: Int -> Rational) . round | otherwise = id- offset st = fromMaybe (pure 0) $ do pat <- Map.lookup ctrl (controls st)- return $ ((f . fromMaybe 0 . getR) <$> pat)+ offset st = fromMaybe (pure 0) $ do p <- Map.lookup ctrl (controls st)+ return $ ((f . fromMaybe 0 . getR) <$> p) ctrl = "_t_" ++ show k trigger :: Show a => a -> Pattern b -> Pattern b@@ -392,10 +394,10 @@ _getP d f pat = (fromMaybe d . f) <$> pat _cX :: a -> (Value -> Maybe a) -> String -> Pattern a-_cX d f s = Pattern Analog $ \(State a m) -> queryArc (maybe (pure d) (_getP d f) $ Map.lookup s m) a+_cX d f s = Pattern $ \(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 Analog $ \(State a m) -> queryArc (maybe silence (_getP_ f) $ Map.lookup s m) a+_cX_ f s = Pattern $ \(State a m) -> queryArc (maybe silence (_getP_ f) $ Map.lookup s m) a cF :: Double -> String -> Pattern Double cF d = _cX d getF@@ -439,7 +441,7 @@ cS0 :: String -> Pattern String cS0 = _cX "" getS -cP :: String -> Pattern String+cP :: (Enumerable a, Parseable a) => String -> Pattern a cP s = innerJoin $ parseBP_E <$> (_cX_ getS s) -- Default controller inputs (for MIDI)
src/Sound/Tidal/Core.hs view
@@ -17,10 +17,10 @@ -- | Takes a function from time to values, and turns it into a 'Pattern'. sig :: (Time -> a) -> Pattern a-sig f = Pattern Analog q+sig f = Pattern q where q (State (Arc s e) _) | s > e = []- | otherwise = [Event (Arc s e) (Arc s e) (f (s+((e-s)/2)))]+ | otherwise = [Event Nothing (Arc s e) (f (s+((e-s)/2)))] -- | @sine@ returns a 'Pattern' of continuous 'Fractional' values following a -- sinewave with frequency of one cycle, and amplitude from 0 to 1.@@ -190,8 +190,7 @@ -- in turn, then the second cycle from each, and so on. cat :: [Pattern a] -> Pattern a cat [] = silence--- TODO I *guess* it would be digital..-cat ps = Pattern Digital q+cat ps = Pattern $ 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))}@@ -234,10 +233,7 @@ -- | 'overlay' combines two 'Pattern's into a new pattern, so that -- their events are combined over time. overlay :: Pattern a -> Pattern a -> Pattern a--- 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+overlay !p !p' = Pattern $ \st -> query p st ++ query p' st -- | An infix alias of @overlay@ (<>) :: Pattern a -> Pattern a -> Pattern a@@ -307,11 +303,13 @@ }) } where makeWholeRelative :: Event a -> Event a- makeWholeRelative (Event (Arc s e) p'@(Arc s' e') v) =- Event (Arc (s'-s) (e'-e)) p' v+ makeWholeRelative (e@(Event Nothing _ _)) = e+ makeWholeRelative (Event (Just (Arc s e)) p'@(Arc s' e') v) =+ Event (Just $ Arc (s'-s) (e-e')) p' v makeWholeAbsolute :: Event a -> Event a- makeWholeAbsolute (Event (Arc s e) p'@(Arc s' e') v) =- Event (Arc (s'-e) (e'+s)) p' v+ makeWholeAbsolute (e@(Event Nothing _ _)) = e+ makeWholeAbsolute (Event (Just (Arc s e)) p'@(Arc s' e') v) =+ Event (Just $ Arc (s'-e) (e'+s)) p' v midCycle :: Arc -> Time midCycle (Arc s _) = sam s + 0.5 mapParts :: (Arc -> Arc) -> [Event a] -> [Event a]
src/Sound/Tidal/Pattern.hs view
@@ -7,7 +7,7 @@ import Prelude hiding ((<*), (*>)) import Control.Applicative (liftA2)-import Data.Bifunctor (Bifunctor(..))+--import Data.Bifunctor (Bifunctor(..)) import Data.Data (Data) -- toConstr import Data.List (delete, findIndex, sort, intercalate) import qualified Data.Map.Strict as Map@@ -86,6 +86,11 @@ | otherwise = Nothing where (Arc s'' e'') = sect a b +subMaybeArc :: Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)+subMaybeArc (Just a) (Just b) = do sa <- subArc a b+ return $ Just sa+subMaybeArc _ _ = Just Nothing+ instance Applicative ArcF where pure t = Arc t t (<*>) (Arc sf ef) (Arc sx ex) = Arc (sf sx) (ef ex)@@ -131,11 +136,10 @@ isIn :: Arc -> Time -> Bool isIn (Arc s e) t = t >= s && t < e --- | An event is a value that's active during a timespan--- The part should be equal to or fit inside the--- whole+-- | An event is a value that's active during a timespan. If a whole+-- is present, the part should be equal to or fit inside it. data EventF a b = Event- { whole :: a+ { whole :: Maybe a , part :: a , value :: b } deriving (Eq, Ord, Functor)@@ -146,17 +150,27 @@ NFData (EventF a b) where rnf (Event w p v) = rnf w `seq` rnf p `seq` rnf v -instance Bifunctor EventF where+{-instance Bifunctor EventF where bimap f g (Event w p e) = Event (f w) (f p) (g e)+-} instance {-# OVERLAPPING #-} Show a => Show (Event a) where- show (Event (Arc ws we) a@(Arc ps pe) e) =+ show (Event (Just (Arc ws we)) a@(Arc ps pe) e) = h ++ "(" ++ show a ++ ")" ++ t ++ "|" ++ show e where h | ws == ps = "" | otherwise = prettyRat ws ++ "-" t | we == pe = "" | otherwise = "-" ++ prettyRat we+ show (Event Nothing a e) =+ "~" ++ show a ++ "~|" ++ show e +isAnalog :: Event a -> Bool+isAnalog (Event {whole = Nothing}) = True+isAnalog _ = False++isDigital :: Event a -> Bool+isDigital = not . isAnalog+ -- | `True` if an `Event`'s starts is within given `Arc` onsetIn :: Arc -> Event a -> Bool onsetIn a e = isIn a (wholeStart e)@@ -186,13 +200,17 @@ (stop (part e') == start (part e)) ) +wholeOrPart :: Event a -> Arc+wholeOrPart (Event {whole = Just a}) = a+wholeOrPart e = part e+ -- | Get the onset of an event's 'whole' wholeStart :: Event a -> Time-wholeStart = start . whole+wholeStart = start . wholeOrPart -- | Get the offset of an event's 'whole' wholeStop :: Event a -> Time-wholeStop = stop . whole+wholeStop = stop . wholeOrPart -- | Get the onset of an event's 'whole' eventPartStart :: Event a -> Time@@ -210,10 +228,12 @@ eventValue = value eventHasOnset :: Event a -> Bool-eventHasOnset e = start (whole e) == start (part e)+eventHasOnset e | isAnalog e = False+ | otherwise = start (fromJust $ whole e) == start (part e) +-- TODO - Is this used anywhere? Just tests, it seems toEvent :: (((Time, Time), (Time, Time)), a) -> Event a-toEvent (((ws, we), (ps, pe)), v) = Event (Arc ws we) (Arc ps pe) v+toEvent (((ws, we), (ps, pe)), v) = Event (Just $ Arc ws we) (Arc ps pe) v -- | an Arc and some named control values data State = State {arc :: Arc,@@ -223,13 +243,8 @@ -- | A function that represents events taking place over time type Query a = (State -> [Event 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}+-- | A datatype that's basically a query+data Pattern a = Pattern {query :: Query a} data Value = VS { svalue :: String } | VF { fvalue :: Double }@@ -306,96 +321,73 @@ 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} -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+applyPatToPat :: (Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)) -> Pattern (a -> b) -> Pattern a -> Pattern b+applyPatToPat combineWholes pf px = Pattern q where q st = catMaybes $ concatMap match $ query pf st where- match (Event fWhole fPart f) =+ match (ef@(Event _ fPart f)) = map- (\(Event xWhole xPart x) ->- do whole' <- subArc xWhole fWhole+ (\ex@(Event _ xPart x) ->+ do whole' <- combineWholes (whole ef) (whole ex) 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+ (query px $ st {arc = (wholeOrPart ef)})++instance Applicative Pattern where+ -- | Repeat the given value once per cycle, forever+ pure v = Pattern $ \(State a _) ->+ map (\a' -> Event (Just a') (sect a a') v) $ cycleArcsInArc a++ (<*>) = applyPatToPatBoth++applyPatToPatBoth :: Pattern (a -> b) -> Pattern a -> Pattern b+applyPatToPatBoth pf px = Pattern q+ where q st = catMaybes $ (concatMap match $ query pf st) ++ (concatMap matchX $ query (filterAnalog px) st) where- match (Event fWhole fPart f) =- map- (Event fWhole fPart . f . value)- (query px $ st {arc = pure (start fPart)})+ -- match analog events from pf with all events from px+ match ef@(Event Nothing fPart _) = map (withFX ef) (query px $ st {arc = fPart}) -- analog+ -- match digital events from pf with digital events from px+ match ef@(Event (Just fWhole) _ _) = map (withFX ef) (query (filterDigital px) $ st {arc = fWhole}) -- digital+ -- match analog events from px (constrained above) with digital events from px+ matchX ex@(Event Nothing fPart _) = map (\ef -> withFX ef ex) (query (filterDigital pf) $ st {arc = fPart}) -- digital+ matchX _ = error "can't happen"+ withFX ef ex = do whole' <- subMaybeArc (whole ef) (whole ex)+ part' <- subArc (part ef) (part ex)+ return (Event whole' part' (value ef $ value ex)) - (<*>) pf@(Pattern Analog _) px@(Pattern Digital _) = Pattern Digital q- where q st = concatMap match $ query px st+applyPatToPatLeft :: Pattern (a -> b) -> Pattern a -> Pattern b+applyPatToPatLeft pf px = Pattern q+ where q st = catMaybes $ (concatMap match $ query pf st) where- match (Event xWhole xPart x) =- map- (\e -> Event xWhole xPart (value e x))- (query pf st {arc = pure (start xPart)})+ match ef = map (withFX ef) (query px $ st {arc = wholeOrPart ef})+ withFX ef ex = do let whole' = whole ef+ part' <- subArc (part ef) (part ex)+ return (Event whole' part' (value ef $ value ex)) - (<*>) pf px = Pattern Analog q- where q st = concatMap match $ query pf st+applyPatToPatRight :: Pattern (a -> b) -> Pattern a -> Pattern b+applyPatToPatRight pf px = Pattern q+ where q st = catMaybes $ (concatMap match $ query px st) where- match ef =- map- (Event (arc st) (arc st) . value ef . value)- (query px st)+ match ex = map (\ef -> withFX ef ex) (query pf $ st {arc = wholeOrPart ex})+ withFX ef ex = do let whole' = whole ex+ part' <- subArc (part ef) (part ex)+ return (Event whole' part' (value ef $ value ex)) --- | Like <*>, but the structure only comes from the left-(<*) :: Pattern (a -> b) -> Pattern a -> Pattern b-(<*) 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 --- 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 'wholes' come from the left+(<*) :: Pattern (a -> b) -> Pattern a -> Pattern b+(<*) = applyPatToPatLeft --- | Like <*>, but the structure only comes from the right+-- | Like <*>, but the 'wholes' come from the right (*>) :: Pattern (a -> b) -> Pattern a -> Pattern 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})+(*>) = applyPatToPatRight infixl 4 <*, *> @@ -421,7 +413,7 @@ (query pp st) munge ow op (Event iw ip v') = do- w' <- subArc ow iw+ w' <- subMaybeArc ow iw p' <- subArc op ip return (Event w' p' v') @@ -444,8 +436,8 @@ outerJoin :: Pattern (Pattern a) -> Pattern a outerJoin pp = pp {query = q} where q st = concatMap- (\(Event w p v) ->- mapMaybe (munge w p) $ query v st {arc = pure (start w)}+ (\e ->+ mapMaybe (munge (whole e) (part e)) $ query (value e) st {arc = pure (start $ wholeOrPart e)} ) (query pp st) where munge ow op (Event _ _ v') =@@ -459,12 +451,12 @@ squeezeJoin :: Pattern (Pattern a) -> Pattern a squeezeJoin pp = pp {query = q} where q st = concatMap- (\(Event w p v) ->- mapMaybe (munge w p) $ query (compressArc (cycleArc w) v) st {arc = p}+ (\e@(Event w p v) ->+ mapMaybe (munge w p) $ query (compressArc (cycleArc $ wholeOrPart e) v) st {arc = p} ) (query pp st) munge oWhole oPart (Event iWhole iPart v) =- do w' <- subArc oWhole iWhole+ do w' <- subMaybeArc oWhole iWhole p' <- subArc oPart iPart return (Event w' p' v) @@ -659,17 +651,11 @@ -- * Internal functions empty :: Pattern a-empty = Pattern {nature = Digital, query = const []}+empty = Pattern {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 -- combined. Being able to assume queries don't span cycles often@@ -680,7 +666,7 @@ -- | Apply a function to the arcs/timespans (both whole and parts) of the result withResultArc :: (Arc -> Arc) -> Pattern a -> Pattern a withResultArc f pat = pat- { query = map (\(Event w p e) -> Event (f w) (f p) e) . query pat}+ { query = map (\(Event w p e) -> Event (f <$> w) (f p) e) . query pat} -- | Apply a function to the time (both start and end of the timespans -- of both whole and parts) of the result@@ -798,8 +784,17 @@ filterWhen test p = p {query = filter (test . wholeStart) . query p} filterOnsets :: Pattern a -> Pattern a-filterOnsets p = p {query = filter (\e -> eventPartStart e == wholeStart e) . query p}+filterOnsets p = p {query = filter (\e -> eventPartStart e == wholeStart e) . query (filterDigital p)} +filterEvents :: (Event a -> Bool) -> Pattern a -> Pattern a+filterEvents f p = p {query = filter f . query p}++filterDigital :: Pattern a -> Pattern a+filterDigital = filterEvents isDigital++filterAnalog :: Pattern a -> Pattern a+filterAnalog = filterEvents isAnalog+ playFor :: Time -> Time -> Pattern a -> Pattern a playFor s e = filterWhen (\t -> (t >= s) && (t < e)) @@ -823,7 +818,7 @@ matchManyToOne f pa pb = pa {query = q} where q st = map match $ query pb st where- match (Event xWhole xPart x) =- Event xWhole xPart (any (f x) (as $ start xWhole), x)+ match (ex@(Event xWhole xPart x)) =+ Event xWhole xPart (any (f x) (as $ start $ wholeOrPart ex), x) as s = map value $ query pa $ fQuery s fQuery s = st {arc = Arc s s}
src/Sound/Tidal/Simple.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Sound.Tidal.Simple where
src/Sound/Tidal/Stream.hs view
@@ -148,12 +148,12 @@ toMessage :: Config -> Double -> OSCTarget -> T.Tempo -> Event (Map.Map String Value) -> Maybe O.Message toMessage config t target tempo e = do vs <- toData target addExtra return $ O.Message (oPath target) $ oPreamble target ++ vs- where on = sched tempo $ start $ whole e- off = sched tempo $ stop $ whole e- identifier = ((if (start $ whole e) == (start $ part e) then "X" else ">")- ++ show (start $ whole e)+ where on = sched tempo $ start $ wholeOrPart e+ off = sched tempo $ stop $ wholeOrPart e+ identifier = ((if (start $ wholeOrPart e) == (start $ part e) then "X" else ">")+ ++ show (start $ wholeOrPart e) ++ "-"- ++ show (stop $ whole e)+ ++ show (stop $ wholeOrPart e) ++ "-" ++ getString "n" ++ "-"@@ -177,7 +177,7 @@ | otherwise = id extra False = addIdentifier [("cps", (VF $ T.cps tempo)), ("delta", VF delta),- ("cycle", VF (fromRational $ start $ whole e))+ ("cycle", VF (fromRational $ start $ wholeOrPart e)) ] extra True = timestamp ++ (extra False) timestamp = [("sec", VI sec),@@ -202,10 +202,11 @@ tempo <- readMVar tempoMV now <- O.time let sMap' = Map.insert "_cps" (pure $ VF $ T.cps tempo) sMap- es = filterEvents $ query p (State {arc = T.nowArc st, controls = sMap'})- filterEvents | cSendParts config = id- | otherwise = filter eventHasOnset- on e = (sched tempo $ start $ whole e) + eventNudge e+ es = filterOns $ query p (State {arc = T.nowArc st, controls = sMap'})+ filterOns | cSendParts config = id+ | otherwise = filter eventHasOnset+ -- there should always be a whole (due to the eventHasOnset filter)+ on e = (sched tempo $ start $ wholeOrPart e) + eventNudge e eventNudge e = fromJust $ getF $ fromMaybe (VF 0) $ Map.lookup "nudge" $ value e messages target = catMaybes $ map (\e -> do m <- toMessage config (on e + latency target) target tempo e return $ (on e, m)@@ -309,8 +310,10 @@ controls = sMap' } )- at e = sched fakeTempo $ start $ whole e- on e = sched tempo $ start $ whole e+ -- there should always be a whole (due to the eventHasOnset filter)+ at e = sched fakeTempo $ start $ wholeOrPart e+ -- there should always be a whole (due to the eventHasOnset filter)+ on e = sched tempo $ start $ wholeOrPart e cpsChanges = map (\e -> (on e - now, Map.lookup "cps" $ value e)) es config = sConfig st messages target =
src/Sound/Tidal/UI.hs view
@@ -9,6 +9,7 @@ -- import System.Random (randoms, mkStdGen) import System.Random.MWC import Control.Monad.ST+import Control.Monad.Primitive (PrimState, PrimMonad) import qualified Data.Vector as V import Data.Word (Word32) import Data.Ratio ((%),numerator,denominator)@@ -28,7 +29,7 @@ -- * UI -- | Randomisation-+timeToSeed :: (PrimMonad m, Real a) => a -> m (Gen (PrimState m)) timeToSeed x = do let x' = toRational (x*x) / 1000000 let n' = fromIntegral $ numerator x'@@ -79,7 +80,7 @@ @ -} rand :: Fractional a => Pattern a-rand = Pattern Analog (\(State a@(Arc s e) _) -> [Event a a (realToFrac $ timeToRand $ (e + s)/2)])+rand = Pattern (\(State a@(Arc s e) _) -> [Event Nothing 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:@@ -196,16 +197,16 @@ degradeBy = tParam _degradeBy _degradeBy :: Double -> Pattern a -> Pattern a-_degradeBy x p = fmap fst $ filterValues ((> x) . snd) $ (,) <$> p <*> rand+_degradeBy x p = fmap fst $ filterValues ((> x) . snd) $ (,) <$> p <* rand unDegradeBy :: Pattern Double -> Pattern a -> Pattern a unDegradeBy = tParam _unDegradeBy _unDegradeBy :: Double -> Pattern a -> Pattern a-_unDegradeBy x p = fmap fst $ filterValues ((<= x) . snd) $ (,) <$> p <*> rand+_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 <*> fastRepeatCycles i rand) <$> slow (fromIntegral i) tx+degradeOverBy i tx p = unwrap $ (\x -> fmap fst $ filterValues ((> x) . snd) $ (,) <$> p <* fastRepeatCycles i rand) <$> slow (fromIntegral i) tx {- | Use @sometimesBy@ to apply a given function "sometimes". For example, the@@ -969,7 +970,7 @@ substruct :: Pattern String -> Pattern b -> Pattern b substruct s p = p {query = f} where f st =- concatMap ((\a' -> queryArc (compressArcTo a' p) a') . whole) (query s st)+ concatMap ((\a' -> queryArc (compressArcTo a' p) a') . fromJust . whole) $ filter isDigital $ (query s st) randArcs :: Int -> Pattern [Arc] randArcs n =@@ -987,8 +988,8 @@ -- TODO - what does this do? Something for @stripe@ .. randStruct :: Int -> Pattern Int-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+randStruct n = splitQueries $ Pattern {query = f}+ where f st = map (\(a,b,c) -> Event (Just a) (fromJust b) c) $ filter (\(_,x,_) -> isJust x) as where as = map (\(i, Arc s' e') -> (Arc (s' + sam s) (e' + sam s), subArc (Arc s e) (Arc (s' + sam s) (e' + sam s)), i)) $@@ -998,7 +999,10 @@ -- TODO - what does this do? substruct' :: Pattern Int -> Pattern a -> Pattern a-substruct' s p = p {query = \st -> concatMap (\(Event a' _ i) -> queryArc (compressArcTo a' (inside (pure $ 1/toRational(length (queryArc s (Arc (sam (start $ arc st)) (nextSam (start $ arc st)))))) (rotR (toRational i)) p)) a') (query s st)}+substruct' s p = p {query = \st -> concatMap (f st) (query s st)}+ where f st (Event (Just a') _ i) = queryArc (compressArcTo a' (inside (pure $ 1/toRational(length (queryArc s (Arc (sam (start $ arc st)) (nextSam (start $ arc st)))))) (rotR (toRational i)) p)) a'+ -- Ignore analog events (ones without wholes)+ f _ _ = [] -- | @stripe n p@: repeats pattern @p@, @n@ times per cycle. So -- similar to @fast@, but with random durations. The repetitions will@@ -1064,10 +1068,10 @@ transition probability from state 0->0 is 2/5, 0->1 is 3/5, 1->0 is 1/4, and 1->1 is 3/4. -} runMarkov :: Int -> [[Double]] -> Int -> Time -> [Int]-runMarkov n tp xi seed = reverse $ (iterate (markovStep $ renorm tp) [xi])!! (n-1) where- markovStep tp xs = (fromJust $ findIndex (r <=) $ scanl1 (+) (tp!!(head xs))) : xs where+runMarkov n tp xi seed = reverse $ (iterate (markovStep $ renorm) [xi])!! (n-1) where+ markovStep tp' xs = (fromJust $ findIndex (r <=) $ scanl1 (+) (tp'!!(head xs))) : xs where r = timeToRand $ seed + (fromIntegral . length) xs / fromIntegral n- renorm tp = [ map (/ sum x) x | x <- tp ]+ renorm = [ map (/ sum x) x | x <- tp ] {- @markovPat n xi tp@ generates a one-cycle pattern of @n@ steps in a Markov chain starting from state @xi@ with transition matrix @tp@. Each row of the@@ -1088,7 +1092,7 @@ markovPat = tParam2 _markovPat _markovPat :: Int -> Int -> [[Double]] -> Pattern Int-_markovPat n xi tp = splitQueries $ Pattern Digital (\(State a@(Arc s e) _) -> +_markovPat n xi tp = splitQueries $ Pattern (\(State a@(Arc s _) _) -> queryArc (listToPat $ runMarkov n tp xi (sam s)) a) {-|@@ -1138,7 +1142,7 @@ stretch :: Pattern a -> Pattern a -- TODO - should that be whole or part? stretch p = splitQueries $ p {query = q}- where q st = query (zoomArc (cycleArc $ enclosingArc $ map whole $ query p (st {arc = Arc (sam s) (nextSam s)})) p) st+ where q st = query (zoomArc (cycleArc $ enclosingArc $ map wholeOrPart $ 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:@@ -1203,7 +1207,7 @@ loopFirst p = splitQueries $ p {query = f} where f st = map (\(Event w p' v) ->- Event (plus w) (plus p') v) $+ Event (plus <$> w) (plus p') v) $ query p (st {arc = minus $ arc st}) where minus = fmap (subtract (sam s)) plus = fmap (+ sam s)@@ -1281,14 +1285,14 @@ randrun :: Int -> Pattern Int randrun 0 = silence randrun n' =- splitQueries $ Pattern Digital (\(State a@(Arc s _) _) -> events a $ sam s)+ splitQueries $ Pattern (\(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' arcs = zipWith Arc fractions (tail fractions) fractions = map (+ (sam $ start a)) [0, 1 / fromIntegral n' .. 1] toEv (a',v) = do a'' <- subArc a a'- return $ Event a' a'' v+ return $ Event (Just a') a'' v 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)@@ -1303,7 +1307,7 @@ transform _ _ = id transform' str (Arc s e) p = s `rotR` inside (pure $ 1/(e-s)) (matchF str) p matchF str = fromMaybe id $ lookup str fs- timedValues = withEvent (\(Event a a' v) -> Event a a' (a,v))+ timedValues = withEvent (\(Event (Just a) a' v) -> Event (Just a) a' (a,v)) . filterDigital inhabit :: [(String, Pattern a)] -> Pattern String -> Pattern a inhabit ps p = squeezeJoin $ (\s -> fromMaybe silence $ lookup s ps) <$> p@@ -1341,13 +1345,15 @@ arpWith f p = withEvents munge p where munge es = concatMap (spreadOut . f) (groupBy (\a b -> whole a == whole b) $ sortOn whole es) spreadOut xs = mapMaybe (\(n, x) -> shiftIt n (length xs) x) $ enumerate xs- shiftIt n d (Event (Arc s e) a' v) =+ shiftIt n d (Event (Just (Arc s e)) a' v) = do a'' <- subArc (Arc newS newE) a'- return (Event (Arc newS newE) a'' v)+ return (Event (Just $ Arc newS newE) a'' v) where newS = s + (dur * fromIntegral n) newE = newS + dur dur = (e - s) / fromIntegral d+ -- TODO ignoring analog events.. Should we just leave them as-is?+ shiftIt _ _ _ = Nothing arp :: Pattern String -> Pattern a -> Pattern a arp = tParam _arp@@ -1412,10 +1418,10 @@ -- Uses the first (binary) pattern to switch between the following two -- patterns. sew :: Pattern Bool -> Pattern a -> Pattern a -> Pattern a-sew stitch a b = overlay (mask stitch a) (mask (inv stitch) b)+sew pb a b = overlay (mask pb a) (mask (inv pb) b) stitch :: Pattern Bool -> Pattern a -> Pattern a -> Pattern a-stitch bool a b = overlay (struct bool a) (struct (inv bool) b)+stitch pb a b = overlay (struct pb a) (struct (inv pb) b) stutter :: Integral i => i -> Time -> Pattern a -> Pattern a stutter n t p = stack $ map (\i -> (t * fromIntegral i) `rotR` p) [0 .. (n-1)]@@ -1643,7 +1649,7 @@ -- | 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 pInt fs pat = innerJoin $ (\i -> _pickF i fs pat) <$> pInt _pickF :: Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a _pickF i fs p = (fs !!! i) p@@ -1718,16 +1724,17 @@ -- | 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 Digital $ \(State a cm) -> flatten $ query p (State a cm) where+mono p = Pattern $ \(State a cm) -> flatten $ query p (State a cm) where flatten :: [Event a] -> [Event a] flatten = mapMaybe constrainPart . truncateOverlaps . sortOn whole truncateOverlaps [] = [] truncateOverlaps (e:es) = e : truncateOverlaps (mapMaybe (snip e) es)- snip a b | start (whole b) >= stop (whole a) = Just b- | stop (whole b) <= stop (whole a) = Nothing- | otherwise = Just b {whole = Arc (stop $ whole a) (stop $ whole b)}+ -- TODO - decide what to do about analog events..+ snip a b | start (wholeOrPart b) >= stop (wholeOrPart a) = Just b+ | stop (wholeOrPart b) <= stop (wholeOrPart a) = Nothing+ | otherwise = Just b {whole = Just $ Arc (stop $ wholeOrPart a) (stop $ wholeOrPart b)} constrainPart :: Event a -> Maybe (Event a)- constrainPart e = do a <- subArc (whole e) (part e)+ constrainPart e = do a <- subArc (wholeOrPart e) (part e) return $ e {part = a} -- serialize the given pattern@@ -1738,24 +1745,25 @@ -- if there is, check where we are in the 'whole' of the event, and use that to tween between the values of the event and the next event -- smooth :: Pattern Double -> Pattern Double +-- TODO - test this with analog events smooth :: Fractional a => Pattern a -> Pattern a-smooth p = Pattern Analog $ \st@(State a cm) -> tween st a $ query monoP (State (midArc a) cm)+smooth p = Pattern $ \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 _ _ [] = []- tween st queryA (e:_) = maybe [e {whole = queryA, part = queryA}] (tween' queryA) (nextV st)+ tween st queryA (e:_) = maybe [e {whole = Just queryA, part = queryA}] (tween' queryA) (nextV st) where aStop = Arc (wholeStop e) (wholeStop e) nextEs st' = query monoP (st' {arc = aStop}) nextV st' | null (nextEs st') = Nothing | otherwise = Just $ value (head (nextEs st')) tween' queryA' v = [ Event- { whole = queryA'+ { whole = Just queryA' , part = queryA' , value = value e + ((v - value e) * pc)} ]- pc | delta' (whole e) == 0 = 0- | otherwise = fromRational $ (eventPartStart e - wholeStart e) / delta' (whole e)+ pc | delta' (wholeOrPart e) == 0 = 0+ | otherwise = fromRational $ (eventPartStart e - wholeStart e) / delta' (wholeOrPart e) delta' a = stop a - start a monoP = mono p @@ -1818,15 +1826,16 @@ squeezeJoinUp :: Pattern (ControlPattern) -> ControlPattern squeezeJoinUp pp = pp {query = q}- where q st = concatMap- (\(Event w p v) ->- mapMaybe (munge w p) $ query (compressArc (cycleArc w) (v |* P.speed (pure $ fromRational $ 1/(stop w - start w)))) st {arc = p}- )- (query pp st)- munge oWhole oPart (Event iWhole iPart v) =+ where q st = concatMap (f st) (query (filterDigital pp) st)+ f st (Event (Just w) p v) =+ mapMaybe (munge w p) $ query (compressArc (cycleArc w) (v |* P.speed (pure $ fromRational $ 1/(stop w - start w)))) st {arc = p}+ -- already ignoring analog events, but for completeness..+ f _ _ = []+ munge oWhole oPart (Event (Just iWhole) iPart v) = do w' <- subArc oWhole iWhole p' <- subArc oPart iPart- return (Event w' p' v)+ return (Event (Just w') p' v)+ munge _ _ _ = Nothing chew :: Int -> Pattern Int -> ControlPattern -> ControlPattern chew n ipat pat = (squeezeJoinUp $ zoompat <$> ipat) |/ P.speed (pure $ fromIntegral n)
src/Sound/Tidal/Version.hs view
@@ -1,4 +1,4 @@ module Sound.Tidal.Version where tidal_version :: String-tidal_version = "1.3.0"+tidal_version = "1.4.0"
test/Sound/Tidal/CoreTest.hs view
@@ -94,36 +94,36 @@ describe "saw" $ do it "goes from 0 up to 1 every cycle" $ do it "0" $- (queryArc saw (Arc 0 0)) `shouldBe` fmap toEvent [(((0,0), (0,0)), 0 :: Float)]+ (queryArc saw (Arc 0 0)) `shouldBe` [(Event Nothing (Arc 0 0) 0)] it "0.25" $- (queryArc saw (Arc 0.25 0.25)) `shouldBe` fmap toEvent [(((0.25,0.25), (0.25,0.25)), 0.25 :: Float)]+ (queryArc saw (Arc 0.25 0.25)) `shouldBe` [(Event Nothing (Arc 0.25 0.25) 0.25)] it "0.5" $- (queryArc saw (Arc 0.5 0.5)) `shouldBe` fmap toEvent [(((0.5,0.5), (0.5,0.5) ), 0.5 :: Float)]+ (queryArc saw (Arc 0.5 0.5)) `shouldBe` [(Event Nothing (Arc 0.5 0.5) 0.5)] it "0.75" $- (queryArc saw (Arc 0.75 0.75)) `shouldBe` fmap toEvent [(((0.75,0.75), (0.75,0.75)), 0.75 :: Float)]+ (queryArc saw (Arc 0.75 0.75)) `shouldBe` [(Event Nothing (Arc 0.75 0.75) 0.75)] it "can be added to" $ do (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 :: Float)]+ `shouldBe` [Event Nothing (Arc 0 1) 3.5] 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 :: 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)+ `shouldBe` + [Event Nothing (Arc 0 0.25) 3.5,+ Event Nothing (Arc 0.25 0.5) 3.5,+ Event Nothing (Arc 0.5 0.75) 3.5,+ Event Nothing (Arc 0.75 1) 3.5 ] it "can be reversed" $ do it "works with whole cycles" $ (queryArc (rev saw) (Arc 0 1))- `shouldBe` fmap toEvent [(((0,1), (0,1)), 0.5 :: Float)]+ `shouldBe` [(Event Nothing (Arc 0 1) 0.5)] it "works with half cycles" $ (queryArc (rev saw) (Arc 0 0.5))- `shouldBe` fmap toEvent [(((0,0.5), (0,0.5)), 0.75 :: Float)]+ `shouldBe` [(Event Nothing (Arc 0 0.5) 0.75)] it "works with inset points" $ (queryArc (rev saw) (Arc 0.25 0.25))- `shouldBe` fmap toEvent [(((0.25,0.25), (0.25,0.25)), 0.75 :: Float)]+ `shouldBe` [(Event Nothing (Arc 0.25 0.25) 0.75)] describe "tri" $ do it "goes from 0 up to 1 and back every cycle" $ do
test/Sound/Tidal/PatternTest.hs view
@@ -25,53 +25,54 @@ let res = fmap (+1) (Arc 3 5) property $ ((Arc 4 6) :: Arc) === res + {- describe "Event" $ do it "(Bifunctor) first: Apply a function to the Arc elements: whole and part" $ do- let res = Event (Arc 1 2) (Arc 3 4) 5 :: Event Int+ let res = Event (Just $ Arc 1 2) (Arc 3 4) 5 :: Event Int f = (+1) property $ first f res ===- Event (Arc 2 3) (Arc 4 5) 5+ Event (Just $ Arc 2 3) (Arc 4 5) 5 it "(Bifunctor) second: Apply a function to the event element" $ do- let res = Event (Arc 1 2) (Arc 3 4) 5 :: Event Int+ let res = Event (Just $ Arc 1 2) (Arc 3 4) 5 :: Event Int f = (+1) property $ second f res ===- Event (Arc 1 2) (Arc 3 4) 6+ Event (Just $ Arc 1 2) (Arc 3 4) 6-} describe "whole" $ do it "returns the whole Arc in an Event" $ do- property $ Arc 1 2 === whole (Event (Arc 1 2) (Arc 3 4) 5 :: Event Int)+ property $ (Just $ Arc 1 2) === whole (Event (Just $ Arc 1 2) (Arc 3 4) 5 :: Event Int) describe "part" $ do it "returns the part Arc in an Event" $ do- property $ Arc 3 4 === part (Event (Arc 1 2) (Arc 3 4) 5 :: Event Int)+ property $ (Arc 3 4) === part (Event (Just $ Arc 1 2) (Arc 3 4) 5 :: Event Int) describe "value" $ do it "returns the event value in an Event" $ do- property $ 5 === value (Event (Arc 1 2 :: Arc) (Arc 3 4) ( 5 :: Int))+ property $ 5 === value (Event (Just $ Arc 1 2) (Arc 3 4) ( 5 :: Int)) describe "wholeStart" $ do it "retrieve the onset of an event: the start of the whole Arc" $ do - property $ 1 === wholeStart (Event (Arc 1 2) (Arc 3 4) (5 :: Int))+ property $ 1 === wholeStart (Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)) describe "eventHasOnset" $ do it "return True when the start values of the two arcs in an event are equal" $ do - let ev = (Event (Arc 1 2) (Arc 1 3) (4 :: Int)) + let ev = (Event (Just $ Arc 1 2) (Arc 1 3) (4 :: Int)) property $ True === eventHasOnset ev it "return False when the start values of the two arcs in an event are not equal" $ do - let ev = (Event (Arc 1 2) (Arc 3 4) (5 :: Int)) + let ev = (Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)) property $ False === eventHasOnset ev describe "pure" $ do it "fills a whole cycle" $ do- property $ queryArc (pure 0) (Arc 0 1) === [(Event (Arc 0 1) (Arc 0 1) (0 :: Int))]+ property $ queryArc (pure 0) (Arc 0 1) === [(Event (Just $ Arc 0 1) (Arc 0 1) (0 :: Int))] it "returns the part of an pure that you ask for, preserving the whole" $ do- property $ queryArc (pure 0) (Arc 0.25 0.75) === [(Event (Arc 0 1) (Arc 0.25 0.75) (0 :: Int))]+ property $ queryArc (pure 0) (Arc 0.25 0.75) === [(Event (Just $ Arc 0 1) (Arc 0.25 0.75) (0 :: Int))] it "gives correct fragments when you go over cycle boundaries" $ do property $ queryArc (pure 0) (Arc 0.25 1.25) ===- [ (Event (Arc 0 1) (Arc 0.25 1) (0 :: Int)),- (Event (Arc 1 2) (Arc 1 1.25) 0)+ [ (Event (Just $ Arc 0 1) (Arc 0.25 1) (0 :: Int)),+ (Event (Just $ Arc 1 2) (Arc 1 1.25) 0) ] it "works with zero-length queries" $ do it "0" $@@ -85,8 +86,8 @@ it "copes with cross-cycle queries" $ do (queryArc(_fastGap 2 $ fastCat [pure "a", pure "b"]) (Arc 0.5 1.5)) `shouldBe`- [(Event (Arc (1 % 1) (5 % 4)) (Arc (1 % 1) (5 % 4)) ("a" :: String)),- (Event (Arc (5 % 4) (3 % 2)) (Arc (5 % 4) (3 % 2)) "b")+ [(Event (Just $ Arc (1 % 1) (5 % 4)) (Arc (1 % 1) (5 % 4)) ("a" :: String)),+ (Event (Just $ Arc (5 % 4) (3 % 2)) (Arc (5 % 4) (3 % 2)) "b") ] it "does not return events outside of the query" $ do (queryArc(_fastGap 2 $ fastCat [pure "a", pure ("b" :: String)]) (Arc 0.5 0.9))@@ -191,9 +192,9 @@ b = fastCat [pure "c", pure "d", pure "e"] pp = fastCat [pure a, pure b] queryArc (unwrap pp) (Arc 0 1)- `shouldBe` [(Event (Arc (0 % 1) (1 % 2)) (Arc (0 % 1) (1 % 2)) ("a" :: String)),- (Event (Arc (1 % 2) (2 % 3)) (Arc (1 % 2) (2 % 3)) "d"),- (Event (Arc (2 % 3) (1 % 1)) (Arc (2 % 3) (1 % 1)) "e")+ `shouldBe` [(Event (Just $ Arc (0 % 1) (1 % 2)) (Arc (0 % 1) (1 % 2)) ("a" :: String)),+ (Event (Just $ Arc (1 % 2) (2 % 3)) (Arc (1 % 2) (2 % 3)) "d"),+ (Event (Just $ Arc (2 % 3) (1 % 1)) (Arc (2 % 3) (1 % 1)) "e") ] describe "squeezeJoin" $ do@@ -202,11 +203,11 @@ b = fastCat [pure "c", pure "d", pure "e"] pp = fastCat [pure a, pure b] queryArc (squeezeJoin pp) (Arc 0 1)- `shouldBe` [(Event (Arc (0 % 1) (1 % 4)) (Arc (0 % 1) (1 % 4)) ("a" :: String)),- (Event (Arc (1 % 4) (1 % 2)) (Arc (1 % 4) (1 % 2)) "b"),- (Event (Arc (1 % 2) (2 % 3)) (Arc (1 % 2) (2 % 3)) "c"),- (Event (Arc (2 % 3) (5 % 6)) (Arc (2 % 3) (5 % 6)) "d"),- (Event (Arc (5 % 6) (1 % 1)) (Arc (5 % 6) (1 % 1)) "e")+ `shouldBe` [(Event (Just $ Arc (0 % 1) (1 % 4)) (Arc (0 % 1) (1 % 4)) ("a" :: String)),+ (Event (Just $ Arc (1 % 4) (1 % 2)) (Arc (1 % 4) (1 % 2)) "b"),+ (Event (Just $ Arc (1 % 2) (2 % 3)) (Arc (1 % 2) (2 % 3)) "c"),+ (Event (Just $ Arc (2 % 3) (5 % 6)) (Arc (2 % 3) (5 % 6)) "d"),+ (Event (Just $ Arc (5 % 6) (1 % 1)) (Arc (5 % 6) (1 % 1)) "e") ] describe ">>=" $ do@@ -251,38 +252,38 @@ describe "controlI" $ do it "can retrieve values from state" $ (query (pure 3 + cF_ "hello") $ State (Arc 0 1) (Map.singleton "hello" (pure $ VF 0.5)))- `shouldBe` [(Event (Arc (0 % 1) (1 % 1)) (Arc (0 % 1) (1 % 1)) 3.5)]+ `shouldBe` [(Event (Just $ Arc (0 % 1) (1 % 1)) (Arc (0 % 1) (1 % 1)) 3.5)] describe "wholeStart" $ do it "retrieve first element of a tuple, inside first element of a tuple, inside the first of another" $ do - property $ 1 === wholeStart (Event (Arc 1 2) (Arc 3 4) (5 :: Int))+ property $ 1 === wholeStart (Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)) describe "wholeStop" $ do it "retrieve the end time from the first Arc in an Event" $ do- property $ 2 === wholeStop (Event (Arc 1 2) (Arc 3 4) (5 :: Int))+ property $ 2 === wholeStop (Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)) describe "eventPartStart" $ do it "retrieve the start time of the second Arc in an Event" $ do - property $ 3 === eventPartStart (Event (Arc 1 2) (Arc 3 4) (5 :: Int))+ property $ 3 === eventPartStart (Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)) describe "eventPartStop" $ do it "retrieve the end time of the second Arc in an Event" $ do - property $ 4 === eventPartStop (Event (Arc 1 2) (Arc 3 4) (5 :: Int))+ property $ 4 === eventPartStop (Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)) describe "eventPart" $ do it "retrieve the second Arc in an Event" $ do - property $ Arc 3 4 === eventPart (Event (Arc 1 2) (Arc 3 4) (5 :: Int))+ property $ Arc 3 4 === eventPart (Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)) describe "eventValue" $ do it "retrieve the second value from a tuple" $ do - property $ 5 === eventValue (Event (Arc 1 2) (Arc 3 4) (5 :: Int))+ property $ 5 === eventValue (Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)) describe "eventHasOnset" $ do it "return True when the start values of the two arcs in an event are equal" $ do - let ev = (Event (Arc 1 2) (Arc 1 3) (4 :: Int)) + let ev = (Event (Just $ Arc 1 2) (Arc 1 3) (4 :: Int)) property $ True === eventHasOnset ev it "return False when the start values of the two arcs in an event are not equal" $ do - let ev = (Event (Arc 1 2) (Arc 3 4) (5 :: Int)) + let ev = (Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)) property $ False === eventHasOnset ev describe "sam" $ do@@ -360,16 +361,16 @@ describe "onsetIn" $ do it "If the beginning of an Event is within a given Arc, same rules as 'isIn'" $ do - let res = onsetIn (Arc 2.0 2.8) (Event (Arc 2.2 2.7) (Arc 3.3 3.8) (5 :: Int))+ let res = onsetIn (Arc 2.0 2.8) (Event (Just $ Arc 2.2 2.7) (Arc 3.3 3.8) (5 :: Int)) property $ True === res it "Beginning of Event is equal to beggining of given Arc" $ do - let res = onsetIn (Arc 2.0 2.8) (Event (Arc 2.0 2.7) (Arc 3.3 3.8) (5 :: Int))+ let res = onsetIn (Arc 2.0 2.8) (Event (Just $ Arc 2.0 2.7) (Arc 3.3 3.8) (5 :: Int)) property $ True === res it "Beginning of an Event is less than the start of the Arc" $ do - let res = onsetIn (Arc 2.0 2.8) (Event (Arc 1.2 1.7) (Arc 3.3 3.8) (5 :: Int))+ let res = onsetIn (Arc 2.0 2.8) (Event (Just $ Arc 1.2 1.7) (Arc 3.3 3.8) (5 :: Int)) property $ False === res it "Start of Event is greater than the start of the given Arc" $ do - let res = onsetIn (Arc 2.0 2.8) (Event (Arc 3.1 3.5) (Arc 4.0 4.6) (5 :: Int))+ let res = onsetIn (Arc 2.0 2.8) (Event (Just $ Arc 3.1 3.5) (Arc 4.0 4.6) (5 :: Int)) property $ False === res describe "subArc" $ do@@ -403,16 +404,16 @@ describe "isAdjacent" $ do it "if the given Events are adjacent parts of the same whole" $ do - let res = isAdjacent (Event (Arc 1 2) (Arc 3 4) 5) (Event (Arc 1 2) (Arc 4 3) (5 :: Int))+ let res = isAdjacent (Event (Just $ Arc 1 2) (Arc 3 4) 5) (Event (Just $ Arc 1 2) (Arc 4 3) (5 :: Int)) property $ True === res it "if first Arc of of first Event is not equal to first Arc of second Event" $ do- let res = isAdjacent (Event (Arc 1 2) (Arc 3 4) 5) (Event (Arc 7 8) (Arc 4 3) (5 :: Int))+ let res = isAdjacent (Event (Just $ Arc 1 2) (Arc 3 4) 5) (Event (Just $ Arc 7 8) (Arc 4 3) (5 :: Int)) property $ False === res it "if the value of the first Event does not equal the value of the second Event" $ do - let res = isAdjacent (Event (Arc 1 2) (Arc 3 4) 5) (Event (Arc 1 2) (Arc 4 3) (6 :: Int))+ let res = isAdjacent (Event (Just $ Arc 1 2) (Arc 3 4) 5) (Event (Just $ Arc 1 2) (Arc 4 3) (6 :: Int)) property $ False === res it "second value of second Arc of first Event not equal to first value of second Arc in second Event..." $ do- let res = isAdjacent (Event (Arc 1 2) (Arc 3 4) 5) (Event (Arc 1 2) (Arc 3 4) (5 :: Int))+ let res = isAdjacent (Event (Just $ Arc 1 2) (Arc 3 4) 5) (Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)) property $ False === res describe "defragParts" $ do @@ -420,24 +421,24 @@ let res = defragParts ([] :: [Event Int]) property $ [] === res it "if list consists of only one Event return it as is" $ do - let res = defragParts [(Event (Arc 1 2) (Arc 3 4) (5 :: Int))]- property $ [Event (Arc 1 2) (Arc 3 4) (5 :: Int)] === res + let res = defragParts [(Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int))]+ property $ [Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)] === res it "if list contains adjacent Events return list with Parts combined" $ do - let res = defragParts [(Event (Arc 1 2) (Arc 3 4) (5 :: Int)), (Event (Arc 1 2) (Arc 4 3) (5 :: Int))]- property $ [(Event (Arc 1 2) (Arc 3 4) 5)] === res+ let res = defragParts [(Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)), (Event (Just $ Arc 1 2) (Arc 4 3) (5 :: Int))]+ property $ [(Event (Just $ Arc 1 2) (Arc 3 4) 5)] === res it "if list contains more than one Event none of which are adjacent, return List as is" $ do - let res = defragParts [(Event (Arc 1 2) (Arc 3 4) 5), (Event (Arc 7 8) (Arc 4 3) (5 :: Int))]- property $ [Event (Arc 1 2) (Arc 3 4) 5, Event (Arc 7 8) (Arc 4 3) (5 :: Int)] === res+ let res = defragParts [(Event (Just $ Arc 1 2) (Arc 3 4) 5), (Event (Just $ Arc 7 8) (Arc 4 3) (5 :: Int))]+ property $ [Event (Just $ Arc 1 2) (Arc 3 4) 5, Event (Just $ Arc 7 8) (Arc 4 3) (5 :: Int)] === res describe "compareDefrag" $ do it "compare list with Events with empty list of Events" $ do- let res = compareDefrag [Event (Arc 1 2) (Arc 3 4) (5 :: Int), Event (Arc 1 2) (Arc 4 3) (5 :: Int)] []+ let res = compareDefrag [Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int), Event (Just $ Arc 1 2) (Arc 4 3) (5 :: Int)] [] property $ False === res it "compare lists containing same Events but of different length" $ do - let res = compareDefrag [Event (Arc 1 2) (Arc 3 4) (5 :: Int), Event (Arc 1 2) (Arc 4 3) 5] [Event (Arc 1 2) (Arc 3 4) (5 :: Int)]+ let res = compareDefrag [Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int), Event (Just $ Arc 1 2) (Arc 4 3) 5] [Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)] property $ True === res it "compare lists of same length with same Events" $ do - let res = compareDefrag [Event (Arc 1 2) (Arc 3 4) (5 :: Int)] [Event (Arc 1 2) (Arc 3 4) (5 :: Int)]+ let res = compareDefrag [Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)] [Event (Just $ Arc 1 2) (Arc 3 4) (5 :: Int)] property $ True === res describe "sect" $ do @@ -549,8 +550,8 @@ -- pending "Sound.Tidal.Pattern.eventL" $ do -- it "succeeds if the first event 'whole' is shorter" $ do- -- property $ eventL (Event (Arc 0,0),(Arc 0 1)),"x") (((0 0) (Arc 0 1.1)) "x")+ -- property $ eventL (Event (Just $ Arc 0,0),(Arc 0 1)),"x") (((0 0) (Arc 0 1.1)) "x") -- it "fails if the events are the same length" $ do- -- property $ not $ eventL (Event (Arc 0,0),(Arc 0 1)),"x") (((0 0) (Arc 0 1)) "x")+ -- property $ not $ eventL (Event (Just $ Arc 0,0),(Arc 0 1)),"x") (((0 0) (Arc 0 1)) "x") -- it "fails if the second event is shorter" $ do- -- property $ not $ eventL (Event (Arc 0,0),(Arc 0 1)),"x") (((0 0) (Arc 0 0.5)) "x")+ -- property $ not $ eventL (Event (Just $ Arc 0,0),(Arc 0 1)),"x") (((0 0) (Arc 0 0.5)) "x")
test/Sound/Tidal/UITest.hs view
@@ -44,7 +44,7 @@ it "can hold a value over multiple cycles" $ do comparePD (Arc 0 8) (segment 0.5 saw)- (slow 2 "0.5" :: Pattern Double)+ (slow 2 "0" :: Pattern Double) {- -- not sure what this is supposed to do! it "holding values over multiple cycles works in combination" $ do@@ -81,49 +81,49 @@ describe "rand" $ do it "generates a (pseudo-)random number between zero & one" $ do it "at the start of a cycle" $- (queryArc rand (Arc 0 0)) `shouldBe` fmap toEvent [(((0, 0), (0, 0)), 0.5000844 :: Float)]+ (queryArc rand (Arc 0 0)) `shouldBe` [Event Nothing (Arc 0 0) (0.5000844 :: Float)] it "at 1/4 of a cycle" $- (queryArc rand (Arc 0.25 0.25)) `shouldBe` fmap toEvent- [(((0.25, 0.25), (0.25, 0.25)), 0.8587171 :: Float)]+ (queryArc rand (Arc 0.25 0.25)) `shouldBe` + [Event Nothing (Arc 0.25 0.25) (0.8587171 :: Float)] it "at 3/4 of a cycle" $- (queryArc rand (Arc 0.75 0.75)) `shouldBe` fmap toEvent- [(((0.75, 0.75), (0.75, 0.75)), 0.7277789 :: Float)]+ (queryArc rand (Arc 0.75 0.75)) `shouldBe` + [Event Nothing (Arc 0.75 0.75) (0.7277789 :: Float)] describe "range" $ do describe "scales a pattern to the supplied range" $ do describe "from 3 to 4" $ do it "at the start of a cycle" $- (queryArc (Sound.Tidal.UI.range 3 4 saw) (Arc 0 0)) `shouldBe` fmap toEvent- [(((0, 0), (0, 0)), 3 :: Float)]+ (queryArc (Sound.Tidal.UI.range 3 4 saw) (Arc 0 0)) `shouldBe` + [Event Nothing (Arc 0 0) (3 :: Float)] it "at 1/4 of a cycle" $- (queryArc (Sound.Tidal.UI.range 3 4 saw) (Arc 0.25 0.25)) `shouldBe` fmap toEvent- [(((0.25, 0.25), (0.25, 0.25)), 3.25 :: Float)]+ (queryArc (Sound.Tidal.UI.range 3 4 saw) (Arc 0.25 0.25)) `shouldBe`+ [Event Nothing (Arc 0.25 0.25) (3.25 :: Float)] it "at 3/4 of a cycle" $- (queryArc (Sound.Tidal.UI.range 3 4 saw) (Arc 0.75 0.75)) `shouldBe` fmap toEvent- [(((0.75, 0.75), (0.75, 0.75)), 3.75 :: Float)]+ (queryArc (Sound.Tidal.UI.range 3 4 saw) (Arc 0.75 0.75)) `shouldBe` + [Event Nothing (Arc 0.75 0.75) (3.75 :: Float)] describe "from -1 to 1" $ do it "at 1/2 of a cycle" $- (queryArc (Sound.Tidal.UI.range (-1) 1 saw) (Arc 0.5 0.5)) `shouldBe` fmap toEvent- [(((0.5, 0.5), (0.5, 0.5)), 0 :: Float)]+ (queryArc (Sound.Tidal.UI.range (-1) 1 saw) (Arc 0.5 0.5)) `shouldBe`+ [Event Nothing (Arc 0.5 0.5) (0 :: Float)] describe "from 4 to 2" $ do it "at the start of a cycle" $- (queryArc (Sound.Tidal.UI.range 4 2 saw) (Arc 0 0)) `shouldBe` fmap toEvent- [(((0, 0), (0, 0)), 4 :: Float)]+ (queryArc (Sound.Tidal.UI.range 4 2 saw) (Arc 0 0)) `shouldBe` + [Event Nothing (Arc 0 0) (4 :: Float)] it "at 1/4 of a cycle" $- (queryArc (Sound.Tidal.UI.range 4 2 saw) (Arc 0.25 0.25)) `shouldBe` fmap toEvent- [(((0.25, 0.25), (0.25, 0.25)), 3.5 :: Float)]+ (queryArc (Sound.Tidal.UI.range 4 2 saw) (Arc 0.25 0.25)) `shouldBe` + [Event Nothing (Arc 0.25 0.25) (3.5 :: Float)] it "at 3/4 of a cycle" $- (queryArc (Sound.Tidal.UI.range 4 2 saw) (Arc 0.75 0.75)) `shouldBe` fmap toEvent- [(((0.75, 0.75), (0.75, 0.75)), 2.5 :: Float)]+ (queryArc (Sound.Tidal.UI.range 4 2 saw) (Arc 0.75 0.75)) `shouldBe` + [Event Nothing (Arc 0.75 0.75) (2.5 :: Float)] describe "from 10 to 10" $ do it "at 1/2 of a cycle" $- (queryArc (Sound.Tidal.UI.range 10 10 saw) (Arc 0.5 0.5)) `shouldBe` fmap toEvent- [(((0.5, 0.5), (0.5, 0.5)), 10 :: Float)]+ (queryArc (Sound.Tidal.UI.range 10 10 saw) (Arc 0.5 0.5)) `shouldBe` + [Event Nothing (Arc 0.5 0.5) (10 :: Float)] - describe "rot" $ do+ describe "rot" $ do it "rotates values in a pattern irrespective of structure" $ property $ comparePD (Arc 0 2) (rot 1 "a ~ b c" :: Pattern String)
tidal.cabal view
@@ -1,5 +1,5 @@ name: tidal-version: 1.3.0+version: 1.4.0 synopsis: Pattern language for improvised music -- description: homepage: http://tidalcycles.org/@@ -61,6 +61,7 @@ , bytestring < 0.11 , clock < 0.9 , deepseq >= 1.1.0.0+ , primitive < 0.8 if !impl(ghc >= 8.4.1) build-depends: semigroups >= 0.18 && < 0.20