tidal 1.7.2 → 1.7.3
raw patch · 13 files changed
+414/−229 lines, 13 filesdep −vector
Dependencies removed: vector
Files
- BootTidal.hs +2/−1
- CHANGELOG.md +10/−0
- src/Sound/Tidal/Params.hs +54/−87
- src/Sound/Tidal/ParseBP.hs +15/−12
- src/Sound/Tidal/Pattern.hs +1/−1
- src/Sound/Tidal/Stream.hs +28/−12
- src/Sound/Tidal/Version.hs +1/−1
- test/Sound/Tidal/CoreTest.hs +253/−88
- test/Sound/Tidal/ExceptionsTest.hs +1/−1
- test/Sound/Tidal/ParseTest.hs +4/−0
- test/Sound/Tidal/StreamTest.hs +21/−1
- test/Sound/Tidal/UITest.hs +23/−23
- tidal.cabal +1/−2
BootTidal.hs view
@@ -66,7 +66,8 @@ :} :{-let setI = streamSetI tidal+let getState = streamGet tidal+ setI = streamSetI tidal setF = streamSetF tidal setS = streamSetS tidal setR = streamSetR tidal
CHANGELOG.md view
@@ -1,5 +1,15 @@ # TidalCycles log of changes +## 1.7.3 - Symonds Yat+ * Signed ratio shorthands now supported @ndr_brt+ * OSC API - mute/unmute stream @mindofmatthew+ * improve performance of playFor/seqP @yaxu+ * Expand tests with autodiscovered laws @RSWilli+ * Add `getState` to BootTidal @mindofmatthew+ * add fadeTime / fadeInTime / fadeOutTime params for grain envelopes @yaxu+ * Fix for nrpnn and nrpnv params @yaxu+ * Disable busses for MIDI parameters @mindofmatthew+ ## 1.7.2 - IKLECTIK c * tidal-parse additions and improved errors, haskellish dependency fix @dktr0 * spring cleaning and delinting, recreated Time.hs, renamed ControlMap toValueMAp @yaxu
src/Sound/Tidal/Params.hs view
@@ -105,6 +105,12 @@ nrpn :: Pattern String -> ControlPattern nrpn = grp [mI "nrpn", mI "val"] +nrpnn :: Pattern Int -> ControlPattern+nrpnn = pI "nrpn"++nrpnv :: Pattern Int -> ControlPattern+nrpnv = pI "val"+ grain' :: Pattern String -> ControlPattern grain' = grp [mF "begin", mF "end"] @@ -216,9 +222,7 @@ arrayTake :: String -> [Double] -> ControlPattern arrayTake name xs = pStateListF "array" name xs arraybus :: Pattern Int -> Pattern [Word8] -> ControlPattern-arraybus busid pat = (pX "array" pat) # (pI "^array" busid)-arrayrecv :: Pattern Int -> ControlPattern-arrayrecv busid = pI "^array" busid+arraybus _ _ = error $ "Control parameter 'array' can't be sent to a bus." -- | a pattern of numbers to specify the attack time (in seconds) of an envelope applied to each sample. attack :: Pattern Double -> ControlPattern@@ -546,9 +550,7 @@ ccnCountTo name ipat = innerJoin $ (\i -> pStateF "ccn" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat ccnbus :: Pattern Int -> Pattern Double -> ControlPattern-ccnbus busid pat = (pF "ccn" pat) # (pI "^ccn" busid)-ccnrecv :: Pattern Int -> ControlPattern-ccnrecv busid = pI "^ccn" busid+ccnbus _ _ = error $ "Control parameter 'ccn' can't be sent to a bus." -- | ccv :: Pattern Double -> ControlPattern@@ -561,9 +563,7 @@ ccvCountTo name ipat = innerJoin $ (\i -> pStateF "ccv" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat ccvbus :: Pattern Int -> Pattern Double -> ControlPattern-ccvbus busid pat = (pF "ccv" pat) # (pI "^ccv" busid)-ccvrecv :: Pattern Int -> ControlPattern-ccvrecv busid = pI "^ccv" busid+ccvbus _ _ = error $ "Control parameter 'ccv' can't be sent to a bus." -- | choose the channel the pattern is sent to in superdirt channel :: Pattern Int -> ControlPattern@@ -634,9 +634,7 @@ controlCountTo name ipat = innerJoin $ (\i -> pStateF "control" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat controlbus :: Pattern Int -> Pattern Double -> ControlPattern-controlbus busid pat = (pF "control" pat) # (pI "^control" busid)-controlrecv :: Pattern Int -> ControlPattern-controlrecv busid = pI "^control" busid+controlbus _ _ = error $ "Control parameter 'control' can't be sent to a bus." -- | cps :: Pattern Double -> ControlPattern@@ -679,9 +677,7 @@ ctlNumCountTo name ipat = innerJoin $ (\i -> pStateF "ctlNum" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat ctlNumbus :: Pattern Int -> Pattern Double -> ControlPattern-ctlNumbus busid pat = (pF "ctlNum" pat) # (pI "^ctlNum" busid)-ctlNumrecv :: Pattern Int -> ControlPattern-ctlNumrecv busid = pI "^ctlNum" busid+ctlNumbus _ _ = error $ "Control parameter 'ctlNum' can't be sent to a bus." -- | ctranspose :: Pattern Double -> ControlPattern@@ -936,6 +932,32 @@ expressionrecv :: Pattern Int -> ControlPattern expressionrecv busid = pI "^expression" busid +-- | As with fadeTime, but controls the fade in time of the grain envelope. Not used if the grain begins at position 0 in the sample.+fadeInTime :: Pattern Double -> ControlPattern+fadeInTime = pF "fadeInTime"+fadeInTimeTake :: String -> [Double] -> ControlPattern+fadeInTimeTake name xs = pStateListF "fadeInTime" name xs+fadeInTimeCount :: String -> ControlPattern+fadeInTimeCount name = pStateF "fadeInTime" name (maybe 0 (+1))+fadeInTimeCountTo :: String -> Pattern Double -> Pattern ValueMap+fadeInTimeCountTo name ipat = innerJoin $ (\i -> pStateF "fadeInTime" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat++fadeInTimebus :: Pattern Int -> Pattern Double -> ControlPattern+fadeInTimebus _ _ = error $ "Control parameter 'fadeInTime' can't be sent to a bus."++-- | Used when using begin/end or chop/striate and friends, to change the fade out time of the 'grain' envelope.+fadeTime :: Pattern Double -> ControlPattern+fadeTime = pF "fadeTime"+fadeTimeTake :: String -> [Double] -> ControlPattern+fadeTimeTake name xs = pStateListF "fadeTime" name xs+fadeTimeCount :: String -> ControlPattern+fadeTimeCount name = pStateF "fadeTime" name (maybe 0 (+1))+fadeTimeCountTo :: String -> Pattern Double -> Pattern ValueMap+fadeTimeCountTo name ipat = innerJoin $ (\i -> pStateF "fadeTime" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat++fadeTimebus :: Pattern Int -> Pattern Double -> ControlPattern+fadeTimebus _ _ = error $ "Control parameter 'fadeTime' can't be sent to a bus."+ -- | frameRate :: Pattern Double -> ControlPattern frameRate = pF "frameRate"@@ -947,9 +969,7 @@ frameRateCountTo name ipat = innerJoin $ (\i -> pStateF "frameRate" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat frameRatebus :: Pattern Int -> Pattern Double -> ControlPattern-frameRatebus busid pat = (pF "frameRate" pat) # (pI "^frameRate" busid)-frameRaterecv :: Pattern Int -> ControlPattern-frameRaterecv busid = pI "^frameRate" busid+frameRatebus _ _ = error $ "Control parameter 'frameRate' can't be sent to a bus." -- | frames :: Pattern Double -> ControlPattern@@ -962,9 +982,7 @@ framesCountTo name ipat = innerJoin $ (\i -> pStateF "frames" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat framesbus :: Pattern Int -> Pattern Double -> ControlPattern-framesbus busid pat = (pF "frames" pat) # (pI "^frames" busid)-framesrecv :: Pattern Int -> ControlPattern-framesrecv busid = pI "^frames" busid+framesbus _ _ = error $ "Control parameter 'frames' can't be sent to a bus." -- | Spectral freeze freeze :: Pattern Double -> ControlPattern@@ -1170,9 +1188,7 @@ hoursCountTo name ipat = innerJoin $ (\i -> pStateF "hours" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat hoursbus :: Pattern Int -> Pattern Double -> ControlPattern-hoursbus busid pat = (pF "hours" pat) # (pI "^hours" busid)-hoursrecv :: Pattern Int -> ControlPattern-hoursrecv busid = pI "^hours" busid+hoursbus _ _ = error $ "Control parameter 'hours' can't be sent to a bus." -- | a pattern of numbers from 0 to 1. Applies the resonance of the high-pass filter. Has alias @hpq@ hresonance :: Pattern Double -> ControlPattern@@ -1601,9 +1617,7 @@ midibendCountTo name ipat = innerJoin $ (\i -> pStateF "midibend" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat midibendbus :: Pattern Int -> Pattern Double -> ControlPattern-midibendbus busid pat = (pF "midibend" pat) # (pI "^midibend" busid)-midibendrecv :: Pattern Int -> ControlPattern-midibendrecv busid = pI "^midibend" busid+midibendbus _ _ = error $ "Control parameter 'midibend' can't be sent to a bus." -- | midichan :: Pattern Double -> ControlPattern@@ -1616,9 +1630,7 @@ midichanCountTo name ipat = innerJoin $ (\i -> pStateF "midichan" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat midichanbus :: Pattern Int -> Pattern Double -> ControlPattern-midichanbus busid pat = (pF "midichan" pat) # (pI "^midichan" busid)-midichanrecv :: Pattern Int -> ControlPattern-midichanrecv busid = pI "^midichan" busid+midichanbus _ _ = error $ "Control parameter 'midichan' can't be sent to a bus." -- | midicmd :: Pattern String -> ControlPattern@@ -1626,9 +1638,7 @@ midicmdTake :: String -> [Double] -> ControlPattern midicmdTake name xs = pStateListF "midicmd" name xs midicmdbus :: Pattern Int -> Pattern String -> ControlPattern-midicmdbus busid pat = (pS "midicmd" pat) # (pI "^midicmd" busid)-midicmdrecv :: Pattern Int -> ControlPattern-midicmdrecv busid = pI "^midicmd" busid+midicmdbus _ _ = error $ "Control parameter 'midicmd' can't be sent to a bus." -- | miditouch :: Pattern Double -> ControlPattern@@ -1641,9 +1651,7 @@ miditouchCountTo name ipat = innerJoin $ (\i -> pStateF "miditouch" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat miditouchbus :: Pattern Int -> Pattern Double -> ControlPattern-miditouchbus busid pat = (pF "miditouch" pat) # (pI "^miditouch" busid)-miditouchrecv :: Pattern Int -> ControlPattern-miditouchrecv busid = pI "^miditouch" busid+miditouchbus _ _ = error $ "Control parameter 'miditouch' can't be sent to a bus." -- | minutes :: Pattern Double -> ControlPattern@@ -1656,9 +1664,7 @@ minutesCountTo name ipat = innerJoin $ (\i -> pStateF "minutes" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat minutesbus :: Pattern Int -> Pattern Double -> ControlPattern-minutesbus busid pat = (pF "minutes" pat) # (pI "^minutes" busid)-minutesrecv :: Pattern Int -> ControlPattern-minutesrecv busid = pI "^minutes" busid+minutesbus _ _ = error $ "Control parameter 'minutes' can't be sent to a bus." -- | modwheel :: Pattern Double -> ControlPattern@@ -1716,36 +1722,6 @@ notebus :: Pattern Int -> Pattern Note -> ControlPattern notebus _ _ = error $ "Control parameter 'note' can't be sent to a bus." --- | -nrpnn :: Pattern Int -> ControlPattern-nrpnn = pI "nrpnn"-nrpnnTake :: String -> [Double] -> ControlPattern-nrpnnTake name xs = pStateListF "nrpnn" name xs-nrpnnCount :: String -> ControlPattern-nrpnnCount name = pStateF "nrpnn" name (maybe 0 (+1))-nrpnnCountTo :: String -> Pattern Double -> Pattern ValueMap-nrpnnCountTo name ipat = innerJoin $ (\i -> pStateF "nrpnn" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat--nrpnnbus :: Pattern Int -> Pattern Int -> ControlPattern-nrpnnbus busid pat = (pI "nrpnn" pat) # (pI "^nrpnn" busid)-nrpnnrecv :: Pattern Int -> ControlPattern-nrpnnrecv busid = pI "^nrpnn" busid---- | -nrpnv :: Pattern Int -> ControlPattern-nrpnv = pI "nrpnv"-nrpnvTake :: String -> [Double] -> ControlPattern-nrpnvTake name xs = pStateListF "nrpnv" name xs-nrpnvCount :: String -> ControlPattern-nrpnvCount name = pStateF "nrpnv" name (maybe 0 (+1))-nrpnvCountTo :: String -> Pattern Double -> Pattern ValueMap-nrpnvCountTo name ipat = innerJoin $ (\i -> pStateF "nrpnv" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat--nrpnvbus :: Pattern Int -> Pattern Int -> ControlPattern-nrpnvbus busid pat = (pI "nrpnv" pat) # (pI "^nrpnv" busid)-nrpnvrecv :: Pattern Int -> ControlPattern-nrpnvrecv busid = pI "^nrpnv" busid- -- | Nudges events into the future by the specified number of seconds. Negative numbers work up to a point as well (due to internal latency) nudge :: Pattern Double -> ControlPattern nudge = pF "nudge"@@ -2081,9 +2057,7 @@ polyTouchCountTo name ipat = innerJoin $ (\i -> pStateF "polyTouch" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat polyTouchbus :: Pattern Int -> Pattern Double -> ControlPattern-polyTouchbus busid pat = (pF "polyTouch" pat) # (pI "^polyTouch" busid)-polyTouchrecv :: Pattern Int -> ControlPattern-polyTouchrecv busid = pI "^polyTouch" busid+polyTouchbus _ _ = error $ "Control parameter 'polyTouch' can't be sent to a bus." -- | portamento :: Pattern Double -> ControlPattern@@ -2111,9 +2085,7 @@ progNumCountTo name ipat = innerJoin $ (\i -> pStateF "progNum" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat progNumbus :: Pattern Int -> Pattern Double -> ControlPattern-progNumbus busid pat = (pF "progNum" pat) # (pI "^progNum" busid)-progNumrecv :: Pattern Int -> ControlPattern-progNumrecv busid = pI "^progNum" busid+progNumbus _ _ = error $ "Control parameter 'progNum' can't be sent to a bus." -- | used in SuperDirt softsynths as a control rate or 'speed' rate :: Pattern Double -> ControlPattern@@ -2321,9 +2293,7 @@ secondsCountTo name ipat = innerJoin $ (\i -> pStateF "seconds" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat secondsbus :: Pattern Int -> Pattern Double -> ControlPattern-secondsbus busid pat = (pF "seconds" pat) # (pI "^seconds" busid)-secondsrecv :: Pattern Int -> ControlPattern-secondsrecv busid = pI "^seconds" busid+secondsbus _ _ = error $ "Control parameter 'seconds' can't be sent to a bus." -- | semitone :: Pattern Double -> ControlPattern@@ -2651,9 +2621,7 @@ songPtrCountTo name ipat = innerJoin $ (\i -> pStateF "songPtr" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat songPtrbus :: Pattern Int -> Pattern Double -> ControlPattern-songPtrbus busid pat = (pF "songPtr" pat) # (pI "^songPtr" busid)-songPtrrecv :: Pattern Int -> ControlPattern-songPtrrecv busid = pI "^songPtr" busid+songPtrbus _ _ = error $ "Control parameter 'songPtr' can't be sent to a bus." -- | a pattern of numbers which changes the speed of sample playback, i.e. a cheap way of changing pitch. Negative values will play the sample backwards! speed :: Pattern Double -> ControlPattern@@ -2867,9 +2835,7 @@ uidCountTo name ipat = innerJoin $ (\i -> pStateF "uid" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat uidbus :: Pattern Int -> Pattern Double -> ControlPattern-uidbus busid pat = (pF "uid" pat) # (pI "^uid" busid)-uidrecv :: Pattern Int -> ControlPattern-uidrecv busid = pI "^uid" busid+uidbus _ _ = error $ "Control parameter 'uid' can't be sent to a bus." -- | used in conjunction with `speed`, accepts values of "r" (rate, default behavior), "c" (cycles), or "s" (seconds). Using `unit "c"` means `speed` will be interpreted in units of cycles, e.g. `speed "1"` means samples will be stretched to fill a cycle. Using `unit "s"` means the playback speed will be adjusted so that the duration is the number of seconds specified by `speed`. unit :: Pattern String -> ControlPattern@@ -2890,9 +2856,7 @@ valCountTo name ipat = innerJoin $ (\i -> pStateF "val" name (maybe 0 ((`mod'` i) . (+1)))) <$> ipat valbus :: Pattern Int -> Pattern Double -> ControlPattern-valbus busid pat = (pF "val" pat) # (pI "^val" busid)-valrecv :: Pattern Int -> ControlPattern-valrecv busid = pI "^val" busid+valbus _ _ = error $ "Control parameter 'val' can't be sent to a bus." -- | vcfegint :: Pattern Double -> ControlPattern@@ -3293,6 +3257,9 @@ gatbus = gatebus gatrecv :: Pattern Int -> ControlPattern gatrecv = gaterecv++fadeOutTime :: Pattern Double -> ControlPattern+fadeOutTime = fadeTime dt :: Pattern Double -> ControlPattern dt = delaytime
src/Sound/Tidal/ParseBP.hs view
@@ -321,12 +321,11 @@ <|> return Positive intOrFloat :: MyParser Double-intOrFloat = do s <- sign- num <- naturalOrFloat- return (case num of- Right x -> applySign s x- Left x -> fromIntegral $ applySign s x- )+intOrFloat = do num <- naturalOrFloat+ return (case num of+ Right x -> x+ Left x -> fromIntegral x+ ) parseRhythm :: Parseable a => MyParser (TPat a) -> String -> Either ParseError (TPat a) parseRhythm f = runParser (pSequence f' Prelude.<* eof) (0 :: Int) ""@@ -439,16 +438,20 @@ pChar = wrapPos $ TPat_Atom Nothing <$> pCharNum pDouble :: MyParser (TPat Double)-pDouble = wrapPos $ do f <- choice [intOrFloat, pRatioChar, parseNote] <?> "float"- do TPat_Stack . map (TPat_Atom Nothing . (+ f)) <$> parseChord- <|> return (TPat_Atom Nothing f)+pDouble = wrapPos $ do s <- sign+ f <- choice [intOrFloat, pRatioChar, parseNote] <?> "float"+ let v = applySign s f+ do TPat_Stack . map (TPat_Atom Nothing . (+ v)) <$> parseChord+ <|> return (TPat_Atom Nothing v) <|> do TPat_Stack . map (TPat_Atom Nothing) <$> parseChord pNote :: MyParser (TPat Note)-pNote = wrapPos $ fmap (fmap Note) $ do f <- choice [intOrFloat, parseNote] <?> "float"- do TPat_Stack . map (TPat_Atom Nothing . (+ f)) <$> parseChord- <|> return (TPat_Atom Nothing f)+pNote = wrapPos $ fmap (fmap Note) $ do s <- sign+ f <- choice [intOrFloat, parseNote] <?> "float"+ let v = applySign s f+ do TPat_Stack . map (TPat_Atom Nothing . (+ v)) <$> parseChord+ <|> return (TPat_Atom Nothing v) <|> do TPat_Stack . map (TPat_Atom Nothing) <$> parseChord <|> do TPat_Atom Nothing <$> pRatioChar
src/Sound/Tidal/Pattern.hs view
@@ -449,7 +449,7 @@ filterAnalog = filterEvents isAnalog playFor :: Time -> Time -> Pattern a -> Pattern a-playFor s e = filterWhen (\t -> (t >= s) && (t < e))+playFor s e pat = Pattern $ \st -> maybe [] (\a -> query pat (st {arc = a})) $ subArc (Arc s e) (arc st) -- ** Temporal parameter helpers
src/Sound/Tidal/Stream.hs view
@@ -287,8 +287,9 @@ where (a,b) = break (== '}') xs getString :: ValueMap -> String -> Maybe String-getString cm s = defaultValue $ simpleShow <$> Map.lookup s cm- where simpleShow :: Value -> String+getString cm s = (simpleShow <$> Map.lookup param cm) <|> defaultValue dflt+ where (param, dflt) = break (== '=') s+ simpleShow :: Value -> String simpleShow (VS str) = str simpleShow (VI i) = show i simpleShow (VF f) = show f@@ -299,11 +300,9 @@ simpleShow (VState _) = show "<stateful>" simpleShow (VPattern _) = show "<pattern>" simpleShow (VList _) = show "<list>"- (_, dflt) = break (== '=') s- defaultValue :: Maybe String -> Maybe String- defaultValue Nothing | null dflt = Nothing- | otherwise = Just $ tail dflt- defaultValue x = x+ defaultValue :: String -> Maybe String+ defaultValue ('=':dfltVal) = Just dfltVal+ defaultValue _ = Nothing playStack :: PlayMap -> ControlPattern playStack pMap = stack $ map pattern active@@ -592,6 +591,9 @@ streamAll s f = do _ <- swapMVar (sGlobalFMV s) f return () +streamGet :: Stream -> String -> IO (Maybe Value)+streamGet s k = Map.lookup k <$> readMVar (sStateMV s)+ streamSet :: Valuable a => Stream -> String -> Pattern a -> IO () streamSet s k pat = do sMap <- takeMVar $ sStateMV s let pat' = toValue <$> pat@@ -647,14 +649,28 @@ bufferIndices [] = [] bufferIndices (x:xs') | x == (O.ASCII_String $ O.ascii "&controlBusIndices") = catMaybes $ takeWhile isJust $ map O.datum_integral xs' | otherwise = bufferIndices xs'- act (O.Message x (O.Int32 k:v:[]))- = act (O.Message x [O.string $ show k,v])- act (O.Message _ (O.ASCII_String k:v@(O.Float _):[]))+ -- External controller commands+ act (O.Message "/ctrl" (O.Int32 k:v:[]))+ = act (O.Message "/ctrl" [O.string $ show k,v])+ act (O.Message "/ctrl" (O.ASCII_String k:v@(O.Float _):[])) = add (O.ascii_to_string k) (VF (fromJust $ O.datum_floating v))- act (O.Message _ (O.ASCII_String k:O.ASCII_String v:[]))+ act (O.Message "/ctrl" (O.ASCII_String k:O.ASCII_String v:[])) = add (O.ascii_to_string k) (VS (O.ascii_to_string v))- act (O.Message _ (O.ASCII_String k:O.Int32 v:[]))+ act (O.Message "/ctrl" (O.ASCII_String k:O.Int32 v:[])) = add (O.ascii_to_string k) (VI (fromIntegral v))+ -- Stream playback commands+ act (O.Message "/mute" (O.Int32 k:[]))+ = streamMute stream k+ act (O.Message "/mute" (O.ASCII_String k:[]))+ = streamMute stream (O.ascii_to_string k)+ act (O.Message "/unmute" (O.Int32 k:[]))+ = streamUnmute stream k+ act (O.Message "/unmute" (O.ASCII_String k:[]))+ = streamUnmute stream (O.ascii_to_string k)+ act (O.Message "/muteAll" [])+ = streamMuteAll stream+ act (O.Message "/unmuteAll" [])+ = streamUnmuteAll stream act m = hPutStrLn stderr $ "Unhandled OSC: " ++ show m add :: String -> Value -> IO () add k v = do sMap <- takeMVar (sStateMV stream)
src/Sound/Tidal/Version.hs view
@@ -21,7 +21,7 @@ -} tidal_version :: String-tidal_version = "1.7.2"+tidal_version = "1.7.3" tidal_status :: IO () tidal_status = tidal_status_string >>= putStrLn
test/Sound/Tidal/CoreTest.hs view
@@ -2,140 +2,305 @@ module Sound.Tidal.CoreTest where -import TestUtils-import Test.Microspec--import Prelude hiding ((<*), (*>))--import Data.Ratio import Data.List (sort)-+import Data.Ratio import Sound.Tidal.Context+import Test.Microspec+import TestUtils+import Prelude hiding ((*>), (<*)) run :: Microspec () run = describe "Sound.Tidal.Core" $ do- describe "append" $ do+ describe "append" $ it "can switch between the cycles from two pures" $ do- (queryArc (append (pure "a") (pure "b")) (Arc 0 5)) `shouldBe`- fmap toEvent- [(((0,1), (0,1)), "a" :: String),- (((1,2), (1,2)), "b"),- (((2,3), (2,3)), "a"),- (((3,4), (3,4)), "b"),- (((4,5), (4,5)), "a")- ]+ queryArc (append (pure "a") (pure "b")) (Arc 0 5)+ `shouldBe` fmap+ toEvent+ [ (((0, 1), (0, 1)), "a" :: String),+ (((1, 2), (1, 2)), "b"),+ (((2, 3), (2, 3)), "a"),+ (((3, 4), (3, 4)), "b"),+ (((4, 5), (4, 5)), "a")+ ] describe "cat" $ do it "can switch between the cycles from three pures" $ do- queryArc (cat [pure "a", pure "b", pure "c"]) (Arc 0 5) `shouldBe`- fmap toEvent- [(((0,1), (0,1)), "a" :: String),- (((1,2), (1,2)), "b"),- (((2,3), (2,3)), "c"),- (((3,4), (3,4)), "a"),- (((4,5), (4,5)), "b")- ]-+ queryArc (cat [pure "a", pure "b", pure "c"]) (Arc 0 5)+ `shouldBe` fmap+ toEvent+ [ (((0, 1), (0, 1)), "a" :: String),+ (((1, 2), (1, 2)), "b"),+ (((2, 3), (2, 3)), "c"),+ (((3, 4), (3, 4)), "a"),+ (((4, 5), (4, 5)), "b")+ ]+ it "can extract nested revs" $+ let a = "1 2 3" :: Pattern Int+ b = "4 5 6" :: Pattern Int+ c = "7 8 9" :: Pattern Int+ in comparePD+ (Arc 0 10)+ (rev $ cat [a, b, c])+ (cat [rev a, rev b, rev c]) describe "fastCat" $ do it "can switch between the cycles from three pures inside one cycle" $ do- it "1" $ queryArc (fastCat [pure "a", pure "b", pure "c"]) (Arc 0 1)- `shouldBe` fmap toEvent- [(((0,1/3), (0,1/3)), "a" :: String),- (((1/3,2/3), (1/3,2/3)), "b"),- (((2/3,1), (2/3,1)), "c")- ]- it "5/3" $ queryArc (fastCat [pure "a", pure "b", pure "c"]) (Arc 0 (5/3))- `shouldBe` fmap toEvent- [(((0,1/3), (0,1/3)), "a" :: String),- (((1/3,2/3), (1/3,2/3)), "b"),- (((2/3,1), (2/3,1)), "c"),- (((1,4/3), (1,4/3)), "a"),- (((4/3,5/3), (4/3,5/3)), "b")- ]+ it "1" $+ queryArc (fastCat [pure "a", pure "b", pure "c"]) (Arc 0 1)+ `shouldBe` fmap+ toEvent+ [ (((0, 1 / 3), (0, 1 / 3)), "a" :: String),+ (((1 / 3, 2 / 3), (1 / 3, 2 / 3)), "b"),+ (((2 / 3, 1), (2 / 3, 1)), "c")+ ]+ it "5/3" $+ queryArc (fastCat [pure "a", pure "b", pure "c"]) (Arc 0 (5 / 3))+ `shouldBe` fmap+ toEvent+ [ (((0, 1 / 3), (0, 1 / 3)), "a" :: String),+ (((1 / 3, 2 / 3), (1 / 3, 2 / 3)), "b"),+ (((2 / 3, 1), (2 / 3, 1)), "c"),+ (((1, 4 / 3), (1, 4 / 3)), "a"),+ (((4 / 3, 5 / 3), (4 / 3, 5 / 3)), "b")+ ] it "works with zero-length queries" $ do it "0" $ queryArc (fastCat [pure "a", pure "b"]) (Arc 0 0)- `shouldBe` fmap toEvent [(((0,0.5), (0,0)), "a" :: String)]+ `shouldBe` fmap toEvent [(((0, 0.5), (0, 0)), "a" :: String)] it "1/3" $- queryArc (fastCat [pure "a", pure "b"]) (Arc (1%3) (1%3))- `shouldBe` fmap toEvent [(((0,0.5), (1%3,1%3)), "a" :: String)]+ queryArc (fastCat [pure "a", pure "b"]) (Arc (1 % 3) (1 % 3))+ `shouldBe` fmap toEvent [(((0, 0.5), (1 % 3, 1 % 3)), "a" :: String)] describe "rev" $ do it "mirrors events" $ do let forward = fastCat [fastCat [pure 7, pure 8], pure 9] :: Pattern Int backward = fastCat [pure 9, fastCat [pure 8, pure 7]] -- sort the events into time order to compare them- (sort $ queryArc (rev forward) (Arc 0 1)) `shouldBe` (sort $ queryArc (backward) (Arc 0 1))+ sort (queryArc (rev forward) (Arc 0 1)) `shouldBe` sort (queryArc backward (Arc 0 1)) it "returns the original if you reverse it twice" $ do let x = fastCat [fastCat [pure 7, pure 8], pure 9] :: Pattern Int- (queryArc (rev $ rev x) (Arc 0 5)) `shouldBe` (queryArc x (Arc 0 5))+ queryArc (rev $ rev x) (Arc 0 5) `shouldBe` queryArc x (Arc 0 5) + describe "|>|" $ do+ let a = "[1, 1] [2,2] 3" :: Pattern Int+ b = "4 [5, 5] 6 7" :: Pattern Int+ c = "7 8 9 10" :: Pattern Int+ d = "7 [8, 9] 10 11" :: Pattern Int+ it "creates silence when" $ do+ it "first argument silent" $+ comparePD+ (Arc 0 1)+ (silence |>| a)+ silence+ it "second argument silent" $+ comparePD+ (Arc 0 1)+ (a |>| silence)+ silence+ it "creates the same pattern when left argument has the same structure" $+ comparePD+ (Arc 0 1)+ (b |>| a)+ (d |>| a)+ it "can extract rev from first argument" $+ comparePD+ (Arc 0 1)+ (rev a |>| b)+ (rev (a |>| rev b))+ it "is assiociative" $+ comparePD+ (Arc 0 1)+ ((a |>| b) |>| c)+ (a |>| (b |>| c))+ it "is commutative in all arguments except the rightmost" $+ comparePD+ (Arc 0 1)+ (a |>| b |>| c)+ (b |>| a |>| c)++ describe "stack" $ do+ let a = "1 2 3" :: Pattern Int+ b = "4 5 6" :: Pattern Int+ c = "7 8 9" :: Pattern Int+ it "is neutral with silence" $+ comparePD+ (Arc 0 1)+ (stack [a, silence])+ a+ it "can create silence" $+ comparePD+ (Arc 0 1)+ (stack [] :: Pattern Int)+ silence+ it "follows commutative laws" $+ comparePD+ (Arc 0 1)+ (stack [a, b])+ (stack [b, a])+ it "follows assiociative laws" $+ comparePD+ (Arc 0 1)+ (stack [a, stack [b, c]])+ (stack [stack [a, b], c])+ it "can extract nested revs" $+ comparePD+ (Arc 0 1)+ (rev $ stack [a, b, c])+ (stack [rev a, rev b, rev c])++ describe "fast" $ do+ let x = "1 2 3" :: Pattern Time+ y = "4 5 6" :: Pattern Time+ it "is neutral with speedup 1" $+ comparePD+ (Arc 0 1)+ (fast 1 x)+ x+ it "mutes, when there is" $ do+ it "silence in first argument" $+ comparePD+ (Arc 0 1)+ (fast silence x)+ silence+ it "silence in second argument" $+ comparePD+ (Arc 0 1)+ (fast x silence :: Pattern Time)+ silence+ it "speedup by 0" $+ comparePD+ (Arc 0 1)+ (fast 0 x)+ silence+ it "is reciprocal to slow" $+ comparePD+ (Arc 0 1)+ (fast 2 x)+ (slow (fromRational $ 1 % 2) x)+ it "can be reversed by reciprocal speedup" $+ comparePD+ (Arc 0 1)+ (fast 2 $ fast (fromRational $ 1 % 2) x)+ x+ it "preserves structure" $+ comparePD+ (Arc 0 1)+ (fast x (stack [y, y]))+ (fast (stack [x, x]) y)++ describe "slow" $ do+ let x = "1 2 3" :: Pattern Time+ y = "4 5 6" :: Pattern Time+ it "is neutral with slowdown 1" $+ comparePD+ (Arc 0 10)+ (slow 1 x)+ x+ it "mutes, when there is" $ do+ it "silence in first argument" $+ comparePD+ (Arc 0 10)+ (slow silence x)+ silence+ it "silence in second argument" $+ comparePD+ (Arc 0 10)+ (slow x silence :: Pattern Time)+ silence+ it "speedup by 0" $+ comparePD+ (Arc 0 10)+ (slow 0 x)+ silence+ it "is reciprocal to fast" $+ comparePD+ (Arc 0 10)+ (slow 2 x)+ (fast (fromRational $ 1 % 2) x)+ it "can be reversed by reciprocal slowdown" $+ comparePD+ (Arc 0 10)+ (slow 2 $ slow (fromRational $ 1 % 2) x)+ x+ it "preserves structure" $+ comparePD+ (Arc 0 1)+ (slow x (stack [y, y]))+ (slow (stack [x, x]) y)+ describe "compress" $ do it "squashes cycles to the start of a cycle" $ do let p = compress (0, 0.5) $ fastCat [pure 7, pure 8] :: Pattern Int- (queryArc p (Arc 0 1)) `shouldBe` fmap toEvent- [ (((0,0.25), (0,0.25)), 7),- (((0.25,0.5),(0.25,0.5)), 8)- ]+ queryArc p (Arc 0 1)+ `shouldBe` fmap+ toEvent+ [ (((0, 0.25), (0, 0.25)), 7),+ (((0.25, 0.5), (0.25, 0.5)), 8)+ ] it "squashes cycles to the end of a cycle" $ do let p = compress (0.5, 1) $ fastCat [pure 7, pure 8] :: Pattern Int- (queryArc p (Arc 0 1)) `shouldBe` fmap toEvent- [(((0.5,0.75), (0.5,0.75)), 7 :: Int),- (((0.75,1), (0.75,1)), 8)- ]+ queryArc p (Arc 0 1)+ `shouldBe` fmap+ toEvent+ [ (((0.5, 0.75), (0.5, 0.75)), 7 :: Int),+ (((0.75, 1), (0.75, 1)), 8)+ ] it "squashes cycles to the middle of a cycle" $ do let p = compress (0.25, 0.75) $ fastCat [pure 7, pure 8]- (queryArc p (Arc 0 1)) `shouldBe` fmap toEvent- [(((0.25,0.5), (0.25,0.5)), 7 :: Int),- (((0.5,0.75), (0.5,0.75)), 8)- ]+ queryArc p (Arc 0 1)+ `shouldBe` fmap+ toEvent+ [ (((0.25, 0.5), (0.25, 0.5)), 7 :: Int),+ (((0.5, 0.75), (0.5, 0.75)), 8)+ ] describe "saw" $ do it "goes from 0 up to 1 every cycle" $ do it "0" $- (queryArc saw (Arc 0 0)) `shouldBe` [(Event (Context []) Nothing (Arc 0 0) 0 :: Event Double)]+ queryArc saw (Arc 0 0) `shouldBe` [Event (Context []) Nothing (Arc 0 0) 0 :: Event Double] it "0.25" $- (queryArc saw (Arc 0.25 0.25)) `shouldBe` [(Event (Context []) Nothing (Arc 0.25 0.25) 0.25 :: Event Double)]+ queryArc saw (Arc 0.25 0.25) `shouldBe` [Event (Context []) Nothing (Arc 0.25 0.25) 0.25 :: Event Double] it "0.5" $- (queryArc saw (Arc 0.5 0.5)) `shouldBe` [(Event (Context []) Nothing (Arc 0.5 0.5) 0.5 :: Event Double)]+ queryArc saw (Arc 0.5 0.5) `shouldBe` [Event (Context []) Nothing (Arc 0.5 0.5) 0.5 :: Event Double] it "0.75" $- (queryArc saw (Arc 0.75 0.75)) `shouldBe` [(Event (Context []) Nothing (Arc 0.75 0.75) 0.75 :: Event Double)]- 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))+ queryArc saw (Arc 0.75 0.75) `shouldBe` [Event (Context []) Nothing (Arc 0.75 0.75) 0.75 :: Event Double]+ it "can be added to" $+ map value (queryArc ((+ 1) <$> saw) (Arc 0.5 0.5)) `shouldBe` [1.5 :: Float]+ it "works on the left of <*>" $+ queryArc ((+) <$> saw <*> pure 3) (Arc 0 1) `shouldBe` [Event (Context []) Nothing (Arc 0 1) 3.5 :: Event Double]- it "works on the right of <*>" $ do- (queryArc ((fast 4 $ pure (+3)) <*> saw) (Arc 0 1))- `shouldBe` - [Event (Context []) Nothing (Arc 0 0.25) 3.5 :: Event Double,- Event (Context []) Nothing (Arc 0.25 0.5) 3.5,- Event (Context []) Nothing (Arc 0.5 0.75) 3.5,- Event (Context []) Nothing (Arc 0.75 1) 3.5- ]+ it "works on the right of <*>" $+ queryArc (fast 4 (pure (+ 3)) <*> saw) (Arc 0 1)+ `shouldBe` [ Event (Context []) Nothing (Arc 0 0.25) 3.5 :: Event Double,+ Event (Context []) Nothing (Arc 0.25 0.5) 3.5,+ Event (Context []) Nothing (Arc 0.5 0.75) 3.5,+ Event (Context []) Nothing (Arc 0.75 1) 3.5+ ] it "can be reversed" $ do it "works with whole cycles" $- (queryArc (rev saw) (Arc 0 1))- `shouldBe` [(Event (Context []) Nothing (Arc 0 1) 0.5 :: Event Double)]+ queryArc (rev saw) (Arc 0 1)+ `shouldBe` [Event (Context []) Nothing (Arc 0 1) 0.5 :: Event Double] it "works with half cycles" $- (queryArc (rev saw) (Arc 0 0.5))- `shouldBe` [(Event (Context []) Nothing (Arc 0 0.5) 0.75 :: Event Double)]+ queryArc (rev saw) (Arc 0 0.5)+ `shouldBe` [Event (Context []) Nothing (Arc 0 0.5) 0.75 :: Event Double] it "works with inset points" $- (queryArc (rev saw) (Arc 0.25 0.25))- `shouldBe` [(Event (Context []) Nothing (Arc 0.25 0.25) 0.75 :: Event Double)]+ queryArc (rev saw) (Arc 0.25 0.25)+ `shouldBe` [Event (Context []) Nothing (Arc 0.25 0.25) 0.75 :: Event Double] describe "tri" $ do- it "goes from 0 up to 1 and back every cycle" $ do- comparePD (Arc 0 1)+ it "goes from 0 up to 1 and back every cycle" $+ comparePD+ (Arc 0 1) (struct "t*8" (tri :: Pattern Double))- ("0.125 0.375 0.625 0.875 0.875 0.625 0.375 0.125")- it "can be added to" $ do- comparePD (Arc 0 1)+ "0.125 0.375 0.625 0.875 0.875 0.625 0.375 0.125"+ it "can be added to" $+ comparePD+ (Arc 0 1) (struct "t*8" $ (tri :: Pattern Double) + 1)- ("1.125 1.375 1.625 1.875 1.875 1.625 1.375 1.125")- describe "every" $ do+ "1.125 1.375 1.625 1.875 1.875 1.625 1.375 1.125"+ describe "every" $ it "`every n id` doesn't change the pattern's structure" $ do- comparePD (Arc 0 4)- (every 2 id $ "x/2" :: Pattern String)- ("x/2")+ comparePD+ (Arc 0 4)+ (every 2 id "x/2" :: Pattern String)+ "x/2"
test/Sound/Tidal/ExceptionsTest.hs view
@@ -5,7 +5,7 @@ import Test.Microspec import Control.Exception import Control.DeepSeq-import Data.Typeable (typeOf)+import Data.Typeable () import Prelude hiding ((<*), (*>)) import Sound.Tidal.Pattern
test/Sound/Tidal/ParseTest.hs view
@@ -131,6 +131,10 @@ compareP (Arc 0 1) (" bd " :: Pattern String) ("bd" :: Pattern String)+ it "can parse negative ratio shorthands" $ do+ compareP (Arc 0 1)+ ("h -h" :: Pattern Double)+ ("0.5 -0.5" :: Pattern Double) it "doesn't crash on zeroes (1)" $ do compareP (Arc 0 2) ("cp/0" :: Pattern String)
test/Sound/Tidal/StreamTest.hs view
@@ -6,6 +6,7 @@ import Sound.Tidal.Stream import Sound.Tidal.Pattern import qualified Sound.OSC.FD as O+import qualified Data.Map.Strict as M run :: Microspec () run =@@ -13,4 +14,23 @@ describe "toDatum" $ do it "should convert VN to osc float" $ do toDatum (VN (Note 3.5)) `shouldBe` O.float (3.5 :: Double)- + + describe "substitutePath" $ do+ -- ValueMap+ let state = M.fromList [("sound", VS "sn"), ("n", VI 8)]+ it "should return same string if no params are specified" $ do+ substitutePath "/s_new" state `shouldBe` Just "/s_new"+ it "should substitute values for params if present" $ do+ substitutePath "/{sound}/{n}/vol" state `shouldBe` Just "/sn/8/vol"+ it "should return Nothing if a param is not present" $ do+ substitutePath "/{sound}/{inst}" state `shouldBe` Nothing+ + describe "getString" $ do+ it "should return Nothing for missing params" $ do+ getString M.empty "s" `shouldBe` Nothing+ it "should work for strings" $ do+ getString (M.singleton "s" (VS "sn")) "s" `shouldBe` Just "sn"+ it "should work for params with fallback expressions" $ do+ getString (M.singleton "s" (VS "sn")) "s=bd" `shouldBe` Just "sn"+ it "should work for missing params with fallback expressions" $ do+ getString M.empty "s=bd" `shouldBe` Just "bd"
test/Sound/Tidal/UITest.hs view
@@ -313,28 +313,28 @@ (arpeggiate $ "[0,0]*2") ("0 0 0 0" :: Pattern Int) - describe "chunk" $ do- it "can chunk a rev pattern" $ do- compareP (Arc 0 4)- (chunk 2 (rev) $ ("a b c d" :: Pattern String))- (slow 2 $ "d c c d a b b a" :: Pattern String)- it "can chunk a fast pattern" $ do- compareP (Arc 0 4)- (chunk 2 (fast 2) $ "a b" :: Pattern String)- (slow 2 $ "a b b _ a _ a b" :: Pattern String)+ describe "chunk" $ do+ it "can chunk a rev pattern" $ do+ compareP (Arc 0 4)+ (chunk 2 (rev) $ ("a b c d" :: Pattern String))+ (slow 2 $ "d c c d a b b a" :: Pattern String)+ it "can chunk a fast pattern" $ do+ compareP (Arc 0 4)+ (chunk 2 (fast 2) $ "a b" :: Pattern String)+ (slow 2 $ "a b b _ a _ a b" :: Pattern String) - describe "binary" $ do- it "converts a number to a pattern of boolean" $ do- compareP (Arc 0 1)- (binary "128")- ("t f f f f f f f" :: Pattern Bool)+ describe "binary" $ do+ it "converts a number to a pattern of boolean" $ do+ compareP (Arc 0 1)+ (binary "128")+ ("t f f f f f f f" :: Pattern Bool) - describe "binaryN" $ do- it "convert a number to a pattern of boolean of specified length" $ do- compareP (Arc 0 1)- (binaryN 4 "8")- ("t f f f" :: Pattern Bool)- it "convert a number to a pattern of boolean of specified patternable length" $ do- compareP (Arc 0 2)- (binaryN "<4 8>" "8")- (cat ["t f f f", "f f f f t f f f"] :: Pattern Bool)+ describe "binaryN" $ do+ it "convert a number to a pattern of boolean of specified length" $ do+ compareP (Arc 0 1)+ (binaryN 4 "8")+ ("t f f f" :: Pattern Bool)+ it "convert a number to a pattern of boolean of specified patternable length" $ do+ compareP (Arc 0 2)+ (binaryN "<4 8>" "8")+ (cat ["t f f f", "f f f f t f f f"] :: Pattern Bool)
tidal.cabal view
@@ -1,5 +1,5 @@ name: tidal-version: 1.7.2+version: 1.7.3 synopsis: Pattern language for improvised music -- description: homepage: http://tidalcycles.org/@@ -58,7 +58,6 @@ , text < 1.3 , parsec >= 3.1.12 && < 3.2 , network < 3.2- , vector < 0.13 , bifunctors < 5.6 , transformers >= 0.5 && < 0.5.7 , bytestring < 0.12