From 32a814d00f6c5167f8011cb7fa430e15478a81d2 Mon Sep 17 00:00:00 2001
From: alex <alex@slab.org>
Date: Sun, 2 Mar 2025 19:58:32 +0000
Subject: [PATCH 1/2] add polymeter

---
 tidal-core/src/Sound/Tidal/Pattern.hs       |  3 +++
 tidal-core/src/Sound/Tidal/Stepwise.hs      | 11 +++++++++--
 tidal-core/test/Sound/Tidal/StepwiseTest.hs | 10 +++++++---
 3 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/tidal-core/src/Sound/Tidal/Pattern.hs b/tidal-core/src/Sound/Tidal/Pattern.hs
index 83470a5d..f6c3e0b9 100644
--- a/tidal-core/src/Sound/Tidal/Pattern.hs
+++ b/tidal-core/src/Sound/Tidal/Pattern.hs
@@ -76,6 +76,9 @@ withStepsPat f p = p {steps = f <$> steps p}
 withSteps :: (Rational -> Rational) -> Pattern a -> Pattern a
 withSteps f p = p {steps = fmap (fmap f) $ steps p}
 
+hasSteps :: Pattern a -> Bool
+hasSteps = isJust . steps
+
 pace :: Pattern Rational -> Pattern a -> Pattern a
 pace target p@(Pattern _ (Just t) _) = setSteps (Just target) $ fast (target / t) p
 -- raise error?
diff --git a/tidal-core/src/Sound/Tidal/Stepwise.hs b/tidal-core/src/Sound/Tidal/Stepwise.hs
index ce220c2f..6326cd0d 100644
--- a/tidal-core/src/Sound/Tidal/Stepwise.hs
+++ b/tidal-core/src/Sound/Tidal/Stepwise.hs
@@ -18,14 +18,15 @@
 
 module Sound.Tidal.Stepwise where
 
+import Control.Applicative (liftA2)
 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)
 
--- _lcmsteps :: [Pattern a] -> Maybe Time
--- _lcmsteps pats = foldl1 lcmr <$> (sequence $ map steps pats)
+_lcmsteps :: [Pattern a] -> Pattern Time
+_lcmsteps pats = foldl1 (liftA2 lcmr) $ mapMaybe steps pats
 
 s_patternify :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c)
 s_patternify f (Pattern _ _ (Just a)) b = f a b
@@ -125,6 +126,12 @@ _extend factor pat = withStepsPat (_fast factor) $ _expand factor $ _fast factor
 extend :: Pattern Rational -> Pattern a -> Pattern a
 extend = s_patternify _extend
 
+polymeter :: [Pattern a] -> Pattern a
+polymeter pats = stack $ map (pace targetSteps) pats'
+  where
+    targetSteps = _lcmsteps pats'
+    pats' = filter hasSteps pats
+
 {-
 s_while :: Pattern Bool -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
 s_while patb f pat@(Pattern _ (Just t) _) = while (_steps t patb) f pat
diff --git a/tidal-core/test/Sound/Tidal/StepwiseTest.hs b/tidal-core/test/Sound/Tidal/StepwiseTest.hs
index 79b7365b..a9a82a79 100644
--- a/tidal-core/test/Sound/Tidal/StepwiseTest.hs
+++ b/tidal-core/test/Sound/Tidal/StepwiseTest.hs
@@ -12,9 +12,9 @@ import Sound.Tidal.Pattern
     fast,
     rev,
   )
-import Sound.Tidal.Stepwise (expand, stepcat, stepdrop, steptake)
+import Sound.Tidal.Stepwise (expand, polymeter, stepcat, stepdrop, steptake)
 import Sound.Tidal.UI (inv, iter, linger, segment)
-import Test.Hspec ( describe, it, shouldBe, Spec )
+import Test.Hspec (Spec, describe, it, shouldBe)
 import TestUtils (compareP, firstCycleValues)
 import Prelude hiding ((*>), (<*))
 
@@ -47,4 +47,8 @@ run =
       it "invert" $ (firstCycleValues <$> steps (inv "1 0 1" :: Pattern Bool)) `shouldBe` Just [3]
       it "chop" $ (firstCycleValues <$> steps (chop 3 $ sound "a b")) `shouldBe` Just [6]
       it "chop" $ (firstCycleValues <$> steps (striate 3 $ sound "a b")) `shouldBe` Just [6]
-
+    describe "polymeter" $ do
+      it "can repeat patterns to step count lcm" $
+        compareP (Arc 0 8) (polymeter ["a b c" :: Pattern Char, "d e"]) "{a b c, d e}%6"
+      it "can work with 3 patterns" $
+        compareP (Arc 0 8) (polymeter ["a b c" :: Pattern Char, "d e", "f g h i"]) "{a b c, d e, f g h i}%12"

From 5c3f2b3dd09efcc0316227c0393af25fdaf5f343 Mon Sep 17 00:00:00 2001
From: alex <alex@slab.org>
Date: Sun, 2 Mar 2025 19:59:06 +0000
Subject: [PATCH 2/2] pm alias for polymeter

---
 tidal-core/src/Sound/Tidal/Stepwise.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/tidal-core/src/Sound/Tidal/Stepwise.hs b/tidal-core/src/Sound/Tidal/Stepwise.hs
index 6326cd0d..107494b8 100644
--- a/tidal-core/src/Sound/Tidal/Stepwise.hs
+++ b/tidal-core/src/Sound/Tidal/Stepwise.hs
@@ -132,6 +132,9 @@ polymeter pats = stack $ map (pace targetSteps) pats'
     targetSteps = _lcmsteps pats'
     pats' = filter hasSteps pats
 
+pm :: [Pattern a] -> Pattern a
+pm = polymeter
+
 {-
 s_while :: Pattern Bool -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
 s_while patb f pat@(Pattern _ (Just t) _) = while (_steps t patb) f pat