diff --git a/src/Sound/Tidal/UI.hs b/src/Sound/Tidal/UI.hs index b3af7f38..a62e3643 100644 --- a/src/Sound/Tidal/UI.hs +++ b/src/Sound/Tidal/UI.hs @@ -222,6 +222,27 @@ perlin2With x y = (/2) . (+1) $ interp2 <$> xfrac <*> yfrac <*> dota <*> dotb <* perlin2 :: Pattern Double -> Pattern Double perlin2 = perlin2With (sig fromRational) +{- | Generates values in [0,1] that follows a normal (bell-curve) distribution. +One possible application is to "humanize" drums with a slight random delay: +@ +d1 $ + s "bd sn bd sn" + # nudge (segment 4 (0.01 * normal)) +@ +Implemented with the Box-Muller transform. + * the max ensures we don't calculate log 0 + * the rot in u2 ensures we don't just get the same value as u1 + * clamp the Box-Muller generated values in a [-3,3] range +-} +normal :: (Floating a, Ord a) => Pattern a +normal = do + u1 <- max 0.001 <$> rand + u2 <- rotL 1000 rand + let r1 = sqrt $ - (2 * log u1) + r2 = cos (2 * pi * u2) + clamp n = max (-3) (min 3 n) + pure $ clamp (r1 * r2 + 3) / 6 + {- | Randomly picks an element from the given list. @ diff --git a/test/Sound/Tidal/UITest.hs b/test/Sound/Tidal/UITest.hs index 71a3f098..68af5350 100644 --- a/test/Sound/Tidal/UITest.hs +++ b/test/Sound/Tidal/UITest.hs @@ -139,6 +139,18 @@ run = Event (Context [((1,1),(3,1))]) Nothing (Arc 0 0.5) (6 :: Int), Event (Context [((4,1),(5,1))]) Nothing (Arc 0.5 1) (0 :: Int) ] + describe "normal" $ do + it "produces values within [0,1] in a bell curve" $ do + it "at the start of a cycle" $ + queryArc normal (Arc 0 0.1) `shouldBe` + [Event (Context []) Nothing (Arc 0 0.1) (0.4614205864457064 :: Double)] + it "at 1/4 of a cycle" $ + queryArc normal (Arc 0.25 0.25) `shouldBe` + [Event (Context []) Nothing (Arc 0.25 0.25) (0.5 :: Double)] + it "at 3/4 of a cycle" $ + queryArc normal (Arc 0.75 0.75) `shouldBe` + [Event (Context []) Nothing (Arc 0.75 0.75) (0.5 :: Double)] + describe "range" $ do describe "scales a pattern to the supplied range" $ do describe "from 3 to 4" $ do diff --git a/tidal.el b/tidal.el index 6497b209..e7e75f4e 100644 --- a/tidal.el +++ b/tidal.el @@ -240,9 +240,9 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" ;; Generate the functions `tidal-run-d1' and `tidal-stop-d1' (tidal-create-runner "d1") -;; This generates tidal-run-* and tidal-stop-* functions for d1 to d9. +;; This generates tidal-run-* and tidal-stop-* functions for d1 to d10. (mapc #'tidal-create-runner - '("d1" "d2" "d3" "d4" "d5" "d6" "d7" "d8" "d9")) + '("d1" "d2" "d3" "d4" "d5" "d6" "d7" "d8" "d9" "d10")) (defun tidal-run-region () "Place the region in a do block and compile." @@ -264,6 +264,11 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (interactive) (tidal-send-string "main")) +(defun tidal-hush () + "Stop all the patterns currently running." + (interactive) + (tidal-send-string "hush")) + (defun tidal-interrupt-haskell () "Interrupt running process." (interactive) @@ -287,6 +292,7 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (define-key map [?\C-c ?\C-l] 'tidal-load-buffer) (define-key map [?\C-c ?\C-i] 'tidal-interrupt-haskell) (define-key map [?\C-c ?\C-m] 'tidal-run-main) + (define-key map [?\C-c ?\C-h] 'tidal-hush) (define-key map [?\C-c ?\C-1] 'tidal-run-d1) (define-key map [?\C-c ?\C-2] 'tidal-run-d2) (define-key map [?\C-c ?\C-3] 'tidal-run-d3) @@ -296,6 +302,7 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (define-key map [?\C-c ?\C-7] 'tidal-run-d7) (define-key map [?\C-c ?\C-8] 'tidal-run-d8) (define-key map [?\C-c ?\C-9] 'tidal-run-d9) + (define-key map [?\C-c ?\C-0] 'tidal-run-d10) (define-key map [?\C-v ?\C-1] 'tidal-stop-d1) (define-key map [?\C-v ?\C-2] 'tidal-stop-d2) (define-key map [?\C-v ?\C-3] 'tidal-stop-d3) @@ -304,7 +311,8 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (define-key map [?\C-v ?\C-6] 'tidal-stop-d6) (define-key map [?\C-v ?\C-7] 'tidal-stop-d7) (define-key map [?\C-v ?\C-8] 'tidal-stop-d8) - (define-key map [?\C-v ?\C-9] 'tidal-stop-d9)) + (define-key map [?\C-v ?\C-9] 'tidal-stop-d9) + (define-key map [?\C-c ?\C-0] 'tidal-stop-d10)) (defun tidal-turn-on-keybindings () "Haskell Tidal keybindings in the local map." @@ -318,6 +326,7 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (local-set-key [?\C-c ?\C-l] 'tidal-load-buffer) (local-set-key [?\C-c ?\C-i] 'tidal-interrupt-haskell) (local-set-key [?\C-c ?\C-m] 'tidal-run-main) + (local-set-key [?\C-c ?\C-h] 'tidal-hush) (local-set-key [?\C-c ?\C-1] 'tidal-run-d1) (local-set-key [?\C-c ?\C-2] 'tidal-run-d2) (local-set-key [?\C-c ?\C-3] 'tidal-run-d3) @@ -327,6 +336,7 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (local-set-key [?\C-c ?\C-7] 'tidal-run-d7) (local-set-key [?\C-c ?\C-8] 'tidal-run-d8) (local-set-key [?\C-c ?\C-9] 'tidal-run-d9) + (local-set-key [?\C-c ?\C-0] 'tidal-run-d10) (local-set-key [?\C-v ?\C-1] 'tidal-stop-d1) (local-set-key [?\C-v ?\C-2] 'tidal-stop-d2) (local-set-key [?\C-v ?\C-3] 'tidal-stop-d3) @@ -335,7 +345,8 @@ Two functions will be created, `tidal-run-NAME' and `tidal-stop-NAME'" (local-set-key [?\C-v ?\C-6] 'tidal-stop-d6) (local-set-key [?\C-v ?\C-7] 'tidal-stop-d7) (local-set-key [?\C-v ?\C-8] 'tidal-stop-d8) - (local-set-key [?\C-v ?\C-9] 'tidal-stop-d9)) + (local-set-key [?\C-v ?\C-9] 'tidal-stop-d9) + (local-set-key [?\C-v ?\C-0] 'tidal-stop-d10))) (defun tidal-mode-menu (map) "Haskell Tidal menu MAP."