diff options
Diffstat (limited to 'src/Internal/ButtonMasks.hs')
| -rw-r--r-- | src/Internal/ButtonMasks.hs | 92 |
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) |