blob: 9f10246b50da63d0c4f43bd051571be9fd0d65a3 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
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)
|
