Merge branch 'cycseq' of github.com:tidalcycles/Tidal into cycseq

tidal-core/src/Sound/Tidal/Bjorklund.hs

@@ -63,19 +63,19 @@ bjorklundOff :: (Int, Int, Int) -> [Bool]
 bjorklundOff (i,j,k) = take j $ drop (k `mod` j) $ cycle $ bjorklundNeg (i,j)
 
 _euclid :: Pattern p => Int -> Int -> p Bool
-_euclid n k = cat $ map pure $ bjorklundNeg (n,k)
+_euclid n k = unitcat $ map pure $ bjorklundNeg (n,k)
 
 euclid :: Pattern p => p Int -> p Int -> p Bool
-euclid = patternify_P_P _euclid
+euclid a b = patternify_P_P _euclid (outer a) (outer b)
 
 _euclidTo :: Pattern p => Int -> Int -> p a -> p a
-_euclidTo n k pat = fastcat $ map (bool pat silence) $ bjorklundNeg (n,k)
+_euclidTo n k pat = unitcat $ map (bool pat silence) $ bjorklundNeg (n,k)
 
 euclidTo :: Pattern p => p Int -> p Int -> p a -> p a
 euclidTo = patternify_P_P_n _euclidTo
 
 _euclidOff :: Pattern p => Int -> Int -> Int -> p Bool
-_euclidOff i j k = cat $ map pure $ bjorklundOff (i,j,k)
+_euclidOff i j k = unitcat $ map pure $ bjorklundOff (i,j,k)
 
 euclidOff :: Pattern p => p Int -> p Int -> p Int -> p Bool
 euclidOff = patternify_P_P_P _euclidOff
@@ -84,7 +84,7 @@ eoff :: Pattern p => p Int -> p Int -> p Int -> p Bool
 eoff = euclidOff
 
 _euclidOffTo :: Pattern p => Int -> Int -> Int -> p a -> p a
-_euclidOffTo i j k pat = fastcat $ map (bool pat silence) $ bjorklundOff (i,j,k)
+_euclidOffTo i j k pat = unitcat $ map (bool pat silence) $ bjorklundOff (i,j,k)
 
 euclidOffTo :: Pattern p => p Int -> p Int -> p Int -> p a -> p a
 euclidOffTo = patternify_P_P_P_n _euclidOffTo

tidal-core/src/Sound/Tidal/Compose.hs

