Add ButtonMasks. Not function. Experimental to try and handle dealing with multiple buttons as masks.experimental_mouse_mask

3 files changed, 99 insertions, 2 deletions

diff --git a/src/Internal/ButtonMasks.hs b/src/Internal/ButtonMasks.hs
new file mode 100644
index 0000000..9f10246
--- /dev/null
+++ b/src/Internal/ButtonMasks.hs
@@ -0,0 +1,92 @@
+module Internal.ButtonMasks (withButtonMasks, buttonMask) where
+
+import Data.Monoid
+import Control.Monad (forM_)
+import XMonad
+import Data.Word
+import qualified XMonad.Util.ExtensibleState as XS
+import Data.Bits
+import Internal.Logger
+
+button13Mask :: Word32
+button13Mask = 0x01
+
+button14Mask :: Word32
+button14Mask = 0x02
+
+button15Mask :: Word32
+button15Mask = 0x04
+
+button13 :: Button
+button13 = 13
+
+button14 :: Button
+button14 = 14
+
+button15 :: Button
+button15 = 15
+
+newtype ButtonMaskState = ButtonMaskState Word32 deriving (Show, Read, Typeable)
+
+instance ExtensionClass ButtonMaskState where
+  initialValue = ButtonMaskState 0
+
+
+buttonMask :: X Word32
+buttonMask = (\(ButtonMaskState w) -> w) <$> XS.get
+
+withButtonMasks :: XConfig l -> XConfig l
+withButtonMasks xconfig =
+  xconfig {
+    startupHook = do
+      XConf { display = dpy, theRoot = rootw } <- ask
+      let grab button m =  io $ grabButton dpy button m rootw False (buttonPressMask .|. buttonReleaseMask) grabModeAsync grabModeSync none none
+
+      startupHook xconfig
+
+      ems <- extraModifiers
+      
+      forM_ [button13, button14, button15] $ \button -> do
+        forM_ ems $ \mod -> do
+          grab button mod,
+
+
+    handleEventHook = buttonMaskHook <> handleEventHook xconfig
+  }
+
+buttonMaskHook :: Event -> X All
+buttonMaskHook event = do
+  case event of
+    ButtonEvent { ev_button = b, ev_event_type = t, ev_state = st } -> do
+      logs $ "Button Event! " ++ show b
+      (ButtonMaskState mask) <- XS.get
+      logs $ "Cur state " ++ show mask
+      logs $ "ev_state " ++ show st
+
+      let mMask =
+            case b of
+              _ | b == button13 -> Just button13Mask
+              _ | b == button14 -> Just button14Mask
+              _ | b == button15 -> Just button15Mask
+              _ -> Nothing in
+          
+          case mMask of
+            Nothing -> return (All True)
+            Just mask ->
+              case t of
+                _ | t == buttonPress -> do
+                  XS.modify (\(ButtonMaskState m) -> ButtonMaskState $ mask .|. m)
+                  (ButtonMaskState mask) <- XS.get
+                  logs $ "New state " ++ show mask
+
+                  return (All False)
+
+                _ | t == buttonRelease -> do
+                  XS.modify (\(ButtonMaskState m) -> ButtonMaskState $ mask .&. (complement m))
+                  (ButtonMaskState mask) <- XS.get
+                  logs $ "New state " ++ show mask
+                  return (All False)
+
+                _ -> return (All True)
+
+    _ -> return (All True)
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 6d34c4a..20e6f15 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -54,6 +54,7 @@ import Internal.PassMenu
 import Internal.Logger
 import Internal.RebindKeys
 import Internal.Swallow
+import Internal.ButtonMasks
 import Internal.ScreenRotate (screenRotateForward, screenRotateBackward)
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
@@ -551,7 +552,10 @@ mouseMap = runButtons $ do
 
   bind button1 $ do
     justMod $ \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster
-
+    altMod $ noWindow $ do
+      m <- buttonMask
+      logs $ "Mask: " ++ show m
+ 
   bind button2 $ do
     justMod $ windows . (W.shiftMaster .) . W.focusWindow
 
diff --git a/src/Main.hs b/src/Main.hs
index 0b4a181..0269ef3 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -21,6 +21,7 @@ import Internal.Logger
 import Internal.DMenu (menuCommandString)
 import Internal.RebindKeys
 import Internal.KeysM
+import Internal.ButtonMasks
 
 import qualified XMonad as X
 import qualified XMonad.StackSet as W
@@ -37,7 +38,7 @@ main = do
   xmobar <- spawnXMobar
 
   (=<<) X.xmonad $
-    applyKeys $ ewmh $ docks $  def
+    applyKeys $ withButtonMasks $ ewmh $ docks $  def
        { terminal    = "alacritty"
        , modMask     = mod3Mask
        , borderWidth = 2