Use cached renderer for systray

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 Phi where
-instance Eq SystrayState where
+  _ == _ = True
-  _ == _ = False
+
+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 []
-    return $ SystrayState phi (head . getScreens $ dispvar) 0 lastReset []
   
-  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
     
-  minSize _ (SystrayState _ systrayScreen _ _ icons) height screen = case True of 
+    setOperator OperatorClear
+    paint
+  
+  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
+  render = renderCached
-    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)]
 
   
-  handleMessage _ priv@(SystrayState phi screen reset lastReset icons) m = case (fromMessage m) of
+  handleMessage _ priv@(SystrayState phi screen reset icons) m = case (fromMessage m) of
-    Just (AddIcon midParent window) -> SystrayState phi screen reset lastReset ((SystrayIconState midParent window):icons)
+    Just (AddIcon midParent window) -> SystrayState phi screen reset ((SystrayIconState midParent window):icons)
-    Just (RemoveIcon window) -> SystrayState phi screen reset lastReset $ filter (\(SystrayIconState _ stateWindow) -> stateWindow /= 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