diff --git a/src/Sound/Tidal/Core.hs b/src/Sound/Tidal/Core.hs index 1eb1b1cfa..160dfa406 100644 --- a/src/Sound/Tidal/Core.hs +++ b/src/Sound/Tidal/Core.hs @@ -179,12 +179,12 @@ a |- b = (-) <$> a <* b ( -|) :: Num a => Pattern a -> Pattern a -> Pattern a a -| b = (-) <$> 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, Moddable b) => a b -> a b -> a b +a |%| b = gmod <$> a <*> b +(|% ) :: Moddable a => Pattern a -> Pattern a -> Pattern a +a |% b = gmod <$> a <* b +( %|) :: Moddable a => Pattern a -> Pattern a -> Pattern a +a %| b = gmod <$> a *> b (|**|) :: (Applicative a, Floating b) => a b -> a b -> a b a |**| b = (**) <$> a <*> b diff --git a/src/Sound/Tidal/Pattern.hs b/src/Sound/Tidal/Pattern.hs index e7046abf2..f752f898c 100644 --- a/src/Sound/Tidal/Pattern.hs +++ b/src/Sound/Tidal/Pattern.hs @@ -40,6 +40,7 @@ import Data.List (delete, findIndex, sort) import Data.Word (Word8) import Data.Data (Data) -- toConstr import Data.Typeable (Typeable) +import Data.Fixed (mod') import Sound.Tidal.Time @@ -297,6 +298,20 @@ instance Fractional ValueMap where recip = fmap (applyFIS recip id id) fromRational r = Map.singleton "speed" $ VF (fromRational r) +class Moddable a where + gmod :: a -> a -> a + +instance Moddable Double where + gmod = mod' +instance Moddable Rational where + gmod = mod' +instance Moddable Note where + gmod (Note a) (Note b) = Note (mod' a b) +instance Moddable Int where + gmod = mod +instance Moddable ValueMap where + gmod = Map.unionWith (fNum2 mod mod') + instance Floating ValueMap where pi = noOv "pi" exp _ = noOv "exp" diff --git a/tidal-parse/src/Sound/Tidal/Parse.hs b/tidal-parse/src/Sound/Tidal/Parse.hs index 8eea4b0bb..d828154dd 100644 --- a/tidal-parse/src/Sound/Tidal/Parse.hs +++ b/tidal-parse/src/Sound/Tidal/Parse.hs @@ -523,7 +523,7 @@ numMergeOperator = $(fromHaskell "*") <|> $(fromHaskell "-") -realMergeOperator :: Real a => H (Pattern a -> Pattern a -> Pattern a) +realMergeOperator :: T.Moddable a => H (Pattern a -> Pattern a -> Pattern a) realMergeOperator = $(fromTidal "|%|") <|> $(fromTidal "|%") <|>