Make render function return cachable surface slices

7 files changed, 232 insertions, 159 deletions

diff --git a/lib/Phi/Border.hs b/lib/Phi/Border.hs
index c9b582e..c6e7531 100644
--- a/lib/Phi/Border.hs
+++ b/lib/Phi/Border.hs
@@ -53,19 +53,21 @@ defaultBorderConfig = BorderConfig { margin = simpleBorderWidth 0
                                    , borderWeight = 1
                                    }
 
-data Border w d = (Widget w d) => Border !BorderConfig !w
-deriving instance Show (Border w d)
-deriving instance Eq (Border w d)
+data Border w s c = (Widget w s c) => Border !BorderConfig !w
+deriving instance Show (Border w s c)
+deriving instance Eq (Border w s c)
 
-instance Eq d => Widget (Border w d) d where
+data BorderCache w s c = (Widget w s c) => BorderCache !c
+
+instance Eq s => Widget (Border w s c) s (BorderCache w s c) where
   initWidget (Border _ w) = initWidget w
   
-  minSize (Border config w) d height screen =
+  minSize (Border config w) s height screen =
     case True of
       _ | childSize == 0 -> 0
         | otherwise -> max (borderH m+2*(bw+cr)) (childSize + borderH p + 2*bw + borderH m)
     where
-      childSize = minSize w d height' screen
+      childSize = minSize w s height' screen
       
       m = margin config
       bw = borderWidth config
@@ -75,9 +77,9 @@ instance Eq d => Widget (Border w d) d where
   
   weight (Border config _) = borderWeight config
   
-  layout (Border config w) d width height screen = case True of
-    _ | width' > 0 -> layout w d width' height' screen
-      | otherwise -> d
+  layout (Border config w) s width height screen = case True of
+    _ | width' > 0 -> layout w s width' height' screen
+      | otherwise -> s
     where
       m = margin config
       bw = borderWidth config
@@ -86,18 +88,49 @@ instance Eq d => Widget (Border w d) d where
       width' = width - borderH m - 2*bw - borderH p
       height' = height - borderV m - 2*bw - borderV p
 