@@ -1,14 +1,18 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE IncoherentInstances #-}
+{-# LANGUAGE MonoLocalBinds      #-}
 
 -- (c) Alex McLean and contributors 2023
 -- Shared under the terms of the GNU Public License v3.0
 
 module Sound.Tidal.Compose where
 
 import           Control.Applicative (Applicative (..))
+import           Data.Bits
+import           Data.Bool           (bool)
 import qualified Data.Map.Strict     as Map
 import           Prelude             hiding (Applicative (..))
-import           Sound.Tidal.Pattern (flexBind)
+import           Sound.Tidal.Pattern (filterJusts, flexBind)
 import           Sound.Tidal.Types
 
 -- ************************************************************ --
@@ -28,5 +32,89 @@ instance {-# OVERLAPPING #-} Unionable ValueMap where
 liftP2 :: Pattern p => (a -> b -> c) -> (p a -> p b -> p c)
 liftP2 op apat bpat = apat `flexBind` \a -> op a <$> bpat
 
+set, keep :: Pattern p => p a -> p a -> p a
+set = liftA2 (flip union)
+keep = liftA2 union
+
+keepif :: Pattern p => p a -> p Bool -> p a
+keepif pata patb = filterJusts $ liftA2 (\a b -> bool Nothing (Just a) b) pata patb
+
+_add, _sub, _mul :: (Pattern p, Num a) => p a -> p a -> p a
+_add = liftA2 (Prelude.+)
+_sub = liftA2 (Prelude.-)
+_mul = liftA2 (Prelude.*)
+
+_div :: (Pattern p, Fractional a) => p a -> p a -> p a
+_div = liftA2 (Prelude./)
+
+_mod, _pow :: (Pattern p, Integral a) => p a -> p a -> p a
+_mod = liftA2 mod
+_pow = liftA2 (Prelude.^)
+
+_powf :: (Pattern p, Floating a) => p a -> p a -> p a
+_powf = liftA2 (Prelude.**)
+
+_concat :: Pattern p => p String -> p String -> p String
+_concat = liftA2 (Prelude.++)
+
+_band, _bor, _bxor :: (Pattern p, Bits a) => p a -> p a -> p a
+_band = liftA2 (.&.)
+_bor = liftA2 (.|.)
+_bxor = liftA2 (.^.)
+
+_bshiftl, _bshiftr :: (Pattern p, Bits a) => p a -> p Int -> p a
+_bshiftl = liftA2 (.<<.)
+_bshiftr = liftA2 (.>>.)
+
+_lt, _gt, _lte, _gte :: (Pattern p, Ord a) => p a -> p a -> p Bool
+_lt = liftA2 (Prelude.<)
+_gt = liftA2 (Prelude.>)
+_lte = liftA2 (Prelude.<=)
+_gte = liftA2 (Prelude.>=)
+
+_eq, _ne :: (Pattern p, Eq a) => p a -> p a -> p Bool
+_eq = liftA2 (Prelude.==)
+_ne = liftA2 (Prelude./=)
+
+_and, _or :: Pattern p => p Bool -> p Bool -> p Bool
+_and = liftA2 (Prelude.&&)
+_or = liftA2 (Prelude.||)
+
 (#) :: (Pattern p, Unionable a) => p a -> p a -> p a
 (#) = liftA2 union
+
+(|=|), (|=), (=|) :: Pattern p => p a -> p a -> p a
+a |=| b = (mix a) # b
+a |= b = (inner a) # b
+a =| b = (outer a) # b
+
+(|+), (+|), (|+|) :: (Num (p a), Pattern p) => p a -> p a -> p a
+a |+ b = (inner a) + b
+a +| b = (outer a) + b
+a |+| b = (mix a) + b
+
+struct :: (Pattern p, Unionable a) => p Bool -> p a -> p a
+struct patbool pat = (outer pat) `keepif` patbool
+
+structAll :: (Pattern p, Unionable a) => p a -> p a -> p a
+structAll pata patb = (outer patb) `keep` pata
+
+mask :: (Pattern p, Unionable a) => p Bool -> p a -> p a
+mask patbool pat = (inner pat) `keepif` patbool
+
+maskAll :: (Pattern p, Unionable a) => p a -> p a -> p a
+maskAll pata patb = (inner patb) `keep` pata
+
+{-
+reset :: (Unionable a) => Signal Bool -> Signal a -> Signal a
+reset = flip keepifTrig
+
+resetAll :: (Unionable a) => Signal a -> Signal a -> Signal a
+resetAll = flip keepTrig
+
+restart :: (Unionable a) => Signal Bool -> Signal a -> Signal a
+restart = flip keepifTrigzero
+
+restartAll :: (Unionable a) => Signal a -> Signal a -> Signal a
+restartAll = flip keepTrigzero
+-}

tidal-core/src/Sound/Tidal/InstanceHacks.hs

@@ -11,6 +11,7 @@ import qualified Data.Map.Strict      as Map
 -- import           Sound.Tidal.Compose  (liftA2)
 import           Sound.Tidal.Sequence ()
 import           Sound.Tidal.Signal   ()
+import           Sound.Tidal.Span     (withSpanTime)
 import           Sound.Tidal.Types
 import           Sound.Tidal.Value
 

tidal-core/src/Sound/Tidal/Pattern.hs

@@ -3,6 +3,9 @@
 
 module Sound.Tidal.Pattern where
 
+import qualified Data.Bits
+import           Data.Char         (ord)
+import           Data.Maybe        (fromJust, isJust)
 import           Data.Ratio
 import           Prelude           hiding ((*>), (<*))
 import           Sound.Tidal.Types
@@ -57,6 +60,9 @@ infixl 4 <*, *>
 flexBind :: Pattern p => p b -> (b -> p c) -> p c
 flexBind a b = (patBind a) a b
 
+filterJusts :: Pattern p => p (Maybe a) -> p a
+filterJusts = fmap fromJust . filterValues isJust
+
 -- ************************************************************ --
 -- Transformations common to Signals and Sequences
 
@@ -311,6 +317,76 @@ _scan n = slowcat $ map _run [1 .. n]
 scan :: (Pattern p, Enum a, Num a) => p a -> p a
 scan = (>>= _run)
 
+__binary :: Data.Bits.Bits b => Int -> b -> [Bool]
+__binary n num = map (Data.Bits.testBit num) $ reverse [0 .. n-1]
+
+_binary :: (Pattern p, Data.Bits.Bits b) => Int -> b -> p Bool
+_binary n num = fastFromList $ __binary n num
+
+_binaryN :: Pattern p => Int -> p Int -> p Bool
+_binaryN n p = squeezeJoin $ _binary n <$> p
+
+binaryN :: Pattern p => p Int -> p Int -> p Bool
+binaryN n p = patternify_P_n _binaryN n p
+
+binary :: Pattern p => p Int -> p Bool
+binary = binaryN (pure 8)
+
+ascii :: Pattern p => p String -> p Bool
+ascii p = squeezeJoin $ fastFromList . concatMap (__binary 8 . ord) <$> p
+
+-- | For specifying a boolean pattern according to a list of offsets
+-- (aka inter-onset intervals).  For example `necklace 12 [4,2]` is
+-- the same as "t f f f t f t f f f t f". That is, 12 steps per cycle,
+-- with true values alternating between every 4 and every 2 steps.
+necklace :: Pattern p => Rational -> [Int] -> p Bool
+necklace perCycle xs = _slow (toRational (sum xs) / perCycle) $ fastFromList $ list xs
+  where list :: [Int] -> [Bool]
+        list []      = []
+        list (x:xs') = (True : replicate (x-1) False) ++ list xs'
+
+
+{-|
+  Treats the given signal @p@ as having @n@ chunks, and applies the function @f@ to one of those sections per cycle.
+  Running:
+   - from left to right if chunk number is positive
+   - from right to left if chunk number is negative
+
+  @
+  d1 $ chunk 4 (fast 4) $ sound "cp sn arpy [mt lt]"
+  @
+-}
+chunk :: Pattern p => p Int -> (p b -> p b) -> p b -> p b
+chunk npat f p = innerJoin $ (\n -> _chunk n f p) <$> npat
+
+_chunk :: Pattern p => Int -> (p b -> p b) -> p b -> p b
+_chunk n f p | n == 0 = p
+             | n > 0 = when (_iterBack n $ fastcat (map pure $ True:replicate (n-1) False)) f p
+             | otherwise = when (_iter (abs n) $ fastcat (map pure $ replicate (abs n-1) False ++ [True])) f p
+
+{-
+  snowball |
+  snowball takes a function that can combine patterns (like '+'),
+  a function that transforms a pattern (like 'slow'),
+  a depth, and a starting pattern,
+  it will then transform the pattern and combine it with the last transformation until the depth is reached
+  this is like putting an effect (like a filter) in the feedback of a delay line
+  each echo is more effected
+  d1 $ note (scale "hexDorian" $ snowball (+) (slow 2 . rev) 8 "0 ~ . -1 . 5 3 4 . ~ -2") # s "gtr"
+-}
+snowball :: Pattern p => Int -> (p a -> p a -> p a) -> (p a -> p a) -> p a -> p a
+snowball depth combinationFunction f signal = cat $ take depth $ scanl combinationFunction signal $ drop 1 $ iterate f signal
+
+{- @soak@ |
+    applies a function to a signal and cats the resulting signal,
+    then continues applying the function until the depth is reached
+    this can be used to create a signal that wanders away from
+    the original signal by continually adding random numbers
+    d1 $ note (scale "hexDorian" mutateBy (+ (range -1 1 $ irand 2)) 8 $ "0 1 . 2 3 4") # s "gtr"
+-}
+soak ::  Pattern p => Int -> (p a -> p a) -> p a -> p a
+soak depth f signal = cat $ take depth $ iterate f signal
+
 -- ************************************************************ --
 -- Metadata utils