Merge pull request #1072 from tidalcycles/tactus

Step-oriented functionality

.github/workflows/ci.yml

@@ -36,9 +36,6 @@ jobs:
           - ghc: 8.6.5
             cabal: 3.4.0.0
             experimental: false
-          - ghc: 8.4.4
-            cabal: 3.4.0.0
-            experimental: false
 
     continue-on-error: ${{ matrix.versions.experimental }}
     name: cabal ${{ matrix.versions.cabal }} - ghc ${{ matrix.versions.ghc }}

BootTidal.hs

@@ -3,11 +3,11 @@
 :set -XOverloadedStrings
 :set prompt ""
 
-default (Signal String, Integer, Double)
-
 -- Import all the boot functions and aliases.
 import Sound.Tidal.Boot
 
+default (Pattern String, Integer, Double)
+
 -- Create a Tidal Stream with the default settings.
 -- Use 'mkTidalWith' to customize these settings.
 tidalInst <- mkTidal

CONTRIBUTING.md

@@ -20,7 +20,7 @@ compiler/interpreter. Some resources for learning Haskell can be found here:
 The main repository is maintained on github:
   https://github.com/tidalcycles/tidal
 
-**At the time of writing, current work should target the '1.10-dev' branch. The 2.0-dev branch is for experiments towards version 2.0.**
+**At the time of writing, current work should target the 'dev' branch.**
 
 The SuperDirt repository is here:
   https://github.com/musikinformatik/SuperDirt
