Add experimental motion events. Not super useful at the moment, but might be in the future.

2 files changed, 31 insertions, 1 deletions

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 0fd3d52..195e12f 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys (applyKeys) where
 
+import Control.Monad.Loops (iterateWhile)
 import Control.Monad.Fix (fix)
 import Graphics.X11.ExtraTypes.XF86;
 import Internal.KeysM
@@ -230,6 +231,19 @@ keymap = runKeys $ do
 
   bind xK_q $ do
     shiftMod $ spawn "xmonad --recompile && xmonad --restart"
+    
+    justMod $ subkeys $ do
+
+      bind xK_q $
+        (justMod -|- noMod) $ do
+          firstMotion@(x, y) <- nextMotion
+          (x', y') <- iterateWhile (==firstMotion) nextMotion
+
+          logs $ printf "Motion: (%d, %d) (%d, %d)" x y x' y'
+
+          if (x' - x) < 0
+            then mediaPrev
+            else mediaNext
 
   bind xK_r $ do
     justMod runDMenu
@@ -319,7 +333,7 @@ keymap = runKeys $ do
       -- Z is reserved to create sub keybindings to do various things.
       -- I don't really use these at the moment.
       bind xK_h $ noMod mediaPrev
-
+      bind xK_j $ noMod playPause
       bind xK_l $ noMod mediaNext
 
     -- Centers the current focused window. i.e. toggles the Zoom layout
@@ -402,6 +416,7 @@ mouseMap = runButtons $ do
             (button7, mediaNext)
             ]
 
+
       let continuous :: [(Button, X ())] -> Button -> Window -> X ()
           continuous actions button w = do
             case find ((==button) . fst) actions of
diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs
index 40becdc..e5968ff 100644
--- a/src/Internal/Submap.hs
+++ b/src/Internal/Submap.hs
@@ -2,6 +2,7 @@ module Internal.Submap (
     mapNextString,
     submapButtonsWithKey,
     nextButton,
+    nextMotion,
     module X) where
 
 import XMonad hiding (keys)
@@ -47,6 +48,20 @@ nextButton = do
 
   return ret
 
+nextMotion :: X (Int, Int)
+nextMotion = do
+  XConf { theRoot = root, display = d } <- ask
+  io $ grabPointer d root False pointerMotionMask grabModeAsync grabModeAsync 0 0 currentTime
+
+  ret <- io $ allocaXEvent $ \xEv -> do
+    maskEvent d pointerMotionMask xEv
+    MotionEvent { ev_x = x, ev_y = y } <- getEvent xEv
+    return (fromIntegral x, fromIntegral y)
+
+  io $ ungrabPointer d currentTime
+
+  return ret
+
 submapButtonsWithKey ::
     ((ButtonMask, Button) -> Window -> X ()) -> (Map (ButtonMask, Button) (Window -> X ())) -> Window -> X ()
 submapButtonsWithKey defaultAction actions window = do