tidal 1.4.3 → 1.4.4
raw patch · 10 files changed
+110/−39 lines, 10 filesdep +random
Dependencies added: random
Files
- src/Sound/Tidal/Core.hs +7/−0
- src/Sound/Tidal/Params.hs +6/−2
- src/Sound/Tidal/ParseBP.hs +13/−3
- src/Sound/Tidal/Pattern.hs +14/−3
- src/Sound/Tidal/Stream.hs +40/−18
- src/Sound/Tidal/Tempo.hs +3/−3
- src/Sound/Tidal/UI.hs +6/−3
- src/Sound/Tidal/Version.hs +1/−1
- tidal.cabal +5/−1
- tidal.el +15/−5
src/Sound/Tidal/Core.hs view
@@ -124,6 +124,13 @@ ( %|) :: Real a => Pattern a -> Pattern a -> Pattern a a %| b = mod' <$> a *> b +(|**|) :: (Applicative a, Real b) => a b -> a b -> a b+a |**| b = mod' <$> a <*> b+(|** ) :: Real a => Pattern a -> Pattern a -> Pattern a+a |** b = mod' <$> a <* b+( **|) :: Real a => Pattern a -> Pattern a -> Pattern a+a **| b = mod' <$> a *> b+ (|>|) :: (Applicative a, Unionable b) => a b -> a b -> a b a |>| b = flip union <$> a <*> b (|> ) :: Unionable a => Pattern a -> Pattern a -> Pattern a
src/Sound/Tidal/Params.hs view
@@ -5,6 +5,7 @@ import Sound.Tidal.Pattern import Sound.Tidal.Utils import Data.Maybe (fromMaybe)+import Data.Word (Word8) -- | group multiple params into one grp :: [String -> ControlMap] -> Pattern String -> ControlPattern@@ -47,6 +48,9 @@ pS :: String -> Pattern String -> ControlPattern pS name = fmap (Map.singleton name . VS) +pX :: String -> Pattern [Word8] -> ControlPattern+pX name = fmap (Map.singleton name . VX)+ -- | patterns for internal sound routing toArg :: Pattern String -> ControlPattern toArg = pS "toArg"@@ -543,8 +547,8 @@ -- SuperDirt MIDI Params -array :: Pattern Double -> ControlPattern-array = pF "array"+array :: Pattern [Word8] -> ControlPattern+array = pX "array" midichan :: Pattern Double -> ControlPattern midichan = pF "midichan" control :: Pattern Double -> ControlPattern
src/Sound/Tidal/ParseBP.hs view
@@ -52,6 +52,7 @@ | TPat_TimeCat [TPat a] | TPat_Overlay (TPat a) (TPat a) | TPat_Stack [TPat a]+ | TPat_CycleChoose [TPat a] | TPat_ShiftL Time (TPat a) -- TPat_E Int Int (TPat a) | TPat_pE (TPat Int) (TPat Int) (TPat Int) (TPat a)@@ -69,6 +70,7 @@ TPat_TimeCat xs -> timeCat $ map (\(n, pat) -> (toRational n, toPat pat)) $ durations xs TPat_Overlay x0 x1 -> overlay (toPat x0) (toPat x1) TPat_Stack xs -> stack $ map toPat xs+ TPat_CycleChoose xs -> unwrap $ cycleChoose $ map toPat xs TPat_ShiftL t x -> t `rotL` toPat x TPat_pE n k s thing -> doEuclid (toPat n) (toPat k) (toPat s) (toPat thing)@@ -297,9 +299,17 @@ return pts pPolyIn :: Parseable a => Parser (TPat a) -> Parser (TPat a)-pPolyIn f = do ps <- brackets (pSequence f `sepBy` symbol ",")- spaces- pMult $ TPat_Stack ps+pPolyIn f = do x <- brackets $ do p <- pSequence f <?> "sequence"+ stackTail p <|> chooseTail p <|> return p+ pMult x+ where stackTail p = do symbol ","+ ps <- pSequence f `sepBy` symbol ","+ spaces+ return $ TPat_Stack (p:ps)+ chooseTail p = do symbol "|"+ ps <- pSequence f `sepBy` symbol "|"+ spaces+ return $ TPat_CycleChoose (p:ps) pPolyOut :: Parseable a => Parser (TPat a) -> Parser (TPat a) pPolyOut f = do ps <- braces (pSequenceN f `sepBy` symbol ",")
src/Sound/Tidal/Pattern.hs view
@@ -15,7 +15,7 @@ import Data.Ratio (numerator, denominator) import Data.Typeable (Typeable) import Control.DeepSeq (NFData(rnf))-+import Data.Word (Word8) ------------------------------------------------------------------------ -- * Types@@ -251,6 +251,7 @@ | VR { rvalue :: Rational } | VI { ivalue :: Int } | VB { bvalue :: Bool }+ | VX { xvalue :: [Word8] } -- Used for OSC 'blobs' deriving (Typeable,Data) class Valuable a where@@ -262,6 +263,7 @@ rnf (VR r) = rnf r rnf (VI i) = rnf i rnf (VB b) = rnf b+ rnf (VX xs) = rnf xs instance Valuable String where toValue = VS@@ -273,14 +275,16 @@ toValue a = VI a instance Valuable Bool where toValue a = VB a+instance Valuable [Word8] where+ toValue a = VX 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+ (VX x) == (VX y) = x == y (VF x) == (VI y) = x == (fromIntegral y) (VI y) == (VF x) = x == (fromIntegral y)@@ -290,7 +294,6 @@ (VI x) == (VR y) = (toRational x) == y (VR y) == (VI x) = (toRational x) == y - _ == _ = False instance Ord Value where@@ -299,10 +302,13 @@ 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 (VX x) (VX y) = compare x y compare (VS _) _ = LT compare _ (VS _) = GT compare (VB _) _ = LT compare _ (VB _) = GT+ compare (VX _) _ = LT+ compare _ (VX _) = GT compare (VF x) (VI y) = compare x (fromIntegral y) compare (VI x) (VF y) = compare (fromIntegral x) y @@ -589,6 +595,7 @@ show (VF f) = show f ++ "f" show (VR r) = show r ++ "r" show (VB b) = show b+ show (VX xs) = show xs instance {-# OVERLAPPING #-} Show ControlMap where show m = intercalate ", " $ map (\(name, v) -> name ++ ": " ++ show v) $ Map.toList m@@ -737,6 +744,10 @@ getR (VF x) = Just $ toRational x getR (VI x) = Just $ toRational x getR _ = Nothing++getBlob :: Value -> Maybe [Word8]+getBlob (VX xs) = Just xs+getBlob _ = Nothing compressArc :: Arc -> Pattern a -> Pattern a compressArc (Arc s e) p | s > e = empty
src/Sound/Tidal/Stream.hs view
@@ -24,6 +24,8 @@ import qualified Sound.Tidal.Tempo as T -- import qualified Sound.OSC.Datum as O import Data.List (sortOn)+import System.Random (getStdRandom, randomR)+import Data.Word (Word8) data TimeStamp = BundleStamp | MessageStamp | NoStamp deriving (Eq, Show)@@ -140,35 +142,50 @@ toDatum (VR x) = O.float $ ((fromRational x) :: Double) toDatum (VB True) = O.int32 (1 :: Int) toDatum (VB False) = O.int32 (0 :: Int)+toDatum (VX xs) = O.Blob $ O.blob_pack xs toData :: OSCTarget -> Event ControlMap -> Maybe [O.Datum] toData target e | isJust (oShape target) = fmap (fmap toDatum) $ sequence $ map (\(n,v) -> Map.lookup n (value e) <|> v) (fromJust $ oShape target) | otherwise = Just $ concatMap (\(n,v) -> [O.string n, toDatum v]) $ Map.toList $ value e +substitutePath :: String -> ControlMap -> String+substitutePath path cm = parse path+ where parse [] = []+ parse ('{':xs) = parseWord xs+ parse (x:xs) = x:(parse xs)+ parseWord xs | b == [] = getString cm a+ | otherwise = getString cm a ++ parse (tail b)+ where (a,b) = break (== '}') xs++getString :: ControlMap -> String -> String+getString cm s = fromMaybe "" $ do v <- Map.lookup s cm+ return $ simpleShow v+ where simpleShow :: Value -> String+ simpleShow (VS str) = str+ simpleShow (VI i) = show i+ simpleShow (VF f) = show f+ simpleShow (VR r) = show r+ simpleShow (VB b) = show b+ simpleShow (VX xs) = show xs+ 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+ return $ O.Message (substitutePath (oPath target) (value e)) $ oPreamble target ++ vs where on = sched tempo $ start $ wholeOrPart e off = sched tempo $ stop $ wholeOrPart e+ cm = value e identifier = ((if (start $ wholeOrPart e) == (start $ part e) then "X" else ">") ++ show (start $ wholeOrPart e) ++ "-" ++ show (stop $ wholeOrPart e) ++ "-"- ++ getString "n"+ ++ getString cm "n" ++ "-"- ++ getString "note"+ ++ getString cm "note" ++ "-"- ++ getString "s"+ ++ getString cm "s" )- getString s = fromMaybe "" $ do v <- Map.lookup s $ value e- return $ simpleShow v- simpleShow (VS s) = s- simpleShow (VI i) = show i- simpleShow (VF f) = show f- simpleShow (VR r) = show r- simpleShow (VB b) = show b delta = off - on messageStamp = oTimestamp target == MessageStamp -- If there is already cps in the event, the union will preserve that.@@ -201,22 +218,23 @@ do p <- readMVar pMV sMap <- readMVar sMapMV tempo <- takeMVar tempoMV- now <- O.time let frameEnd = snd $ T.nowTimespan st sMap' = Map.insert "_cps" (pure $ VF $ T.cps tempo) sMap es = sortOn (start . part) $ 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 tempo' = (sched tempo' $ start $ wholeOrPart e)+ on e tempo'' = (sched tempo'' $ start $ wholeOrPart e) eventNudge e = fromJust $ getF $ fromMaybe (VF 0) $ Map.lookup "nudge" $ value e processCps :: T.Tempo -> [Event ControlMap] -> ([(T.Tempo, Event ControlMap)], T.Tempo)- processCps tempo [] = ([], tempo)- processCps tempo (e:es) = (((tempo', e):es'), tempo'')+ processCps t [] = ([], t)+ -- If an event has a tempo change, that affects the following+ -- events..+ processCps t (e:evs) = (((t', e):es'), t'') where cps' = do x <- Map.lookup "cps" $ value e getF x- tempo' = (maybe tempo (\newCps -> T.changeTempo' tempo newCps (eventPartStart e)) cps')- (es', tempo'') = processCps tempo' es+ t' = (maybe t (\newCps -> T.changeTempo' t newCps (eventPartStart e)) cps')+ (es', t'') = processCps t' evs latency target = oLatency target + cFrameTimespan config + T.nudged tempo (tes, tempo') = processCps tempo es mapM_ (\(Cx target udp) -> (do let ms = catMaybes $ map (\(t, e) -> do let nudge = eventNudge e@@ -311,7 +329,11 @@ streamUnsolo s k = withPatId s (show k) (\x -> x {solo = False}) streamOnce :: Stream -> ControlPattern -> IO ()-streamOnce st p+streamOnce st p = do i <- getStdRandom $ randomR (0, 8192)+ streamFirst st $ rotL (toRational (i :: Int)) p++streamFirst :: Stream -> ControlPattern -> IO ()+streamFirst st p = do sMap <- readMVar (sInput st) tempo <- readMVar (sTempoMV st) now <- O.time
src/Sound/Tidal/Tempo.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns -fno-warn-orphans #-} {-# LANGUAGE RecordWildCards #-} module Sound.Tidal.Tempo where@@ -12,13 +12,13 @@ import qualified Network.Socket as N import Control.Concurrent (forkIO, ThreadId, threadDelay) import Control.Monad (forever, when, foldM)-import Data.List (isPrefixOf, nub, intercalate)+import Data.List (isPrefixOf, nub) import qualified Control.Exception as E import Sound.Tidal.Config instance Show O.UDP where- show x = "-unshowable-"+ show _ = "-unshowable-" data Tempo = Tempo {atTime :: O.Time, atCycle :: Rational,
src/Sound/Tidal/UI.hs view
@@ -902,6 +902,9 @@ randcat :: [Pattern a] -> Pattern a randcat ps = spread' rotL (_segment 1 $ (%1) . fromIntegral <$> (irand (length ps) :: Pattern Int)) (slowcat ps) +wrandcat :: [(Pattern a, Double)] -> Pattern a+wrandcat ps = unwrap $ wchooseBy (segment 1 rand) ps+ -- @fromNote p@: converts a pattern of human-readable pitch names -- into pitch numbers. For example, @"cs2"@ will be parsed as C Sharp -- in the 2nd octave with the result of @11@, and @"b-3"@ as@@ -1420,9 +1423,9 @@ plyWith np f p = innerJoin $ (\n -> _plyWith n f p) <$> np _plyWith :: (Ord t, Num t) => t -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-_plyWith numPat f p = arpeggiate $ compound numPat f p- where compound n f p | n <= 1 = p- | otherwise = overlay p (f (compound (n-1) f p))+_plyWith numPat f p = arpeggiate $ compound numPat+ where compound n | n <= 1 = p+ | otherwise = overlay p (f $ compound $ n-1) -- Uses the first (binary) pattern to switch between the following two -- patterns.
src/Sound/Tidal/Version.hs view
@@ -1,4 +1,4 @@ module Sound.Tidal.Version where tidal_version :: String-tidal_version = "1.4.3"+tidal_version = "1.4.4"
tidal.cabal view
@@ -1,5 +1,5 @@ name: tidal-version: 1.4.3+version: 1.4.4 synopsis: Pattern language for improvised music -- description: homepage: http://tidalcycles.org/@@ -45,6 +45,7 @@ Sound.Tidal.Utils Sound.Tidal.Version Sound.Tidal.EspGrid+ -- Sound.Tidal.Light -- Sound.Tidal.TH Build-depends: base >=4.8 && <5@@ -62,6 +63,9 @@ , clock < 0.9 , deepseq >= 1.1.0.0 , primitive < 0.8+ , random < 1.2+ -- , serialport+ -- , hashable if !impl(ghc >= 8.4.1) build-depends: semigroups >= 0.18 && < 0.20
tidal.el view
@@ -58,12 +58,22 @@ "*Arguments to the haskell interpreter (default=none).") (defvar tidal-boot-script-path- (concat (substring- (shell-command-to-string- "ghc-pkg describe $(ghc-pkg latest tidal) | grep data-dir | cut -f2 -d' '") 0 -1)- "/BootTidal.hs")- "*Full path to BootTidal.hs (inferred by introspecting ghc-pkg package db)."+ (let ((filepath+ (cond+ ((string-equal system-type "windows-nt")+ '(("path" . "echo off && for /f %a in ('ghc-pkg latest tidal') do (for /f \"tokens=2\" %i in ('ghc-pkg describe %a ^| findstr data-dir') do (echo %i))")+ ("separator" . "\\")+ ))+ ((or (string-equal system-type "darwin") (string-equal system-type "gnu/linux"))+ '(("path" . "ghc-pkg describe $(ghc-pkg latest tidal) | grep data-dir | cut -f2 -d' '")+ ("separator" . "/")+ ))+ )+ ))+ (concat (substring (shell-command-to-string (cdr (assoc "path" filepath))) 0 -1) (cdr (assoc "separator" filepath)) "BootTidal.hs") )+ "*Full path to BootTidal.hs (inferred by introspecting ghc-pkg package db)."+) (defvar tidal-literate-p t