@@ -124,4 +124,4 @@ Push any final changes to the code, updating the following files:
 
 * [The Hackage upload page](https://hackage.haskell.org/upload) contains instructions and links for uploading a release archive. **Start by uploading a package candidate because a package release can't be changed!**
 * To distribute a package candidate for testing, find the download link for the `.tar.gz` bundle on the Hackage page for the package candidate. This candidate version can be installed with the following command: `cabal v1-install [url]` (note that at this time, [the v1 install command is necessary for installing a library from a URL](https://github.com/haskell/cabal/issues/8335)).
-* Once everyone is happy with the new version, go ahead and upload the archive as a package release and publish the release on GitHub!
+* Once everyone is happy with the new version, go ahead and upload the archive as a package release and publish the release on GitHub!

src/Sound/Tidal/Boot.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings     #-}
 
 module Sound.Tidal.Boot
   ( Tidally (..)
@@ -72,10 +72,10 @@ where
     along with this library.  If not, see <http://www.gnu.org/licenses/>.
 -}
 
-import Prelude hiding (all, (*>), (<*))
-import Sound.Tidal.Context hiding (mute, solo)
-import Sound.Tidal.ID (ID)
-import System.IO (hSetEncoding, stdout, utf8)
+import           Prelude             hiding (all, (*>), (<*))
+import           Sound.Tidal.Context
+import           Sound.Tidal.ID      (ID)
+import           System.IO           (hSetEncoding, stdout, utf8)
 
 -- | Functions using this constraint can access the in-scope Tidal instance.
 -- You must implement an instance of this in 'BootTidal.hs'. Note that GHC

src/Sound/Tidal/Context.hs

@@ -18,19 +18,20 @@ module Sound.Tidal.Context (module C) where
     along with this library.  If not, see <http://www.gnu.org/licenses/>.
 -}
 
-import Prelude hiding ((<*), (*>))
+import           Prelude                hiding ((*>), (<*))
 
-import Data.Ratio as C
+import           Data.Ratio             as C
 
-import Sound.Tidal.Stream as C
-import Sound.Tidal.Control as C
-import Sound.Tidal.Core as C
-import Sound.Tidal.Params as C
-import Sound.Tidal.ParseBP as C
-import Sound.Tidal.Pattern as C
-import Sound.Tidal.Scales as C
-import Sound.Tidal.Show as C
-import Sound.Tidal.Simple as C
-import Sound.Tidal.Transition as C
-import Sound.Tidal.UI as C
-import Sound.Tidal.Version as C
+import           Sound.Tidal.Control    as C
+import           Sound.Tidal.Core       as C
+import           Sound.Tidal.Params     as C
+import           Sound.Tidal.ParseBP    as C
+import           Sound.Tidal.Pattern    as C
+import           Sound.Tidal.Scales     as C
+import           Sound.Tidal.Show       as C
+import           Sound.Tidal.Simple     as C
+import           Sound.Tidal.Stepwise   as C
+import           Sound.Tidal.Stream     as C
+import           Sound.Tidal.Transition as C
+import           Sound.Tidal.UI         as C
+import           Sound.Tidal.Version    as C

src/Sound/Tidal/Control.hs

@@ -1,4 +1,7 @@
-{-# LANGUAGE FlexibleInstances, OverloadedStrings, FlexibleContexts, BangPatterns #-}
+{-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Sound.Tidal.Control where
 {-
@@ -21,18 +24,18 @@ module Sound.Tidal.Control where
     along with this library.  If not, see <http://www.gnu.org/licenses/>.
 -}
 
-import           Prelude hiding ((<*), (*>))
+import           Prelude                  hiding ((*>), (<*))
 
-import qualified Data.Map.Strict as Map
-import Data.Maybe (fromMaybe, isJust, fromJust)
-import Data.Ratio
+import qualified Data.Map.Strict          as Map
+import           Data.Maybe               (fromJust, fromMaybe, isJust)
+import           Data.Ratio
 
-import Sound.Tidal.Pattern
-import Sound.Tidal.Core
-import Sound.Tidal.Stream.Types (patternTimeID)
-import Sound.Tidal.UI
-import qualified Sound.Tidal.Params as P
-import Sound.Tidal.Utils
+import           Sound.Tidal.Core
+import qualified Sound.Tidal.Params       as P
+import           Sound.Tidal.Pattern
+import           Sound.Tidal.Stream.Types (patternTimeID)
+import           Sound.Tidal.UI
+import           Sound.Tidal.Utils
 
 {- | `spin` will "spin" and layer up a pattern the given number of times,
 with each successive layer offset in time by an additional @1/n@ of a cycle,
@@ -44,7 +47,7 @@ around. This function work well on multichannel systems.
 >    $ sound "drum*3 tabla:4 [arpy:2 ~ arpy] [can:2 can:3]"
 -}
 spin :: Pattern Int -> ControlPattern -> ControlPattern
-spin = tParam _spin
+spin = patternify _spin
 
 _spin :: Int -> ControlPattern -> ControlPattern
 _spin copies p =
@@ -87,13 +90,13 @@ _spin copies p =
   > d1 $ loopAt 8 $ rev $ chop 32 $ sound "bev"
 -}
 chop :: Pattern Int -> ControlPattern -> ControlPattern
-chop = tParam _chop
+chop = patternify _chop
 
 chopArc :: Arc -> Int -> [Arc]
 chopArc (Arc s e) n = map (\i -> Arc (s + (e-s)*(fromIntegral i/fromIntegral n)) (s + (e-s)*(fromIntegral (i+1) / fromIntegral n))) [0 .. n-1]
 
 _chop :: Int -> ControlPattern -> ControlPattern
-_chop n = withEvents (concatMap chopEvent)
+_chop n pat = withTactus (* toRational n) $ withEvents (concatMap chopEvent) pat
   where -- for each part,
         chopEvent :: Event ValueMap -> [Event ValueMap]
         chopEvent (Event c (Just w) p' v) = map (chomp c v (length $ chopArc w n)) $ arcs w p'
@@ -152,10 +155,10 @@ and manipulates those parts by reversing and rotating the loops:
 -}
 
 striate :: Pattern Int -> ControlPattern -> ControlPattern
-striate = tParam _striate
+striate = patternify _striate
 
 _striate :: Int -> ControlPattern -> ControlPattern
-_striate n p = fastcat $ map offset [0 .. n-1]
+_striate n p = keepTactus (withTactus (* toRational n) p) $ fastcat $ map offset [0 .. n-1]
   where offset i = mergePlayRange (fromIntegral i / fromIntegral n, fromIntegral (i+1) / fromIntegral n) <$> p
 
 mergePlayRange :: (Double, Double) -> ValueMap -> ValueMap
@@ -180,7 +183,7 @@ internally. This means that you probably shouldn't also specify `begin` or
 `end`.
 -}
 striateBy :: Pattern Int -> Pattern Double -> ControlPattern -> ControlPattern
-striateBy = tParam2 _striateBy
+striateBy = patternify2 _striateBy
 
 -- | DEPRECATED, use 'striateBy' instead.
 striate' :: Pattern Int -> Pattern Double -> ControlPattern -> ControlPattern
@@ -201,7 +204,7 @@ each sample is chopped into:
 -}
 
 gap :: Pattern Int -> ControlPattern -> ControlPattern
-gap = tParam _gap
+gap = patternify _gap
 
 _gap :: Int -> ControlPattern -> ControlPattern
 _gap n p = _fast (toRational n) (cat [pure 1, silence]) |>| _chop n p
@@ -336,7 +339,7 @@ _slice n i p =
   > d1 $ fast 4 $ randslice 32 $ sound "bev"
 -}
 randslice :: Pattern Int -> ControlPattern -> ControlPattern
