diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # TidalCycles log of changes +## 1.0.14 - IICON + +* 'chew' - like bite, but speeds playback rate up and down +* variable probability for ? in mini notation +* chooseBy takes modulo of index to avoid out of bounds errors +* 'rate' control param +* Fix dependencies for parsec/colour + ## 1.0.13 - 🐝⌛️🦋 #2 * Simplify espgrid support - @yaxu 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 @@ -369,81 +369,68 @@ 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 + where q st = query ((offset st) ~> pat) st + offset st = fromMaybe (pure 0) $ do pat <- Map.lookup ctrl (controls st) + return $ ((fromMaybe 0 . getR) <$> pat) 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 -_cX f ds s = Pattern Analog $ - \(State a m) -> maybe (map (Event a a) ds) (f a) $ Map.lookup s m +_getP_ :: (Value -> Maybe a) -> Pattern Value -> Pattern a +_getP_ f pat = filterJust $ f <$> pat -_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) +_getP :: a -> (Value -> Maybe a) -> Pattern Value -> Pattern a +_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_ :: (Value -> Maybe a) -> String -> Pattern 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 = _cF [d] -cF0 :: String -> Pattern Double -cF0 = _cF [0] +cF d = _cX d getF cF_ :: String -> Pattern Double -cF_ = _cF [] +cF_ = _cX_ getF +cF0 :: String -> Pattern Double +cF0 = _cX 0 getF +cI :: Int -> String -> Pattern Int +cI d = _cX d getI +cI_ :: String -> Pattern Int +cI_ = _cX_ getI +cI0 :: String -> Pattern Int +cI0 = _cX 0 getI + 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) +cB d = _cX d getB +cB_ :: String -> Pattern Bool +cB_ = _cX_ getB +cB0 :: String -> Pattern Bool +cB0 = _cX False getB +cR :: Rational -> String -> Pattern Rational +cR d = _cX d getR +cR_ :: String -> Pattern Rational +cR_ = _cX_ getR +cR0 :: String -> Pattern Rational +cR0 = _cX 0 getR + cT :: Time -> String -> Pattern Time -cT d = (toRational <$>) . cF (fromRational d) +cT = cR cT0 :: String -> Pattern Time -cT0 = (toRational <$>) . cF0 +cT0 = cR0 cT_ :: String -> Pattern Time -cT_ = (toRational <$>) . cF_ - - -cR :: Time -> String -> Pattern Rational -cR = cT -cR0 :: String -> Pattern Time -cR0 = cT0 -cR_ :: String -> Pattern Time -cR_ = cT_ +cT_ = cR_ -_cS :: [String] -> String -> Pattern String -_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] +cS d = _cX d getS cS_ :: String -> Pattern String -cS_ = _cS [] - -_cP :: (Enumerable a, Parseable a) => [Pattern a] -> String -> Pattern a -_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)] +cS_ = _cX_ getS +cS0 :: String -> Pattern String +cS0 = _cX "" getS -cP :: (Enumerable a, Parseable a) => Pattern a -> String -> Pattern a -cP d = _cP [d] -cP_ :: (Enumerable a, Parseable a) => String -> Pattern a -cP_ = _cP [] +cP :: String -> Pattern String +cP s = innerJoin $ parseBP_E <$> (_cX_ getS s) -- Default controller inputs (for MIDI) in0 :: Pattern Double diff --git a/src/Sound/Tidal/Params.hs b/src/Sound/Tidal/Params.hs --- a/src/Sound/Tidal/Params.hs +++ b/src/Sound/Tidal/Params.hs @@ -298,6 +298,9 @@ pitch3 = pF "pitch3" portamento :: Pattern Double -> ControlPattern portamento = pF "portamento" +-- | used in SuperDirt softsynths as a control rate or "speed" +rate :: Pattern Double -> ControlPattern +rate = pF "rate" -- | a pattern of numbers to specify the release time (in seconds) of an envelope applied to each sample. Only takes effect if `attack` is also specified. release :: Pattern Double -> ControlPattern release = pF "release" diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs --- a/src/Sound/Tidal/ParseBP.hs +++ b/src/Sound/Tidal/ParseBP.hs @@ -250,7 +250,10 @@ <|> do es <- many1 (symbol "_") return [TPat_Elongate (length es)] let ps' = TPat_Cat $ map elongate $ splitFeet $ concat ps - return (length ps, ps') + extraElongate (TPat_Elongate n) = n-1 + extraElongate _ = 0 + sumElongates x = sum (map extraElongate x) + return (length ps + sumElongates (concat ps), ps') elongate :: [TPat a] -> TPat a elongate xs | any isElongate xs = TPat_TimeCat xs @@ -413,8 +416,9 @@ pRand :: TPat a -> Parser (TPat a) pRand thing = do char '?' + r <- float <|> return 0.5 spaces - return $ TPat_DegradeBy 0.5 thing + return $ TPat_DegradeBy r thing <|> return thing pE :: TPat a -> Parser (TPat 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 @@ -207,7 +207,7 @@ -- | an Arc and some named control values data State = State {arc :: Arc, - controls :: ControlMap + controls :: StateMap } -- | A function that represents events taking place over time @@ -225,10 +225,27 @@ | VF { fvalue :: Double } | VR { rvalue :: Rational } | VI { ivalue :: Int } + | VB { bvalue :: Bool } deriving (Typeable,Data) +class Valuable a where + toValue :: a -> Value + +instance Valuable String where + toValue = VS +instance Valuable Double where + toValue a = VF a +instance Valuable Rational where + toValue a = VR a +instance Valuable Int where + toValue a = VI a +instance Valuable Bool where + toValue a = VB a + instance Eq Value where (VS x) == (VS y) = x == y + (VB x) == (VB y) = x == y + (VF x) == (VF y) = x == y (VI x) == (VI y) = x == y (VR x) == (VR y) = x == y @@ -241,16 +258,19 @@ (VI x) == (VR y) = (toRational x) == y (VR y) == (VI x) = (toRational x) == y - (VS _) == _ = False - _ == (VS _) = False + + _ == _ = False instance Ord Value where compare (VS x) (VS y) = compare x y + compare (VB x) (VB 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 (VB _) _ = LT + compare _ (VB _) = GT compare (VF x) (VI y) = compare x (fromIntegral y) compare (VI x) (VF y) = compare (fromIntegral x) y @@ -260,6 +280,7 @@ compare (VF x) (VR y) = compare x (fromRational y) compare (VR x) (VF y) = compare (fromRational x) y +type StateMap = Map.Map String (Pattern Value) type ControlMap = Map.Map String Value type ControlPattern = Pattern ControlMap @@ -548,6 +569,7 @@ show (VI i) = show i show (VF f) = show f ++ "f" show (VR r) = show r ++ "r" + show (VB b) = show b instance {-# OVERLAPPING #-} Show ControlMap where show m = intercalate ", " $ map (\(name, v) -> name ++ ": " ++ show v) $ Map.toList m @@ -679,18 +701,28 @@ getI :: Value -> Maybe Int getI (VI i) = Just i +getI (VR x) = Just $ floor x +getI (VF x) = Just $ floor x getI _ = Nothing getF :: Value -> Maybe Double getF (VF f) = Just f +getF (VR x) = Just $ fromRational x +getF (VI x) = Just $ fromIntegral x getF _ = Nothing getS :: Value -> Maybe String getS (VS s) = Just s getS _ = Nothing +getB :: Value -> Maybe Bool +getB (VB b) = Just b +getB _ = Nothing + getR :: Value -> Maybe Rational getR (VR r) = Just r +getR (VF x) = Just $ toRational x +getR (VI x) = Just $ toRational x getR _ = Nothing compressArc :: Arc -> Pattern a -> Pattern a diff --git a/src/Sound/Tidal/Stream.hs b/src/Sound/Tidal/Stream.hs --- a/src/Sound/Tidal/Stream.hs +++ b/src/Sound/Tidal/Stream.hs @@ -28,7 +28,7 @@ deriving (Eq, Show) data Stream = Stream {sConfig :: Config, - sInput :: MVar ControlMap, + sInput :: MVar StateMap, sOutput :: MVar ControlPattern, sListenTid :: Maybe ThreadId, sPMapMV :: MVar PlayMap, @@ -110,15 +110,15 @@ oTimestamp = MessageStamp } -startStream :: Config -> MVar ControlMap -> [OSCTarget] -> IO (MVar ControlPattern, MVar T.Tempo, [Cx]) -startStream config cMapMV targets +startStream :: Config -> MVar StateMap -> [OSCTarget] -> IO (MVar ControlPattern, MVar T.Tempo, [Cx]) +startStream config sMapMV targets = do cxs <- mapM (\target -> do u <- O.openUDP (oAddress target) (oPort target) return $ Cx {cxUDP = u, cxTarget = target } ) targets pMV <- newMVar empty - (tempoMV, _) <- T.clocked config $ onTick config cMapMV pMV cxs + (tempoMV, _) <- T.clocked config $ onTick config sMapMV pMV cxs return $ (pMV, tempoMV, cxs) @@ -135,6 +135,9 @@ toDatum (VF x) = O.float x toDatum (VI x) = O.int32 x toDatum (VS x) = O.string x +toDatum (VR x) = O.float $ ((fromRational x) :: Double) +toDatum (VB True) = O.int32 (1 :: Int) +toDatum (VB False) = O.int32 (0 :: Int) toData :: OSCTarget -> Event ControlMap -> Maybe [O.Datum] toData target e @@ -171,14 +174,14 @@ return () doCps _ _ = return () -onTick :: Config -> MVar ControlMap -> MVar ControlPattern -> [Cx] -> MVar T.Tempo -> T.State -> IO () -onTick config cMapMV pMV cxs tempoMV st = +onTick :: Config -> MVar StateMap -> MVar ControlPattern -> [Cx] -> MVar T.Tempo -> T.State -> IO () +onTick config sMapMV pMV cxs tempoMV st = do p <- readMVar pMV - cMap <- readMVar cMapMV + sMap <- readMVar sMapMV tempo <- readMVar tempoMV now <- O.time - let cMap' = Map.insert "_cps" (VF $ T.cps tempo) cMap - es = filter eventHasOnset $ query p (State {arc = T.nowArc st, controls = cMap'}) + let sMap' = Map.insert "_cps" (pure $ VF $ T.cps tempo) sMap + es = filter eventHasOnset $ query p (State {arc = T.nowArc st, controls = sMap'}) on e = (sched tempo $ start $ whole e) + eventNudge e eventNudge e = fromJust $ getF $ fromMaybe (VF 0) $ Map.lookup "nudge" $ value e messages target = catMaybes $ map (\e -> do m <- toMessage (on e + latency target) target tempo e @@ -237,9 +240,9 @@ input <- takeMVar $ sInput s -- put change time in control input now <- O.time - let cycle = T.timeToCycles tempo now + let cyc = T.timeToCycles tempo now putMVar (sInput s) $ - Map.insert ("_t_all") (VR cycle) $ Map.insert ("_t_" ++ show k) (VR cycle) input + Map.insert ("_t_all") (pure $ VR cyc) $ Map.insert ("_t_" ++ show k) (pure $ VR cyc) input -- update the pattern itself pMap <- seq x $ takeMVar $ sPMapMV s let playState = updatePS $ Map.lookup (show k) pMap @@ -269,7 +272,7 @@ streamOnce :: Stream -> ControlPattern -> IO () streamOnce st p - = do cMap <- readMVar (sInput st) + = do sMap <- readMVar (sInput st) tempo <- readMVar (sTempoMV st) now <- O.time let fakeTempo = T.Tempo {T.cps = T.cps tempo, @@ -278,9 +281,9 @@ T.paused = False, T.nudged = 0 } - cMap' = Map.insert "_cps" (VF $ T.cps tempo) cMap + sMap' = Map.insert "_cps" (pure $ VF $ T.cps tempo) sMap es = filter eventHasOnset $ query p (State {arc = (Arc 0 1), - controls = cMap' + controls = sMap' } ) at e = sched fakeTempo $ start $ whole e @@ -328,6 +331,27 @@ streamAll s f = do _ <- swapMVar (sGlobalFMV s) f calcOutput s +streamSet :: Valuable a => Stream -> String -> Pattern a -> IO () +streamSet s k pat = do sMap <- takeMVar $ sInput s + let pat' = toValue <$> pat + sMap' = Map.insert k pat' sMap + putMVar (sInput s) $ sMap' + +streamSetI :: Stream -> String -> Pattern Int -> IO () +streamSetI = streamSet + +streamSetF :: Stream -> String -> Pattern Double -> IO () +streamSetF = streamSet + +streamSetS :: Stream -> String -> Pattern String -> IO () +streamSetS = streamSet + +streamSetB :: Stream -> String -> Pattern Bool -> IO () +streamSetB = streamSet + +streamSetR :: Stream -> String -> Pattern Rational -> IO () +streamSetR = streamSet + calcOutput :: Stream -> IO () calcOutput s = do pMap <- readMVar $ sPMapMV s globalF <- (readMVar $ sGlobalFMV s) @@ -344,13 +368,13 @@ startMulti :: [OSCTarget] -> Config -> IO Stream startMulti targets config = - do cMapMV <- newMVar (Map.empty :: ControlMap) - listenTid <- ctrlListen cMapMV config - (pMV, tempoMV, cxs) <- startStream config cMapMV targets + do sMapMV <- newMVar (Map.empty :: StateMap) + listenTid <- ctrlListen sMapMV config + (pMV, tempoMV, cxs) <- startStream config sMapMV targets pMapMV <- newMVar Map.empty globalFMV <- newMVar id return $ Stream {sConfig = config, - sInput = cMapMV, + sInput = sMapMV, sListenTid = listenTid, sOutput = pMV, sPMapMV = pMapMV, @@ -359,8 +383,8 @@ sCxs = cxs } -ctrlListen :: MVar ControlMap -> Config -> IO (Maybe ThreadId) -ctrlListen cMapMV c +ctrlListen :: MVar StateMap -> Config -> IO (Maybe ThreadId) +ctrlListen sMapMV c | cCtrlListen c = do putStrLn $ "Listening for controls on " ++ cCtrlAddr c ++ ":" ++ show (cCtrlPort c) catchAny run (\_ -> do putStrLn $ "Control listen failed. Perhaps there's already another tidal instance listening on that port?" return Nothing @@ -383,27 +407,12 @@ = add (O.ascii_to_string k) (VI $ fromIntegral v) act m = putStrLn $ "Unhandled OSC: " ++ show m add :: String -> Value -> IO () - add k v = do cMap <- takeMVar cMapMV - putMVar cMapMV $ Map.insert k v cMap + add k v = do sMap <- takeMVar sMapMV + putMVar sMapMV $ Map.insert k (pure v) sMap return () catchAny :: IO a -> (E.SomeException -> IO a) -> IO a catchAny = E.catch -{- -listenCMap :: MVar ControlMap -> IO () -listenCMap cMapMV = do sock <- O.udpServer "127.0.0.1" (6011) - _ <- forkIO $ loop sock - return () - where loop sock = - do ms <- O.recvMessages sock - mapM_ readMessage ms - loop sock - readMessage (O.Message _ (O.ASCII_String k:v@(O.Float _):[])) = add (O.ascii_to_string k) (VF $ fromJust $ O.datum_floating v) - readMessage (O.Message _ (O.ASCII_String k:O.ASCII_String v:[])) = add (O.ascii_to_string k) (VS $ O.ascii_to_string v) - readMessage (O.Message _ (O.ASCII_String k:O.Int32 v:[])) = add (O.ascii_to_string k) (VI $ fromIntegral v) - readMessage _ = return () - add :: String -> Value -> IO () - add k v = do cMap <- takeMVar cMapMV - putMVar cMapMV $ Map.insert k v cMap - return () --} + + + 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 @@ -156,7 +156,7 @@ chooseBy :: Pattern Double -> [a] -> Pattern a chooseBy _ [] = silence -chooseBy f xs = (xs !!) . floor <$> range 0 (fromIntegral $ length xs) f +chooseBy f xs = (xs !!!) . floor <$> range 0 (fromIntegral $ length xs) f {- | Like @choose@, but works on an a list of tuples of values and weights @@ -1293,17 +1293,8 @@ -- | @arpeggiate@ finds events that share the same timespan, and spreads -- them out during that timespan, so for example @arpeggiate "[bd,sn]"@ -- gets turned into @"bd sn"@. Useful for creating arpeggios/broken chords. -arpeggiate :: Pattern a -> Pattern a -arpeggiate p = withEvents munge p - where munge es = concatMap spreadOut (groupBy (\a b -> whole a == whole b) es) - spreadOut xs = mapMaybe (\(n, x) -> shiftIt n (length xs) x) $ enumerate xs - shiftIt n d (Event (Arc s e) a' v) = - do - a'' <- subArc (Arc newS newE) a' - return (Event (Arc newS newE) a'' v) - where newS = s + (dur * fromIntegral n) - newE = newS + dur - dur = (e - s) / fromIntegral d +arpeggiate :: Pattern a -> Pattern a +arpeggiate = arpWith id -- | Shorthand alias for arpeggiate arpg :: Pattern a -> Pattern a @@ -1311,7 +1302,7 @@ arpWith :: ([EventF (ArcF Time) a] -> [EventF (ArcF Time) b]) -> Pattern a -> Pattern b arpWith f p = withEvents munge p - where munge es = concatMap (spreadOut . f) (groupBy (\a b -> whole a == whole b) es) + 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) = do @@ -1785,3 +1776,21 @@ squeeze :: Pattern Int -> [Pattern a] -> Pattern a squeeze _ [] = silence squeeze ipat pats = squeezeJoin $ (pats !!!) <$> ipat + + +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) = + do w' <- subArc oWhole iWhole + p' <- subArc oPart iPart + return (Event w' p' v) + +chew :: Int -> Pattern Int -> ControlPattern -> ControlPattern +chew n ipat pat = (squeezeJoinUp $ zoompat <$> ipat) |/ P.speed (pure $ fromIntegral n) + where zoompat i = zoom (i'/(fromIntegral n), (i'+1)/(fromIntegral n)) (pat) + where i' = fromIntegral $ i `mod` n 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.0.13" +tidal_version = "1.0.14" diff --git a/test/Sound/Tidal/ParseTest.hs b/test/Sound/Tidal/ParseTest.hs --- a/test/Sound/Tidal/ParseTest.hs +++ b/test/Sound/Tidal/ParseTest.hs @@ -9,6 +9,7 @@ import Sound.Tidal.Core import Sound.Tidal.Pattern +import Sound.Tidal.UI (_degradeBy) run :: Microspec () run = @@ -34,6 +35,34 @@ compareP (Arc 0 2) ("a*8" :: Pattern String) (fast 8 "a") + it "can elongate with _" $ do + compareP (Arc 0 2) + ("a _ _ b _" :: Pattern String) + (timeCat [(3,"a"), (2,"b")]) + it "can replicate with !" $ do + compareP (Arc 0 2) + ("a! b" :: Pattern String) + (fastCat ["a", "a", "b"]) + it "can replicate with ! and number" $ do + compareP (Arc 0 2) + ("a!3 b" :: Pattern String) + (fastCat ["a", "a", "a", "b"]) + it "can degrade with ?" $ do + compareP (Arc 0 1) + ("a?" :: Pattern String) + (degradeByDefault "a") + it "can degrade with ? and number" $ do + compareP (Arc 0 1) + ("a?0.2" :: Pattern String) + (_degradeBy 0.2 "a") + it "can degrade with ? for double patterns" $ do + compareP (Arc 0 1) + ("0.4 0.5? 0.6" :: Pattern Double) + (fastcat[0.4, degradeByDefault 0.5, 0.6]) + it "can stretch with @" $ do + comparePD (Arc 0 1) + ("a@2 b" :: Pattern String) + (timeCat [(2, "a"),(1,"b")]) it "can do polymeter with {}" $ do compareP (Arc 0 2) ("{a b, c d e}" :: Pattern String) @@ -66,3 +95,4 @@ compareP (Arc 0 2) ("cp(5,c)" :: Pattern String) (silence) + where degradeByDefault = _degradeBy 0.5 diff --git a/test/Sound/Tidal/PatternTest.hs b/test/Sound/Tidal/PatternTest.hs --- a/test/Sound/Tidal/PatternTest.hs +++ b/test/Sound/Tidal/PatternTest.hs @@ -248,7 +248,7 @@ describe "controlI" $ do it "can retrieve values from state" $ - (query (pure 3 + cF_ "hello") $ State (Arc 0 1) (Map.singleton "hello" (VF 0.5))) + (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)] describe "wholeStart" $ do @@ -480,17 +480,20 @@ it "get Just value when Int value is supplied" $ do let res = getI (VI 3) property $ (Just 3) === res - it "get Nothing if Int value is not supplied" $ do - let res = getI (VF 3) + it "get floored value when float value is supplied" $ do + let res = getI (VF 3.5) + property $ (Just 3) === res + it "get Nothing if String value is supplied" $ do + let res = getI (VS "3") property $ Nothing === res - describe "getf" $ do + describe "getF" $ do it "get Just value when Float value is supplied" $ do let res = getF (VF 3) property $ (Just 3.0) === res - it "get Nothing if Int value is not supplied" $ do + it "get converted value if Int value is supplied" $ do let res = getF (VI 3) - property $ Nothing === res + property $ (Just 3.0) === res describe "getS" $ do it "get Just value when String value is supplied" $ do 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 @@ -119,6 +119,7 @@ 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)] + describe "rot" $ do it "rotates values in a pattern irrespective of structure" $ property $ comparePD (Arc 0 2) @@ -249,3 +250,27 @@ compareP (Arc 0 4) (bite 4 "0 2*2" (Sound.Tidal.Core.run 8)) ("[0 1] [4 5]*2" :: Pattern Int) + + describe "chooseBy" $ do + it "chooses from elements based on closest scaled double value" $ do + compareP (Arc 0 4) + (("0"::Pattern Int) |+ chooseBy ((/ 4)$(sig fromRational)) [0,1,2,3]) + ("<0 1 2 3>"::Pattern Int) + it "never gets an index out of bounds" $ do + compareP (Arc 0 4) + (("0"::Pattern Int) |+ chooseBy (sig fromRational) [0,1,2,3]) + ("<0>"::Pattern Int) + + describe "arpeggiate" $ do + it "can arpeggiate" $ do + compareP (Arc 0 1) + (arpeggiate ("[bd, sn] [hh:1, cp]" :: Pattern String)) + ("bd sn hh:1 cp" :: Pattern String) + it "can arpeggiate" $ do + compareP (Arc 0 4) + (arpeggiate $ "[0,0] [0,0]") + ("0 0 0 0" :: Pattern Int) + it "can arpeggiate a 'sped up' pattern" $ do + compareP (Arc 0 4) + (arpeggiate $ "[0,0]*2") + ("0 0 0 0" :: Pattern Int) diff --git a/tidal.cabal b/tidal.cabal --- a/tidal.cabal +++ b/tidal.cabal @@ -1,5 +1,5 @@ name: tidal -version: 1.0.13 +version: 1.0.14 synopsis: Pattern language for improvised music -- description: homepage: http://tidalcycles.org/ @@ -54,18 +54,18 @@ , colour < 2.4 , hosc < 0.18 , text < 1.3 - , parsec < 3.2 - , network < 3.1 + , parsec >= 3.1.12 && < 3.2 + , network < 3.2 , mwc-random < 0.15 , vector < 0.13 , bifunctors < 5.6 - , transformers < 0.5.7 + , transformers >= 0.5 && < 0.5.7 , template-haskell >= 2.10.0.0 && < 2.15 , bytestring < 0.11 - , clock < 0.8 + , clock < 0.9 if !impl(ghc >= 8.4.1) - build-depends: semigroups == 0.18.* + build-depends: semigroups >= 0.18 && < 0.20 test-suite tests type: exitcode-stdio-1.0