diff --git a/src/Sound/Tidal/Pattern.hs b/src/Sound/Tidal/Pattern.hs index 52976608..1c88f05c 100644 --- a/src/Sound/Tidal/Pattern.hs +++ b/src/Sound/Tidal/Pattern.hs @@ -249,12 +249,12 @@ innerJoin pp = setTactus (Just $ innerJoin' $ filterJust $ tactus <$> pp) $ inne where -- \| innerJoin but without tactus manipulation (to avoid recursion) innerJoin' :: Pattern (Pattern b) -> Pattern b - innerJoin' pp = pp {query = q, pureValue = Nothing} + innerJoin' pp' = pp' {query = q, pureValue = Nothing} where q st = concatMap (\(Event oc _ op v) -> mapMaybe (munge oc) $ query v st {arc = op}) - (query pp st) + (query pp' st) where munge oc (Event ic iw ip v) = do diff --git a/src/Sound/Tidal/Scales.hs b/src/Sound/Tidal/Scales.hs index 20894d73..c8a5e54c 100644 --- a/src/Sound/Tidal/Scales.hs +++ b/src/Sound/Tidal/Scales.hs @@ -1,4 +1,4 @@ -module Sound.Tidal.Scales (scale, scaleList, scaleTable, getScale) where +module Sound.Tidal.Scales (scale, scaleList, scaleTable, getScale, scaleWith, scaleWithList, raiseDegree, lowerDegree, raiseDegrees, lowerDegrees) where {- Scale.hs - Scales for TidalCycles @@ -18,10 +18,10 @@ module Sound.Tidal.Scales (scale, scaleList, scaleTable, getScale) where along with this library. If not, see . -} -import Data.Maybe -import Sound.Tidal.Core -import Sound.Tidal.Pattern -import Sound.Tidal.Utils +import Data.Maybe (fromMaybe) +import Sound.Tidal.Core (slowcat) +import Sound.Tidal.Pattern (Pattern, (<*)) +import Sound.Tidal.Utils ((!!!)) import Prelude hiding ((*>), (<*)) -- * Scale definitions @@ -352,7 +352,7 @@ uniq l = l Meant to be passed as an argument to @scaleWith@ -} raiseDegree :: (Fractional a) => Int -> [a] -> [a] -raiseDegree n (hd : []) = (hd + 1) : [] +raiseDegree _ (hd : []) = (hd + 1) : [] raiseDegree 0 (hd : tl) = (hd + 1) : tl raiseDegree n (hd : tl) = hd : (raiseDegree (n - 1) tl) raiseDegree _ [] = error "Degree is not present in the scale" @@ -361,7 +361,7 @@ raiseDegree _ [] = error "Degree is not present in the scale" Meant to be passed as an argument to @scaleWith@ -} lowerDegree :: (Fractional a) => Int -> [a] -> [a] -lowerDegree n (hd : []) = (hd - 1) : [] +lowerDegree _ (hd : []) = (hd - 1) : [] lowerDegree 0 (hd : tl) = (hd - 1) : tl lowerDegree n (hd : tl) = hd : (lowerDegree (n - 1) tl) lowerDegree _ [] = error "Degree is not present in the scale" @@ -369,7 +369,7 @@ lowerDegree _ [] = error "Degree is not present in the scale" {- Like @raiseDegree@, but raises a range of degrees instead of a single one -} raiseDegrees :: (Fractional a) => Int -> Int -> [a] -> [a] -raiseDegrees n m (hd : []) = (hd + 1) : [] +raiseDegrees _ _ (hd : []) = (hd + 1) : [] raiseDegrees 0 0 (hd : tl) = (hd + 1) : tl raiseDegrees 0 m (hd : tl) = (hd + 1) : (raiseDegrees 0 (m - 1) tl) raiseDegrees n m (hd : tl) = hd : (raiseDegrees (n - 1) (m - 1) tl) @@ -378,7 +378,7 @@ raiseDegrees _ _ [] = error "Degrees are out of the scale" {- Like @lowerDegree@, but lowers a range of degrees instead of a single one -} lowerDegrees :: (Fractional a) => Int -> Int -> [a] -> [a] -lowerDegrees n m (hd : []) = (hd - 1) : [] +lowerDegrees _ _ (hd : []) = (hd - 1) : [] lowerDegrees 0 0 (hd : tl) = (hd - 1) : tl lowerDegrees 0 m (hd : tl) = (hd - 1) : (lowerDegrees 0 (m - 1) tl) lowerDegrees n m (hd : tl) = hd : (lowerDegrees (n - 1) (m - 1) tl) diff --git a/src/Sound/Tidal/Stepwise.hs b/src/Sound/Tidal/Stepwise.hs index 4eb5bd52..91a5bc46 100644 --- a/src/Sound/Tidal/Stepwise.hs +++ b/src/Sound/Tidal/Stepwise.hs @@ -18,9 +18,9 @@ module Sound.Tidal.Stepwise where -import Data.List (sort, sortOn, transpose) -import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, mapMaybe) -import Sound.Tidal.Core +import Data.List (sort, sortOn) +import Data.Maybe (fromJust, isJust, mapMaybe) +import Sound.Tidal.Core (stack, timecat, zoompat) import Sound.Tidal.Pattern import Sound.Tidal.Utils (enumerate, nubOrd, pairs) @@ -38,7 +38,7 @@ s_patternify2 f a b p = stepJoin $ (\x y -> f x y p) <$> a <*> b stepJoin :: Pattern (Pattern a) -> Pattern a stepJoin pp = splitQueries $ Pattern q t Nothing where - q st@(State a c) = + q st@(State a _) = query ( stepcat $ retime $ @@ -79,10 +79,10 @@ stepcat pats = innerJoin $ (timecat . map snd . sortOn fst) <$> (tpat $ epats pa where -- enumerated patterns, ignoring those without tactus epats :: [Pattern a] -> [(Int, Pattern a)] - epats pats = enumerate $ filter (isJust . tactus) pats + epats = enumerate . filter (isJust . tactus) -- tpat :: [(Int, Pattern a)] -> Pattern [(Int, (Time, Pattern a))] - tpat pats = sequence $ map (\(i, pat) -> (\t -> (i, (t, pat))) <$> (fromJust $ tactus pat)) pats + tpat = mapM (\(i, pat) -> (\t -> (i, (t, pat))) <$> fromJust (tactus pat)) _steptake :: Time -> Pattern a -> Pattern a -- raise error? @@ -97,7 +97,7 @@ steptake :: Pattern Time -> Pattern a -> Pattern a steptake = s_patternify _steptake _stepdrop :: Time -> Pattern a -> Pattern a -_stepdrop n pat@(Pattern _ Nothing _) = pat +_stepdrop _ pat@(Pattern _ Nothing _) = pat _stepdrop n pat@(Pattern _ (Just tpat) _) = steptake (f <$> tpat) pat where f t diff --git a/src/Sound/Tidal/Stream/Main.hs b/src/Sound/Tidal/Stream/Main.hs index 74c07741..04a4a82e 100644 --- a/src/Sound/Tidal/Stream/Main.hs +++ b/src/Sound/Tidal/Stream/Main.hs @@ -1,15 +1,20 @@ module Sound.Tidal.Stream.Main where -import Control.Concurrent -import Control.Concurrent.MVar +import Control.Concurrent (forkIO, newMVar) import qualified Data.Map as Map import qualified Sound.Tidal.Clock as Clock import Sound.Tidal.Stream.Config + ( Config (cClockConfig, cCtrlAddr, cCtrlPort), + ) import Sound.Tidal.Stream.Listen -import Sound.Tidal.Stream.Process -import Sound.Tidal.Stream.Target -import Sound.Tidal.Stream.Types -import Sound.Tidal.Stream.UI + ( ctrlResponder, + openListener, + verbose, + ) +import Sound.Tidal.Stream.Process (doTick) +import Sound.Tidal.Stream.Target (getCXs, superdirtShape) +import Sound.Tidal.Stream.Types (OSC, Stream (..), Target) +import Sound.Tidal.Stream.UI (sendHandshakes) import Sound.Tidal.Version (tidal_status_string) import System.IO (hPutStrLn, stderr) @@ -74,4 +79,4 @@ startStream config oscmap = do return stream startMulti :: [Target] -> Config -> IO () -startMulti _ _ = hPutStrLn stderr $ "startMulti has been removed, please check the latest documentation on tidalcycles.org" +startMulti _ _ = hPutStrLn stderr "startMulti has been removed, please check the latest documentation on tidalcycles.org" diff --git a/src/Sound/Tidal/UI.hs b/src/Sound/Tidal/UI.hs index 7cf816cb..836db6ca 100644 --- a/src/Sound/Tidal/UI.hs +++ b/src/Sound/Tidal/UI.hs @@ -5,7 +5,7 @@ {- UI.hs - Tidal's main 'user interface' functions, for transforming patterns, building on the Core ones. - Copyright (C) 2020, Alex McLean and contributors + Copyright (C) 2025, Alex McLean and contributors This library is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -1469,8 +1469,9 @@ _markovPat n xi tp = beat :: Pattern Time -> Pattern Time -> Pattern a -> Pattern a beat = patternify2 $ __beat innerJoin +-- TODO it would probably be better to pass a bind here instead.. __beat :: (Pattern (Pattern a) -> Pattern a) -> Time -> Time -> Pattern a -> Pattern a -__beat join t d p = join $ (compress (s, e) . pure) <$> p +__beat usejoin t d p = usejoin $ compress (s, e) . pure <$> p where s = t' / d e = (t' + 1) / d @@ -1509,7 +1510,7 @@ __beat join t d p = join $ (compress (s, e) . pure) <$> p -- # n (run 8) -- @ mask :: Pattern Bool -> Pattern a -> Pattern a -mask b p = const <$> p <* (filterValues id b) +mask b p = const <$> p <* filterValues id b -- TODO: refactor towards union enclosingArc :: [Arc] -> Arc @@ -2062,17 +2063,17 @@ rolledBy pt = patternify rolledWith (segment 1 $ pt) rolledWith :: Ratio Integer -> Pattern a -> Pattern a rolledWith t = withEvents aux where - aux es = concatMap (steppityIn) (groupBy (\a b -> whole a == whole b) $ ((isRev t) es)) + aux es = concatMap steppityIn (groupBy (\a b -> whole a == whole b) $ isRev t es) isRev b = (\x -> if x > 0 then id else reverse) b - steppityIn xs = mapMaybe (\(n, ev) -> (timeguard n xs ev t)) $ enumerate xs + steppityIn xs = mapMaybe (\(n, ev) -> timeguard n xs ev t) $ enumerate xs timeguard _ _ ev 0 = return ev - timeguard n xs ev _ = (shiftIt n (length xs) ev) + timeguard n xs ev _ = shiftIt n (length xs) ev shiftIt n d (Event c (Just (Arc s e)) a' v) = do a'' <- subArc (Arc newS e) a' return (Event c (Just $ Arc newS e) a'' v) where newS = s + (dur * fromIntegral n) - dur = ((e - s)) / ((1 / (abs t)) * fromIntegral d) + dur = (e - s) / ((1 / abs t) * fromIntegral d) shiftIt _ _ ev = return ev {- TODO ! @@ -2122,7 +2123,7 @@ ply :: Pattern Rational -> Pattern a -> Pattern a ply = patternify' _ply _ply :: Rational -> Pattern a -> Pattern a -_ply n pat = squeezeJoin $ (_fast n . pure) <$> pat +_ply n pat = squeezeJoin $ _fast n . pure <$> pat -- | As 'ply', but applies a function each time. The applications are compounded. plyWith :: (Ord t, Num t) => Pattern t -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a @@ -2190,7 +2191,7 @@ pressBy :: Pattern Time -> Pattern a -> Pattern a pressBy = patternify' _pressBy _pressBy :: Time -> Pattern a -> Pattern a -_pressBy r pat = squeezeJoin $ (compressTo (r, 1) . pure) <$> pat +_pressBy r pat = squeezeJoin $ compressTo (r, 1) . pure <$> pat {- Uses the first (binary) pattern to switch between the following @@ -2405,7 +2406,7 @@ spreadf = spread ($) stackwith :: (Unionable a) => Pattern a -> [Pattern a] -> Pattern a stackwith p ps | null ps = silence - | otherwise = stack $ map (\(i, p') -> p' # ((fromIntegral i % l) `rotL` p)) (zip [0 :: Int ..] ps) + | otherwise = stack $ zipWith (\i p' -> p' # ((fromIntegral i % l) `rotL` p)) [0 :: Int ..] ps where l = fromIntegral $ length ps @@ -2825,7 +2826,7 @@ soak depth f pat = cat $ take depth $ iterate f pat -- | @construct n p@ breaks @p@ into pieces and then reassembles them -- so that it fits into @n@ steps. deconstruct :: Int -> Pattern String -> String -deconstruct n p = intercalate " " $ map showStep $ toList p +deconstruct n p = unwords $ map showStep $ toList p where showStep :: [String] -> String showStep [] = "~" @@ -2860,9 +2861,9 @@ bite :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a bite npat ipat pat = innerJoin $ (\n -> _bite n ipat pat) <$> npat _bite :: Int -> Pattern Int -> Pattern a -> Pattern a -_bite n ipat pat = squeezeJoin $ zoompat <$> ipat +_bite n ipat pat = squeezeJoin $ zoomslice <$> ipat where - zoompat i = zoom (i' / (fromIntegral n), (i' + 1) / (fromIntegral n)) pat + zoomslice i = zoom (i' / fromIntegral n, (i' + 1) / fromIntegral n) pat where i' = fromIntegral $ i `mod` n @@ -2871,7 +2872,7 @@ squeeze :: Pattern Int -> [Pattern a] -> Pattern a squeeze _ [] = silence squeeze ipat pats = squeezeJoin $ (pats !!!) <$> ipat -squeezeJoinUp :: Pattern (ControlPattern) -> ControlPattern +squeezeJoinUp :: Pattern ControlPattern -> ControlPattern squeezeJoinUp pp = pp {query = q, pureValue = Nothing} where q st = concatMap (f st) (query (filterDigital pp) st) @@ -2887,9 +2888,9 @@ squeezeJoinUp pp = pp {query = q, pureValue = Nothing} munge _ _ _ _ = Nothing _chew :: Int -> Pattern Int -> ControlPattern -> ControlPattern -_chew n ipat pat = (squeezeJoinUp $ zoompat <$> ipat) |/ P.speed (pure $ fromIntegral n) +_chew n ipat pat = squeezeJoinUp (zoomslice <$> ipat) |/ P.speed (pure $ fromIntegral n) where - zoompat i = zoom (i' / (fromIntegral n), (i' + 1) / (fromIntegral n)) (pat) + zoomslice i = zoom (i' / (fromIntegral n), (i' + 1) / (fromIntegral n)) (pat) where i' = fromIntegral $ i `mod` n @@ -2920,7 +2921,7 @@ binary :: Pattern Int -> Pattern Bool binary = binaryN 8 ascii :: Pattern String -> Pattern Bool -ascii p = squeezeJoin $ (listToPat . concatMap (__binary 8 . ord)) <$> p +ascii p = squeezeJoin $ listToPat . concatMap (__binary 8 . ord) <$> p -- | Given a start point and a duration (both specified in cycles), this -- generates a control pattern that makes a sound begin at the start @@ -2966,13 +2967,13 @@ chromaticiseBy n pat = innerJoin $ (\np -> _chromaticiseBy np pat) <$> n _chromaticiseBy :: (Num a, Enum a, Ord a) => a -> Pattern a -> Pattern a _chromaticiseBy n pat = squeezeJoin $ - ( \value -> + ( \val -> fastcat $ map pure ( if n >= 0 - then [value .. (value + n)] - else (reverse $ [(value + n) .. value]) + then [val .. (val + n)] + else reverse [(val + n) .. val] ) ) <$> pat