{-# LANGUAGE MultiWayIf #-}
module XMonad.Util.Timer
(
startTimer
, handleTimer
, TimerId
) where
import Control.Concurrent
import Data.Unique
import XMonad
import XMonad.Prelude (listToMaybe)
type TimerId = Int
startTimer :: Rational -> X TimerId
startTimer :: Rational -> X Int
startTimer Rational
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
Int
u <- Unique -> Int
hashUnique forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Unique
newUnique
forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork forall a b. (a -> b) -> a -> b
$ do
Display
d <- String -> IO Display
openDisplay String
""
Atom
rw <- Display -> ScreenNumber -> IO Atom
rootWindow Display
d forall a b. (a -> b) -> a -> b
$ Display -> ScreenNumber
defaultScreen Display
d
Int -> IO ()
threadDelay (forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ Rational
s forall a. Num a => a -> a -> a
* Rational
1000000)
Atom
a <- Display -> String -> Bool -> IO Atom
internAtom Display
d String
"XMONAD_TIMER" Bool
False
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
e -> do
XEventPtr -> ScreenNumber -> IO ()
setEventType XEventPtr
e ScreenNumber
clientMessage
XEventPtr -> Atom -> Atom -> CInt -> Atom -> Atom -> IO ()
setClientMessageEvent XEventPtr
e Atom
rw Atom
a CInt
32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u) Atom
0
Display -> Atom -> Bool -> Atom -> XEventPtr -> IO ()
sendEvent Display
d Atom
rw Bool
False Atom
structureNotifyMask XEventPtr
e
Display -> Bool -> IO ()
sync Display
d Bool
False
forall (m :: * -> *) a. Monad m => a -> m a
return Int
u
handleTimer :: TimerId -> Event -> X (Maybe a) -> X (Maybe a)
handleTimer :: forall a. Int -> Event -> X (Maybe a) -> X (Maybe a)
handleTimer Int
ti ClientMessageEvent{ev_message_type :: Event -> Atom
ev_message_type = Atom
mt, ev_data :: Event -> [CInt]
ev_data = [CInt]
dt} X (Maybe a)
action = do
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
Atom
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Atom
internAtom Display
d String
"XMONAD_TIMER" Bool
False
if | Atom
mt forall a. Eq a => a -> a -> Bool
== Atom
a, Just CInt
dth <- forall a. [a] -> Maybe a
listToMaybe [CInt]
dt, forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
dth forall a. Eq a => a -> a -> Bool
== Int
ti -> X (Maybe a)
action
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
handleTimer Int
_ Event
_ X (Maybe a)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing