Add rolled function with variants

src/Sound/Tidal/UI.hs

@@ -25,8 +25,14 @@ import           Prelude hiding ((<*), (*>))
 
 import           Data.Char (digitToInt, isDigit, ord)
 import           Data.Bits (testBit, Bits, xor, shiftL, shiftR)
+
+-- import           System.Random (randoms, mkStdGen)
+-- import           Control.Monad.ST
+-- import           Control.Monad.Primitive (PrimState, PrimMonad)
+-- import qualified Data.Vector as V
+-- import           Data.Word (Word32)
+import           Data.Ratio ((%), Ratio)
 import           Data.Fixed (mod')
-import           Data.Ratio ((%))
 import           Data.List (sort, sortOn, findIndices, elemIndex, groupBy, transpose, intercalate, findIndex)
 import           Data.Maybe (isJust, fromJust, fromMaybe, mapMaybe)
 import qualified Data.Text as T
@@ -1439,6 +1445,40 @@ _arp name p = arpWith f p
         thumbup xs = concatMap (\x -> [thumb,x]) $ tail xs
           where thumb = head xs
 
+{- | `rolled` plays each note of a chord quickly in order, as opposed to simultaneously; to give a chord a harp-like effect.
+This will played from the lowest note to the highest note of the chord
+@
+rolled $ n "c'maj'4" # s "superpiano"
+@
+
+
+And you can use `rolledBy` or `rolledBy'` to specify the length of the roll. The value in the passed pattern
+is the divisor of the cycle length. A negative value will play the arpeggio in reverse order.
+
+@
+rolledBy "<1 -0.5 0.25 -0.125>" $ note "c'maj9" # s "superpiano"
+@
+-}
+
+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))
+               isRev b = (\x -> if x > 0 then id else reverse ) b 
+               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)
+               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)
+               shiftIt _ _ ev =  return ev
+
+rolledBy :: Pattern (Ratio Integer) -> Pattern a -> Pattern a
+rolledBy pt = tParam rolledWith (segment 1 $ pt)
+
+rolled :: Pattern a -> Pattern a
+rolled = rolledBy (1/4)
 
 {- TODO !
 

test/Sound/Tidal/UITest.hs

@@ -53,6 +53,44 @@ run =
           ("0*4" :: Pattern Double)
       -}
 
+    describe "rolledBy" $ do
+      it "shifts each start of events in a list correctly" $ do
+        let
+          overTimeSpan = (Arc 0 1)
+          testMe = rolledBy "0.5" $ n ("[0,1,2,3]")
+          expectedResult = n "[0, ~ 1@7, ~@2 2@6, ~@3 3@5]"
+          in
+            compareP overTimeSpan testMe expectedResult
+      it "shifts each start of events in a list correctly in reverse order" $ do
+        let
+          overTimeSpan = (Arc 0 1)
+          testMe = rolledBy "-0.5" $ n ("[0,1,2,3]")
+          expectedResult = n "[3, ~ 2@7, ~@2 1@6, ~@3 0@5]"
+          in
+            compareP overTimeSpan testMe expectedResult
+      it "trims the result pattern if it becomes larger than the original pattern" $ do
+        let
+          overTimeSpan = (Arc 0  1)
+          testMe = rolledBy "1.5" $ n ("[0,1,2]")
+          expectedResult = n "[0, ~ 1]"
+          in
+            compareP overTimeSpan testMe expectedResult
+      it "does nothing for continous functions" $ do
+        let
+          overTimeSpan = (Arc 0  1)
+          testMe = n (rolledBy "0.25" (irand 0) |+ "[0,12]")
+          expectedResult = n (irand 0) |+ n "[0, 12]"
+          in
+            compareP overTimeSpan testMe expectedResult
+      it "does nothing when passing zero as time value" $ do
+        let
+          overTimeSpan = (Arc 0  1)
+          testMe = n (rolledBy "0" "[0,1,2,3]")
+          expectedResult = n "[0,1,2,3]"
+          in
+            compareP overTimeSpan testMe expectedResult
+
+
     describe "sometimesBy" $ do
       it "does nothing when set at 0% probability" $ do
         let