Merge pull request #1101 from sss-create/normal

backport from #1055 and #1012

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.
 
 @

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

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."