-  render (Border config w) d x y width height screen = when (width > borderH m - 2*bw - borderH p) $ do
-    drawBorder config 0 0 width height
-    clip
-    translate (fromIntegral dx) (fromIntegral dy)
-    render w d (x+dx) (y+dy) width' height' screen
-    return ()
+  render (Border config w) s x y width height screen = case () of 
+    _ | (width > borderH m - 2*bw - borderH p) -> do
+      border <- createImageSurface FormatARGB32 width height
+      renderWith border $ do
+        setOperator OperatorClear
+        paint
+        setOperator OperatorOver
+        drawBorder config 0 0 width height
+      surfaces <- render w s (x+dx) (y+dy) width' height' screen
+      let surfaces' = (True, 0, Nothing):(map (\(updated, SurfaceSlice x surf) -> (updated, x+dx, Just surf)) surfaces)++[(True, width-rightWidth, Nothing)]
+          surfacesWidths = zipWith (\(updated, x, surf) (_, x', _) -> (updated, x, x'-x, surf)) surfaces' (tail surfaces' ++ [(False, width, Nothing)])
+      forM surfacesWidths $ \(updated, x, surfWidth, surf) -> do
+        surf' <- createImageSurface FormatARGB32  surfWidth height
+        renderWith surf' $ do
+          setOperator OperatorClear
+          paint
+          setOperator OperatorOver
+          
+          save
+          translate (fromIntegral (-x)) 0
+          withPatternForSurface border setSource
+          paint
+          restore
+          
+          case surf of
+            Just surface -> do
+              translate 0 (fromIntegral dy)
+              withPatternForSurface surface setSource
+              paint
+            Nothing -> return ()
+          
+        return (updated, SurfaceSlice x surf')
+      | otherwise -> do
+      surface <- createImageSurface FormatARGB32 width height
+      return [(True, SurfaceSlice 0 surface)]
     where
       m = margin config
       bw = borderWidth config
       p = padding config
       
-      dx = borderLeft m + bw + borderLeft p
+      leftWidth = borderLeft m + bw + borderLeft p
+      rightWidth = borderRight m + bw + borderRight p
+      dx = leftWidth
       dy = borderTop m + bw + borderTop p
       width' = width - borderH m - 2*bw - borderH p
       height' = height - borderV m - 2*bw - borderV p
@@ -139,5 +172,5 @@ roundRectangle x y width height radius = do
   arc (x + radius) (y + radius) radius  pi (pi*3/2)
   closePath
 
-border :: (Widget w d) => BorderConfig -> w -> Border w d
+border :: (Widget w s c) => BorderConfig -> w -> Border w s c
 border = Border
diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs
index 2b031d9..f265c62 100644
--- a/lib/Phi/Widget.hs
+++ b/lib/Phi/Widget.hs
@@ -6,6 +6,7 @@ module Phi.Widget ( Display(..)
                   , getScreenWindows
                   , getScreens
                   , unionArea
+                  , SurfaceSlice(..)
                   , Widget(..)
                   , CompoundWidget
                   , (<~>)
@@ -20,8 +21,6 @@ import Control.Concurrent.MVar
 import Control.Monad
 import Control.Monad.IO.Class
 
-import Data.Traversable hiding (forM)
-
 import qualified Graphics.X11.Xlib as Xlib
 import Graphics.Rendering.Cairo
 
@@ -64,20 +63,22 @@ unionArea a b = fromIntegral $ uw*uh
     by2 = by1 + fromIntegral bh
 
 
-class (Show a, Eq a, Eq d) => Widget a d | a -> d where
-  initWidget :: a -> Phi -> Display -> IO d
+data SurfaceSlice = SurfaceSlice !Int !Surface
+
+class (Show a, Eq a, Eq s) => Widget a s c | a -> s, a -> c where
+  initWidget :: a -> Phi -> Display -> IO s
   
-  minSize :: a -> d -> Int -> Xlib.Rectangle -> Int
+  minSize :: a -> s -> Int -> Xlib.Rectangle -> Int
   
   weight :: a -> Float
   weight _ = 0
 
-  layout :: a -> d -> Int -> Int -> Xlib.Rectangle -> d
+  layout :: a -> s -> Int -> Int -> Xlib.Rectangle -> s
   layout _ priv _ _ _ = priv
   
-  render :: a -> d -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> Render ()
+  render :: a -> s -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> IO [(Bool, SurfaceSlice)]
   
-  handleMessage :: a -> d -> Message -> d
+  handleMessage :: a -> s -> Message -> s
   handleMessage _ priv _ = priv
 
 {-createStateRender :: Widget a d => CacheArrow (Kleisli IO) (a, d, Int, Int, Int, Int, Xlib.Rectangle) Surface
@@ -90,57 +91,64 @@ createStateRender = lift . Kleisli $ \(widget, state, x, y, w, h, screen) -> do
     render widget state x y w h screen
   return surface-}
 
-data CompoundWidget a da b db = (Widget a da, Widget b db) => CompoundWidget !a !b
-deriving instance Eq (CompoundWidget a da b db)
-deriving instance Show (CompoundWidget a da b db)
+data CompoundWidget a sa ca b sb cb = (Widget a sa ca, Widget b sb cb) => CompoundWidget !a !b
+deriving instance Eq (CompoundWidget a sa ca b sb cb)
+deriving instance Show (CompoundWidget a sa ca b sb cb)
+
+data CompoundState a sa ca b sb cb = (Widget a sa ca, Widget b sb cb) => CompoundState !sa !sb !Int
+deriving instance Eq (CompoundState a sa ca b sb cb)
 
-data CompoundState a da b db = (Widget a da, Widget b db) => CompoundState !da !db !Int
-deriving instance Eq (CompoundState a da b db)
+data CompoundCache a sa ca b sb cb = (Widget a sa ca, Widget b sb cb) => CompoundCache !ca !cb
 
-instance Widget (CompoundWidget a da b db) (CompoundState a da b db) where
+
+instance Widget (CompoundWidget a sa ca b sb cb) (CompoundState a sa ca b sb cb) (CompoundCache a sa ca b sb cb) where
   initWidget (CompoundWidget a b) phi disp = liftM3 CompoundState (initWidget a phi disp) (initWidget b phi disp) (return 0)
   
   minSize (CompoundWidget a b) (CompoundState da db _) height screen = minSize a da height screen + minSize b db height screen
   
   weight (CompoundWidget a b) = weight' a + weight' b
 
-  layout c@(CompoundWidget a b) d@(CompoundState da db _) width height screen = CompoundState da' db' xb
+  layout c@(CompoundWidget a b) s@(CompoundState sa sb _) width height screen = CompoundState sa' sb' xb
     where
-      sizesum = minSize c d height screen
+      sizesum = minSize c s height screen
       wsum = let wsum = weight c
              in if wsum > 0 then wsum else 1
     
       surplus = width - sizesum
       
-      (xb, da') = layoutWidget a da
-      (_, db') = layoutWidget b db
+      (xb, sa') = layoutWidget a sa
+      (_, sb') = layoutWidget b sb
       
-      layoutWidget w priv = let wWidth = floor $ (fromIntegral $ minSize w priv height screen) + (fromIntegral surplus)*(weight' w)/wsum
-                            in (wWidth, layout w priv wWidth height screen)
+      layoutWidget w s = let wWidth = floor $ (fromIntegral $ minSize w s height screen) + (fromIntegral surplus)*(weight' w)/wsum
+                            in (wWidth, layout w s wWidth height screen)
   
-  render (CompoundWidget a b) (CompoundState da db xb) x y w h screen = do
-    save
-    render a da x y xb h screen
-    restore
-    translate (fromIntegral xb) 0
-    render b db (x+xb) y (w-xb) h screen
+  render (CompoundWidget a b) (CompoundState sa sb xb) x y w h screen = do
+    surfacea <- render a sa x y xb h screen
+    surfaceb <- render b sb (x+xb) y (w-xb) h screen
+    return $ surfacea ++ map (\(updated, SurfaceSlice x surface) -> (updated, SurfaceSlice (x+xb) surface)) surfaceb
     
-  handleMessage (CompoundWidget a b) (CompoundState da db xb) message = CompoundState (handleMessage a da message) (handleMessage b db message) xb
+  handleMessage (CompoundWidget a b) (CompoundState sa sb xb) message = CompoundState (handleMessage a sa message) (handleMessage b sb message) xb
 
-weight' :: (Widget a da) => a -> Float
+weight' :: (Widget a sa ca) => a -> Float
 weight' = max 0 . weight
 
-(<~>) :: (Widget a da, Widget b db) => a -> b -> CompoundWidget a da b db
+(<~>) :: (Widget a sa ca, Widget b sb cb) => a -> b -> CompoundWidget a sa ca b sb cb
 a <~> b = CompoundWidget a b
 
 data Separator = Separator !Int !Float deriving (Show, Eq)
 
-instance Widget Separator () where
+instance Widget Separator () () where
   initWidget _ _ _ = return ()
   
   minSize (Separator s _) _ _ _ = s
   weight (Separator _ w) = w
-  render _ _ _ _ _ _ _ = return ()
+  render _ _ _ _ width height _ = do
+    surface <- createImageSurface FormatARGB32 width height
+    renderWith surface $ do
+      setOperator OperatorClear
+      paint
+    return [(True, SurfaceSlice 0 surface)]
+
 
 separator :: Int -> Float -> Separator
 separator = Separator
diff --git a/lib/Phi/Widgets/AlphaBox.hs b/lib/Phi/Widgets/AlphaBox.hs
index eacda5a..cd540e3 100644
--- a/lib/Phi/Widgets/AlphaBox.hs
+++ b/lib/Phi/Widgets/AlphaBox.hs
@@ -12,11 +12,11 @@ import Control.Monad
 import Graphics.Rendering.Cairo
 
 
-data AlphaBox w d = (Widget w d) => AlphaBox !Double !w
-deriving instance Show (AlphaBox w d)
-deriving instance Eq (AlphaBox w d)
+data AlphaBox w s c = (Widget w s c) => AlphaBox !Double !w
+deriving instance Show (AlphaBox w s c)
+deriving instance Eq (AlphaBox w s c)
 
-instance Eq d => Widget (AlphaBox w d) d where
+instance Eq s => Widget (AlphaBox w s c) s () where
   initWidget (AlphaBox _ w) = initWidget w
   
   minSize (AlphaBox _ w) = minSize w
@@ -25,21 +25,25 @@ instance Eq d => Widget (AlphaBox w d) d where
   
   layout (AlphaBox _ w) = layout w
 
-  render (AlphaBox alpha w) d x y width height screen = do
-    renderWithSimilarSurface ContentColorAlpha width height $ \surface -> do
-      renderWith surface $ do
-        render w d x y width height screen
+  render (AlphaBox alpha w) s x y width height screen = do
+    surfaces <- render w s x y width height screen
+    let surfacesWidths = zipWith (\(updated, SurfaceSlice x surf) x' -> (updated, x, x'-x, surf)) surfaces (map (\(_, SurfaceSlice x _) -> x) (tail surfaces) ++ [width])
+    forM surfacesWidths $ \(updated, x, surfWidth, surf) -> do
+      surf' <- createImageSurface FormatARGB32  surfWidth height
+      renderWith surf' $ do
+        setOperator OperatorSource
+        withPatternForSurface surf setSource
+        paint
         
         setOperator OperatorDestIn
         setSourceRGBA 0 0 0 alpha
         paint
       
-      withPatternForSurface surface setSource
-      paint
+      return (updated, SurfaceSlice x surf')
   
   handleMessage (AlphaBox _ w) = handleMessage w
 
 
-alphaBox :: (Widget w d) => Double -> w -> AlphaBox w d
+alphaBox :: (Widget w s c) => Double -> w -> AlphaBox w s c
 alphaBox = AlphaBox
 
diff --git a/lib/Phi/Widgets/Clock.hs b/lib/Phi/Widgets/Clock.hs
index bee8d39..12906c0 100644
--- a/lib/Phi/Widgets/Clock.hs
+++ b/lib/Phi/Widgets/Clock.hs
@@ -43,7 +43,7 @@ data ClockState = ClockState !ZonedTime deriving (Show, Eq)
 
 data ClockMessage = UpdateTime !ZonedTime deriving (Show, Typeable)
 
-instance Widget Clock ClockState where
+instance Widget Clock ClockState () where
   initWidget (Clock _) phi _ = do
     forkIO $ forever $ do
       time <- getZonedTime
@@ -59,26 +59,33 @@ instance Widget Clock ClockState where
   minSize (Clock config) _ _ _ = clockSize config
   
   render (Clock config) (ClockState time) _ _ w h _ = do
-    let (r, g, b, a) = fontColor config
-        str = formatTime defaultTimeLocale (clockFormat config) time
-    setSourceRGBA r g b a
-    
-    layout <- createLayout ""
-    (_, PangoRectangle _ _ textWidth textHeight) <- liftIO $ do
-      layoutSetMarkup layout str
-      layoutSetAlignment layout AlignCenter
-      layoutSetSpacing layout $ lineSpacing config
-      layoutGetExtents layout
-    
-    let scalef = min 1 ((fromIntegral w)/textWidth)
-    when (scalef < 1) $ do
-      scale scalef scalef
-      updateLayout layout
-    
-    (_, PangoRectangle _ _ textWidth' textHeight') <- liftIO $ layoutGetExtents layout
-    
-    moveTo (((fromIntegral w)/scalef - textWidth')/2) (((fromIntegral h)/scalef - textHeight')/2)
-    showLayout layout
+    surface <- createImageSurface FormatARGB32 w h
+    renderWith surface $ do
+      setOperator OperatorClear
+      paint
+
+      setOperator OperatorOver
+      let (r, g, b, a) = fontColor config
+          str = formatTime defaultTimeLocale (clockFormat config) time
+      setSourceRGBA r g b a
+      
+      layout <- createLayout ""
+      (_, PangoRectangle _ _ textWidth textHeight) <- liftIO $ do
+        layoutSetMarkup layout str
+        layoutSetAlignment layout AlignCenter
+        layoutSetSpacing layout $ lineSpacing config
+        layoutGetExtents layout
+      
+      let scalef = min 1 ((fromIntegral w)/textWidth)
+      when (scalef < 1) $ do
+        scale scalef scalef
+        updateLayout layout
+      
+      (_, PangoRectangle _ _ textWidth' textHeight') <- liftIO $ layoutGetExtents layout
+      
+      moveTo (((fromIntegral w)/scalef - textWidth')/2) (((fromIntegral h)/scalef - textHeight')/2)
+      showLayout layout
+    return [(True, SurfaceSlice 0 surface)]
   
   handleMessage _ priv m = case (fromMessage m) of
     Just (UpdateTime time) -> ClockState time
diff --git a/lib/Phi/Widgets/Systray.hs b/lib/Phi/Widgets/Systray.hs
index 6812018..662c6a7 100644
--- a/lib/Phi/Widgets/Systray.hs
+++ b/lib/Phi/Widgets/Systray.hs
@@ -47,7 +47,7 @@ data SystrayMessage = AddIcon !Window !Window | RemoveIcon !Window | RenderIcon
                       deriving (Show, Typeable)
 
 
-instance Widget Systray SystrayState where
+instance Widget Systray SystrayState () where
   initWidget (Systray) phi dispvar = do
     phi' <- dupPhi phi
     forkIO $ systrayRunner phi' dispvar
@@ -61,15 +61,20 @@ instance Widget Systray SystrayState where
 
   weight _ = 0
   
-  render Systray (SystrayState phi systrayScreen reset lastResetRef icons) x y w h screen = case True of 
-    _ | screen == systrayScreen -> do
-      lastReset <- liftIO $ readIORef lastResetRef
-      liftIO $ writeIORef lastResetRef reset
+  render Systray (SystrayState phi systrayScreen reset lastResetRef icons) x y w h screen = do
+    when (screen == systrayScreen) $ do
+      lastReset <- readIORef lastResetRef
+      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)
-        
-      | otherwise -> return ()
+    
+    surface <- 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
     Just (AddIcon midParent window) -> SystrayState phi screen reset lastReset ((SystrayIconState midParent window):icons)
diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs
index c17ac36..fbf7da8 100644
--- a/lib/Phi/Widgets/Taskbar.hs
+++ b/lib/Phi/Widgets/Taskbar.hs
@@ -166,7 +166,7 @@ data TaskbarMessage = WindowListUpdate ![Xlib.Window] !(M.Map Window WindowState
 instance Show (IORef a) where
   show _ = "IORef <?>"
 
-instance Widget Taskbar TaskbarState where
+instance Widget Taskbar TaskbarState () where
   initWidget (Taskbar _) phi dispvar = do
     phi' <- dupPhi phi
     forkIO $ taskbarRunner phi' dispvar
@@ -204,41 +204,50 @@ instance Widget Taskbar TaskbarState where
         
         desktopsWidth  = sum $ map dwidth desktopNumbers
         windowWidth    = if windowCount == 0 then 0 else min (taskMaxSize config) ((w - desktopsWidth) `div` windowCount)
-      
-    flip (flip foldM_ 0) desktops $ \nwindows (desktop, desktopWindows) -> do
-      let dstyle' = dstyle desktop
-          dx = dleftwidth desktop + (sum $ map dwidth $ take desktop [0..]) + nwindows*windowWidth
-      
-      case dstyle' of
-        Just ds -> do
-          let (r, g, b, a) = desktopColor ds
-          save
-          drawBorder (desktopBorder ds) (dx - dleftwidth desktop) 0 (dwidth desktop + windowWidth * length desktopWindows) h
-          clip
-          
-          setSourceRGBA r g b a
-          renderText (desktopFont ds) (fromIntegral (dx - dlabelwidth desktop - gap desktop ds)) 0 (dlabelwidth desktop) h $ show (desktop+1)
-          
-          restore
-      
-          forM_ (zip [0..] desktopWindows) $ \(i, window) -> do
-            let style = (if window == activeWindow then activeTaskStyle else normalTaskStyle) config
-                h' = h - (borderV $ margin $ desktopBorder ds) - 2*(borderWidth $ desktopBorder ds) - (borderV $ padding $ desktopBorder ds)
-                mstate = M.lookup window windowStates
-                micons = M.lookup window windowIcons
-                mscaledIconRef = M.lookup window windowScaledIcons
-                x = dx + i*windowWidth
-                y = (borderTop $ margin $ desktopBorder ds) + (borderWidth $ desktopBorder ds) + (borderTop $ padding $ desktopBorder ds)
+    
+    surface <- createImageSurface FormatARGB32 w h
+    renderWith surface $ do
+      setOperator OperatorClear
+      paint
+
+      setOperator OperatorOver
+
+      flip (flip foldM_ 0) desktops $ \nwindows (desktop, desktopWindows) -> do
+        let dstyle' = dstyle desktop
+            dx = dleftwidth desktop + (sum $ map dwidth $ take desktop [0..]) + nwindows*windowWidth
+        
+        case dstyle' of
+          Just ds -> do
+            let (r, g, b, a) = desktopColor ds
+            save
+            drawBorder (desktopBorder ds) (dx - dleftwidth desktop) 0 (dwidth desktop + windowWidth * length desktopWindows) h
+            clip
             
-            case (mstate, micons, mscaledIconRef) of
-              (Just state, Just icons, Just scaledIconRef) ->
-                renderTask state icons scaledIconRef style x y windowWidth h'
-          
-              _ -> return ()
+            setSourceRGBA r g b a
+            renderText (desktopFont ds) (fromIntegral (dx - dlabelwidth desktop - gap desktop ds)) 0 (dlabelwidth desktop) h $ show (desktop+1)
+            
+            restore
+            
+            forM_ (zip [0..] desktopWindows) $ \(i, window) -> do
+              let style = (if window == activeWindow then activeTaskStyle else normalTaskStyle) config
+                  h' = h - (borderV $ margin $ desktopBorder ds) - 2*(borderWidth $ desktopBorder ds) - (borderV $ padding $ desktopBorder ds)
+                  mstate = M.lookup window windowStates
+                  micons = M.lookup window windowIcons
+                  mscaledIconRef = M.lookup window windowScaledIcons
+                  x = dx + i*windowWidth
+                  y = (borderTop $ margin $ desktopBorder ds) + (borderWidth $ desktopBorder ds) + (borderTop $ padding $ desktopBorder ds)
+              
+              case (mstate, micons, mscaledIconRef) of
+                (Just state, Just icons, Just scaledIconRef) ->
+                  renderTask state icons scaledIconRef style x y windowWidth h'
+            
+                _ -> return ()
         
-        _ -> return ()
+          _ -> return ()
       
-      return $ nwindows + length desktopWindows
+        return $ nwindows + length desktopWindows
+    
+    return [(True, SurfaceSlice 0 surface)]
       
   
   handleMessage _ priv m = case (fromMessage m) of
diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs
index b2b3c2c..110e9d4 100644
--- a/lib/Phi/X11.hs
+++ b/lib/Phi/X11.hs
@@ -38,21 +38,22 @@ import qualified Phi.Bindings.Util as Util
 data XConfig = XConfig { phiXScreenInfo :: !(Display -> IO [Rectangle])
                        }
 
-data PhiState w d = (Widget.Widget w d) => PhiState { phiRootImage    :: !Surface
-                                                    , phiPanels       :: ![PanelState w d]
-                                                    , phiRepaint      :: !Bool
-                                                    , phiShutdown     :: !Bool
-                                                    , phiShutdownHold :: !Int
-                                                    }
-
-data PanelState w d = (Widget.Widget w d) => PanelState { panelWindow       :: !Window
-                                                        , panelPixmap       :: !Pixmap
-                                                        , panelArea         :: !Rectangle
-                                                        , panelScreenArea   :: !Rectangle
-                                                        , panelWidget       :: !w
-                                                        , panelWidgetState  :: !d
+data PhiState w s c = (Widget.Widget w s c) => PhiState { phiRootImage    :: !Surface
+                                                        , phiPanels       :: ![PanelState w s c]
+                                                        , phiRepaint      :: !Bool
+                                                        , phiShutdown     :: !Bool
+                                                        , phiShutdownHold :: !Int
                                                         }
 
+data PanelState w s c = (Widget.Widget w s c) => PanelState { panelWindow       :: !Window
+                                                            , panelPixmap       :: !Pixmap
+                                                            , panelArea         :: !Rectangle
+                                                            , panelScreenArea   :: !Rectangle
+                                                            , panelWidget       :: !w
+                                                            , panelWidgetState  :: !s
+                                                            , panelWidgetCache  :: !(Maybe c)
+                                                            }
+
 data PhiConfig = PhiConfig { phiPhi         :: !Phi
                            , phiPanelConfig :: !Panel.PanelConfig
                            , phiXConfig     :: !XConfig
@@ -65,17 +66,16 @@ newtype PhiReader a = PhiReader (ReaderT PhiConfig IO a)
 runPhiReader :: PhiConfig -> PhiReader a -> IO a
 runPhiReader config (PhiReader a) = runReaderT a config
 
-newtype PhiX w d a = PhiX (StateT (PhiState w d) PhiReader a)
-                   deriving (Monad, MonadState (PhiState w d), MonadReader PhiConfig, MonadIO)
+newtype PhiX w s c a = PhiX (StateT (PhiState w s c) PhiReader a)
+                   deriving (Monad, MonadState (PhiState w s c), MonadReader PhiConfig, MonadIO)
 
-runPhiX :: PhiConfig -> PhiState w d -> PhiX w d a -> IO (a, PhiState w d)
+runPhiX :: PhiConfig -> PhiState w s c -> PhiX w s c a -> IO (a, PhiState w s c)
 runPhiX config st (PhiX a) = runPhiReader config $ runStateT a st
 
 defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo
                          }
 
-
-runPhi :: (Widget.Widget w d) => XConfig -> Panel.PanelConfig -> w -> IO ()
+runPhi :: (Widget.Widget w s c) => XConfig -> Panel.PanelConfig -> w -> IO ()
 runPhi xconfig config widget = do
   xSetErrorHandler
   
@@ -158,12 +158,12 @@ termHandler :: Phi -> Handler
 termHandler phi = Catch $ sendMessage phi Shutdown
 
 
-handlePanel :: Message -> PanelState w d -> PanelState w d
+handlePanel :: Message -> PanelState w s c -> PanelState w s c
 handlePanel message panel@PanelState {panelWidget = widget, panelWidgetState = state} = panel {panelWidgetState = state'}
   where
     state' = Widget.handleMessage widget state message
 
-handleMessage :: Widget.Display -> Message -> PhiX w d ()
+handleMessage :: Widget.Display -> Message -> PhiX w s c ()
 handleMessage dispvar m = do
   modify $ \state@PhiState {phiPanels = panels} -> state {phiPanels = map (handlePanel m) panels}
   
@@ -195,7 +195,7 @@ receiveEvents phi dispvar = do
       
     when (not handled) $ threadWaitRead connection
 
-updatePanels :: (Widget w d) => Widget.Display -> PhiX w d ()
+updatePanels :: (Widget w s c) => Widget.Display -> PhiX w s c ()
 updatePanels dispvar = do
   rootImage <- gets phiRootImage
   panels <- gets phiPanels
@@ -205,7 +205,7 @@ updatePanels dispvar = do
         area = panelArea panel
     
     let layoutedWidget = (withDimension area $ Widget.layout (panelWidget panel) (panelWidgetState panel)) $ panelScreenArea panel
-        panel' = panel { panelWidgetState = layoutedWidget }
+    panelSurfaces <- liftIO $ (withDimension area $ Widget.render (panelWidget panel) layoutedWidget 0 0) (panelScreenArea panel)
     
     Widget.withDisplay dispvar $ \disp -> do
       let screen = defaultScreen disp
@@ -215,31 +215,37 @@ updatePanels dispvar = do
       
       liftIO $ (withDimension area $ withSimilarSurface xbuffer ContentColor) $ \buffer -> do
         renderWith buffer $ do
-          withPatternForSurface rootImage $ \pattern -> do
+          save
+          translate (-(fromIntegral $ rect_x area)) (-(fromIntegral $ rect_y area))
+          withPatternForSurface rootImage setSource
+          paint
+          restore
+          
+          forM_ panelSurfaces $ \(updated, SurfaceSlice x surface) -> do
             save
-            translate (-(fromIntegral $ rect_x area)) (-(fromIntegral $ rect_y area))
-            setSource pattern
+            translate (fromIntegral x) 0
+            withPatternForSurface surface setSource
             paint
             restore
-          (withDimension area $ Widget.render (panelWidget panel) layoutedWidget 0 0) (panelScreenArea panel)
+        
         renderWith xbuffer $ do
-          withPatternForSurface buffer $ \pattern -> do
-            setSource pattern
-            paint
+          withPatternForSurface buffer setSource
+          paint
       
       surfaceFinish xbuffer
       
       -- copy buffer to window
       liftIO $ do
-        (withDimension area $ clearArea disp (panelWindow panel') 0 0) True
+        (withDimension area $ clearArea disp (panelWindow panel) 0 0) True
         sync disp False
     
-    return panel'
+    return $ panel { panelWidgetState = layoutedWidget }
+
   
   modify $ \state -> state { phiPanels = panels' }
 
 
-handlePropertyUpdate :: Display -> Event -> PhiX w d ()
+handlePropertyUpdate :: Display -> Event -> PhiX w s c ()
 handlePropertyUpdate disp PropertyEvent { ev_atom = atom } = do
   phi <- asks phiPhi
   atoms <- asks phiAtoms
@@ -251,7 +257,7 @@ handlePropertyUpdate disp PropertyEvent { ev_atom = atom } = do
     sendMessage phi Repaint
   
 
-updateRootImage :: Display -> PhiX w d ()
+updateRootImage :: Display -> PhiX w s c ()
 updateRootImage disp = do
   atoms <- asks phiAtoms
   
@@ -289,8 +295,8 @@ updateRootImage disp = do
       surfaceFinish rootSurface
 
 
-createPanel :: (Widget w d) => Display -> Window -> w -> d -> Rectangle -> PhiX w d (PanelState w d)
-createPanel disp win w d screenRect = do
+createPanel :: (Widget w s c) => Display -> Window -> w -> s -> Rectangle -> PhiX w s c (PanelState w s c)
+createPanel disp win w s screenRect = do
   config <- asks phiPanelConfig
   let rect = panelBounds config screenRect
   let screen = defaultScreen disp
@@ -304,10 +310,11 @@ createPanel disp win w d screenRect = do
                     , panelArea = rect
                     , panelScreenArea = screenRect
                     , panelWidget = w
-                    , panelWidgetState = d
+                    , panelWidgetState = s
+                    , panelWidgetCache = Nothing
                     }
 
-createPanelWindow :: Display -> Rectangle -> PhiX w d Window
+createPanelWindow :: Display -> Rectangle -> PhiX w s c Window
 createPanelWindow disp screenRect = do
   config <- asks phiPanelConfig
   let rect = panelBounds config screenRect
@@ -326,7 +333,7 @@ createPanelWindow disp screenRect = do
     withRectangle rect (createWindow disp rootwin) 0 depth inputOutput visual mask attr
 
 
-setPanelProperties :: Display -> PanelState w d -> PhiX w d ()
+setPanelProperties :: Display -> PanelState w s c -> PhiX w s c ()
 setPanelProperties disp panel = do
   atoms <- asks phiAtoms
   liftIO $ do
@@ -357,7 +364,7 @@ setPanelProperties disp panel = do
   setStruts disp panel
 
 
-setStruts :: Display -> PanelState w d -> PhiX w d ()
+setStruts :: Display -> PanelState w s c -> PhiX w s c ()
 setStruts disp panel = do
   atoms <- asks phiAtoms
   config <- asks phiPanelConfig