aboutsummaryrefslogtreecommitdiff
path: root/src/Internal/ButtonMasks.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Internal/ButtonMasks.hs')
-rw-r--r--src/Internal/ButtonMasks.hs92
1 files changed, 92 insertions, 0 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)