-randslice = tParam $ \n p -> innerJoin $ (\i -> _slice n i p) <$> _irand n
+randslice = patternify $ \n p -> keepTactus (withTactus (* (toRational n)) $ p) $ innerJoin $ (\i -> _slice n i p) <$> _irand n
 
 _splice :: Int -> Pattern Int -> ControlPattern -> Pattern (Map.Map String Value)
 _splice bits ipat pat = withEvent f (slice (pure bits) ipat pat) # P.unit (pure "c")
@@ -441,7 +444,7 @@ smash' n xs p = slowcat $ map (`slow` p') xs
     > d1 $ echo 4 (-0.2) 0.5 $ sound "bd sn"
 -}
 echo :: Pattern Integer -> Pattern Rational -> Pattern Double -> ControlPattern -> ControlPattern
-echo = tParam3 _echo
+echo = patternify3' _echo
 
 _echo :: Integer -> Rational -> Double -> ControlPattern -> ControlPattern
 _echo count time feedback p = _echoWith count time (|* P.gain (pure $ feedback)) p
@@ -470,7 +473,7 @@ _echoWith count time f p | count <= 1 = p
 
 -- | DEPRECATED, use 'echo' instead
 stut :: Pattern Integer -> Pattern Double -> Pattern Rational -> ControlPattern -> ControlPattern
-stut = tParam3 _stut
+stut = patternify3' _stut
 
 _stut :: Integer -> Double -> Rational -> ControlPattern -> ControlPattern
 _stut count feedback steptime p = stack (p:map (\x -> ((x%1)*steptime) `rotR` (p |* P.gain (pure $ scalegain (fromIntegral x)))) [1..(count-1)])

src/Sound/Tidal/Core.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, BangPatterns #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 {-
     Core.hs - For functions judged to be 'core' to tidal functionality.
@@ -20,11 +20,11 @@
 
 module Sound.Tidal.Core where
 
-import           Prelude hiding ((<*), (*>))
+import           Prelude             hiding ((*>), (<*))
 
-import           Data.Fixed (mod')
-import qualified Data.Map.Strict as Map
-import           Data.Maybe (fromMaybe)
+import           Data.Fixed          (mod')
+import qualified Data.Map.Strict     as Map
+import           Data.Maybe          (fromMaybe)
 import           Sound.Tidal.Pattern
 
 -- ** Elemental patterns
@@ -37,7 +37,7 @@ import           Sound.Tidal.Pattern
   > saw = sig $ \t -> mod' (fromRational t) 1
 -}
 sig :: (Time -> a) -> Pattern a
-sig f = Pattern q
+sig f = pattern q
   where q (State (Arc s e) _)
           | s > e = []
           | otherwise = [Event (Context []) Nothing (Arc s e) (f (s+((e-s)/2)))]
@@ -266,7 +266,7 @@ listToPat = fastFromList
 -- > d1 $ n "0 ~ 2" # s "superpiano"
 fromMaybes :: [Maybe a] -> Pattern a
 fromMaybes = fastcat . map f
-  where f Nothing = silence
+  where f Nothing  = silence
         f (Just x) = pure x
 
 {-| A pattern of whole numbers from 0 to the given number, in a single cycle.
@@ -312,7 +312,8 @@ append a b = cat [a,b]
 -}
 cat :: [Pattern a] -> Pattern a
 cat [] = silence
-cat ps = Pattern q
+cat (p:[]) = p
+cat ps = pattern q
   where n = length ps
         q st = concatMap (f st) $ arcCyclesZW (arc st)
         f st a = query (withResultTime (+offset) p) $ st {arc = Arc (subtract offset (start a)) (subtract offset (stop a))}
@@ -349,7 +350,9 @@ fastappend = fastAppend
   > d1 $ fastcat [sound "bd*2 sn", sound "jvbass*3", sound "drum*2", sound "ht mt"]
 -}
 fastCat :: [Pattern a] -> Pattern a
-fastCat ps = _fast (toTime $ length ps) $ cat ps
+fastCat (p:[]) = p
+fastCat ps     = setTactus t $ _fast (toTime $ length ps) $ cat ps
+  where t = fromMaybe (toRational $ length ps) $ ((* (toRational $ length ps)) . foldl1 lcmr) <$> (sequence $ map tactus ps)
 
 -- | Alias for @fastCat@
 fastcat :: [Pattern a] -> Pattern a
