diff options
| -rw-r--r-- | lib/Phi/Widgets/Systray.hs | 56 |
1 files changed, 25 insertions, 31 deletions
diff --git a/lib/Phi/Widgets/Systray.hs b/lib/Phi/Widgets/Systray.hs index 7e7ec63..2aef713 100644 --- a/lib/Phi/Widgets/Systray.hs +++ b/lib/Phi/Widgets/Systray.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable #-} +{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances #-} module Phi.Widgets.Systray ( systray ) where @@ -35,54 +35,49 @@ import Phi.Widget import Phi.X11.Atoms -data SystrayIconState = SystrayIconState !Window !Window deriving Show +data SystrayIconState = SystrayIconState !Window !Window deriving (Show, Eq) -data SystrayState = SystrayState !Phi !Rectangle !Int !(IORef Int) ![SystrayIconState] -instance Eq SystrayState where - _ == _ = False +instance Eq Phi where + _ == _ = True + +data SystrayState = SystrayState !Phi !Rectangle !Int ![SystrayIconState] deriving Eq data Systray = Systray deriving (Show, Eq) -data SystrayMessage = AddIcon !Window !Window | RemoveIcon !Window | RenderIcon !Window !Window !Int !Int !Int !Int !Bool +data SystrayMessage = AddIcon !Window !Window | RemoveIcon !Window | RenderIcon !Window !Window !Int !Int !Int !Int deriving (Show, Typeable) -instance Widget Systray SystrayState () where +instance Widget Systray SystrayState (RenderCache Systray SystrayState) where initWidget (Systray) phi dispvar = do phi' <- dupPhi phi forkIO $ systrayRunner phi' dispvar - lastReset <- newIORef 0 - return $ SystrayState phi (head . getScreens $ dispvar) 0 lastReset [] + return $ SystrayState phi (head . getScreens $ dispvar) 0 [] - initCache _ = () + initCache _ = createRenderCache $ \Systray (SystrayState phi systrayScreen reset icons) x y w h screen -> do + when (screen == systrayScreen) $ do + forM_ (zip [0..] icons) $ \(i, SystrayIconState midParent window) -> do + let x' = x + i*(h+2) + sendMessage phi $ RenderIcon midParent window x' y h h + + setOperator OperatorClear + paint - minSize _ (SystrayState _ systrayScreen _ _ icons) height screen = case True of + minSize _ (SystrayState _ systrayScreen _ icons) height screen = case True of _ | screen == systrayScreen -> max 0 $ (length icons)*(height+2)-1 | otherwise -> 0 weight _ = 0 - render Systray (SystrayState phi systrayScreen reset lastResetRef icons) x y w h screen = do - when (screen == systrayScreen) $ do - lastReset <- liftIO $ readIORef lastResetRef - liftIO $ writeIORef lastResetRef reset - forM_ (zip [0..] icons) $ \(i, SystrayIconState midParent window) -> do - let x' = x + i*(h+2) - sendMessage phi $ RenderIcon midParent window x' y h h (lastReset /= reset) - - surface <- liftIO $ createImageSurface FormatARGB32 w h - renderWith surface $ do - setOperator OperatorClear - paint - return [(True, SurfaceSlice 0 surface)] + render = renderCached - handleMessage _ priv@(SystrayState phi screen reset lastReset icons) m = case (fromMessage m) of - Just (AddIcon midParent window) -> SystrayState phi screen reset lastReset ((SystrayIconState midParent window):icons) - Just (RemoveIcon window) -> SystrayState phi screen reset lastReset $ filter (\(SystrayIconState _ stateWindow) -> stateWindow /= window) icons + handleMessage _ priv@(SystrayState phi screen reset icons) m = case (fromMessage m) of + Just (AddIcon midParent window) -> SystrayState phi screen reset ((SystrayIconState midParent window):icons) + Just (RemoveIcon window) -> SystrayState phi screen reset $ filter (\(SystrayIconState _ stateWindow) -> stateWindow /= window) icons _ -> case (fromMessage m) of - Just ResetBackground -> SystrayState phi screen (reset+1) lastReset icons + Just ResetBackground -> SystrayState phi screen (reset+1) icons _ -> priv @@ -102,7 +97,7 @@ systrayRunner phi dispvar = do handleEvent event phi dispvar xembedWindow _ -> case (fromMessage m) of - Just (RenderIcon midParent window x y w h reset) -> do + Just (RenderIcon midParent window x y w h) -> do withDisplay dispvar $ \disp -> do liftIO $ flip catch (\_ -> return ()) $ do sync disp False @@ -118,8 +113,7 @@ systrayRunner phi dispvar = do moveResizeWindow disp window 0 0 (fromIntegral w) (fromIntegral h) sync disp False - when (resize || reset) $ - clearArea disp window 0 0 (fromIntegral w) (fromIntegral h) True + clearArea disp window 0 0 (fromIntegral w) (fromIntegral h) True sync disp False xSetErrorHandler |