module WildBind.X11.Internal.NotificationDebouncer
( Debouncer
, withDebouncer
, notify
, xEventMask
, isDebouncedEvent
) where
import Control.Exception (bracket)
import qualified Control.FoldDebounce as Fdeb
import qualified Graphics.X11.Xlib as Xlib
import qualified Graphics.X11.Xlib.Extras as XlibE
data Debouncer
= Debouncer
{ Debouncer -> Trigger () ()
ndTrigger :: Fdeb.Trigger () ()
, Debouncer -> Atom
ndMessageType :: Xlib.Atom
}
withDebouncer :: Xlib.Display -> (Debouncer -> IO a) -> IO a
withDebouncer :: forall a. Display -> (Debouncer -> IO a) -> IO a
withDebouncer Display
disp Debouncer -> IO a
action = do
Atom
mtype <- Display -> String -> Bool -> IO Atom
Xlib.internAtom Display
disp String
"_WILDBIND_NOTIFY_CHANGE" Bool
False
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Display -> Atom -> IO (Trigger () ())
newTrigger Display
disp Atom
mtype) (forall i o. Trigger i o -> IO ()
Fdeb.close) forall a b. (a -> b) -> a -> b
$ \Trigger () ()
trigger -> Debouncer -> IO a
action (Trigger () () -> Atom -> Debouncer
Debouncer Trigger () ()
trigger Atom
mtype)
notify :: Debouncer -> IO ()
notify :: Debouncer -> IO ()
notify Debouncer
deb = forall i o. Trigger i o -> i -> IO ()
Fdeb.send (Debouncer -> Trigger () ()
ndTrigger Debouncer
deb) ()
debounceDelay :: Int
debounceDelay :: Int
debounceDelay = Int
200000
newTrigger :: Xlib.Display -> Xlib.Atom -> IO (Fdeb.Trigger () ())
newTrigger :: Display -> Atom -> IO (Trigger () ())
newTrigger Display
disp Atom
mtype = forall i o. Args i o -> Opts i o -> IO (Trigger i o)
Fdeb.new (forall i. IO () -> Args i ()
Fdeb.forVoid forall a b. (a -> b) -> a -> b
$ Display -> Atom -> IO ()
sendClientMessage Display
disp Atom
mtype)
forall a. Default a => a
Fdeb.def { delay :: Int
Fdeb.delay = Int
debounceDelay, alwaysResetTimer :: Bool
Fdeb.alwaysResetTimer = Bool
True }
xEventMask :: Xlib.EventMask
xEventMask :: Atom
xEventMask = Atom
Xlib.substructureNotifyMask
sendClientMessage :: Xlib.Display -> Xlib.Atom -> IO ()
sendClientMessage :: Display -> Atom -> IO ()
sendClientMessage Display
disp Atom
mtype = forall a. (XEventPtr -> IO a) -> IO a
Xlib.allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
xev -> do
let root_win :: Atom
root_win = Display -> Atom
Xlib.defaultRootWindow Display
disp
XEventPtr -> EventType -> IO ()
XlibE.setEventType XEventPtr
xev EventType
Xlib.clientMessage
XEventPtr -> Atom -> Atom -> CInt -> Atom -> Atom -> IO ()
XlibE.setClientMessageEvent XEventPtr
xev Atom
root_win Atom
mtype CInt
8 Atom
0 Atom
0
Display -> Atom -> Bool -> Atom -> XEventPtr -> IO ()
Xlib.sendEvent Display
disp Atom
root_win Bool
False Atom
xEventMask XEventPtr
xev
Display -> IO ()
Xlib.flush Display
disp
isDebouncedEvent :: Debouncer -> Xlib.XEventPtr -> IO Bool
isDebouncedEvent :: Debouncer -> XEventPtr -> IO Bool
isDebouncedEvent Debouncer
deb XEventPtr
xev = do
Event
ev <- XEventPtr -> IO Event
XlibE.getEvent XEventPtr
xev
let exp_type :: Atom
exp_type = Debouncer -> Atom
ndMessageType Debouncer
deb
case Event
ev of
XlibE.ClientMessageEvent EventType
_ CULong
_ Bool
_ Display
_ Atom
_ Atom
got_type [CInt]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (Atom
got_type forall a. Eq a => a -> a -> Bool
== Atom
exp_type)
Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False