@@ -371,10 +374,11 @@ fastcat = fastCat
 
 -}
 timeCat :: [(Time, Pattern a)] -> Pattern a
-timeCat tps = stack $ map (\(s,e,p) -> compressArc (Arc (s/total) (e/total)) p) $ arrange 0 tps
+timeCat ((_,p):[]) = p
+timeCat tps = setTactus total $ stack $ map (\(s,e,p) -> compressArc (Arc (s/total) (e/total)) p) $ arrange 0 $ filter (\(t, _) -> t > 0) $ tps
     where total = sum $ map fst tps
           arrange :: Time -> [(Time, Pattern a)] -> [(Time, Time, Pattern a)]
-          arrange _ [] = []
+          arrange _ []            = []
           arrange t ((t',p):tps') = (t,t+t',p) : arrange (t+t') tps'
 
 -- | Alias for @timeCat@
@@ -418,17 +422,19 @@ pattern to multiple patterns at once:
 > ] # speed "[[1 0.8], [1.5 2]*2]/3"
 -}
 stack :: [Pattern a] -> Pattern a
-stack = foldr overlay silence
+stack pats = (foldr overlay silence pats) {tactus = t}
+  where t | length pats == 0 = Nothing
+          | otherwise = foldl1 lcmr <$> (sequence $ map tactus pats)
 
 -- ** Manipulating time
 
 -- | Shifts a pattern back in time by the given amount, expressed in cycles
 (<~) :: Pattern Time -> Pattern a -> Pattern a
-(<~) = tParam rotL
+(<~) = patternify' rotL
 
 -- | Shifts a pattern forward in time by the given amount, expressed in cycles
 (~>) :: Pattern Time -> Pattern a -> Pattern a
-(~>) = tParam rotR
+(~>) = patternify' rotR
 
 {-| Slow down a pattern by the factors in the given time pattern, "squeezing"
   the pattern to fit the slot given in the time pattern. It is the slow analogue
@@ -453,7 +459,7 @@ stack = foldr overlay silence
   > d1 $ s "bd*4 bd*2 [bd bd/2]"
 -}
 slowSqueeze :: Pattern Time -> Pattern a -> Pattern a
-slowSqueeze = tParamSqueeze _slow
+slowSqueeze = patternifySqueeze _slow
 
 -- | An alias for @slow@
 sparsity :: Pattern Time -> Pattern a -> Pattern a
@@ -477,7 +483,7 @@ zoom :: (Time, Time) -> Pattern a -> Pattern a
 zoom (s,e) = zoomArc (Arc s e)
 
 zoomArc :: Arc -> Pattern a -> Pattern a
-zoomArc (Arc s e) p = splitQueries $
+zoomArc (Arc s e) p = withTactus (*d) $ splitQueries $
   withResultArc (mapCycle ((/d) . subtract s)) $ withQueryArc (mapCycle ((+s) . (*d))) p
      where d = e-s
 
@@ -488,7 +494,7 @@ zoomArc (Arc s e) p = splitQueries $
   would be empty). The factor should be at least 1.
 -}
 fastGap :: Pattern Time -> Pattern a -> Pattern a
-fastGap = tParam _fastGap
+fastGap = patternify _fastGap
 
 -- | An alias for @fastGap@
 densityGap :: Pattern Time -> Pattern a -> Pattern a
@@ -519,7 +525,7 @@ compressTo :: (Time,Time) -> Pattern a -> Pattern a
 compressTo (s,e) = compressArcTo (Arc s e)
 
 repeatCycles :: Pattern Int -> Pattern a -> Pattern a
-repeatCycles = tParam _repeatCycles
+repeatCycles = patternify _repeatCycles
 
 _repeatCycles :: Int -> Pattern a -> Pattern a
 _repeatCycles n p = cat (replicate n p)
@@ -634,10 +640,10 @@ _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 $ \(State a m) -> queryArc (maybe (pure d) (_getP d f . valueToPattern) $ Map.lookup s m) a
+_cX d f s = pattern $ \(State a m) -> queryArc (maybe (pure d) (_getP d f . valueToPattern) $ Map.lookup s m) a
 
 _cX_ :: (Value -> Maybe a) -> String -> Pattern a
-_cX_ f s = Pattern $ \(State a m) -> queryArc (maybe silence (_getP_ f . valueToPattern) $ Map.lookup s m) a
+_cX_ f s = pattern $ \(State a m) -> queryArc (maybe silence (_getP_ f . valueToPattern) $ Map.lookup s m) a
 
 cF :: Double -> String -> Pattern Double
 cF d = _cX d getF