Fix background update race, speed up rendering!

1 files changed, 28 insertions, 18 deletions

diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs
index 23c6c62..d7159dd 100644
--- a/lib/Phi/X11.hs
+++ b/lib/Phi/X11.hs
@@ -208,18 +208,23 @@ updatePanels dispvar = do
       let screen = defaultScreen disp
           visual = defaultVisual disp screen
       
-      buffer <- liftIO $ withDimension area $ Util.createXlibSurface disp pixmap visual
+      xbuffer <- liftIO $ withDimension area $ Util.createXlibSurface disp pixmap visual
       
-      renderWith buffer $ do
-        withPatternForSurface rootImage $ \pattern -> do
-          save
-          translate (-(fromIntegral $ rect_x area)) (-(fromIntegral $ rect_y area))
-          setSource pattern
-          paint
-          restore
-        Widget.renderWidgets layoutedWidgets $ panelScreenArea panel
+      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))
+            setSource pattern
+            paint
+            restore
+          Widget.renderWidgets layoutedWidgets $ panelScreenArea panel
+        renderWith xbuffer $ do
+          withPatternForSurface buffer $ \pattern -> do
+            setSource pattern
+            paint
       
-      surfaceFinish buffer
+      surfaceFinish xbuffer
       
       -- copy buffer to window
       liftIO $ do
@@ -266,14 +271,19 @@ updateRootImage disp = do
   
   bg <- gets phiRootImage
   
-  when (pixmap /= 0) $ do
-    rootSurface <- liftIO $ Util.createXlibSurface disp pixmap visual (fromIntegral rootWidth) (fromIntegral rootHeight)
-    
-    renderWith bg $ withPatternForSurface rootSurface $ \pattern -> do
-      setSource pattern
-      paint
-    
-    surfaceFinish rootSurface
+  case pixmap of 
+    0 -> do
+      renderWith bg $ do
+        setSourceRGB 0 0 0
+        paint
+    _ -> do
+      rootSurface <- liftIO $ Util.createXlibSurface disp pixmap visual (fromIntegral rootWidth) (fromIntegral rootHeight)
+      
+      renderWith bg $ withPatternForSurface rootSurface $ \pattern -> do
+        setSource pattern
+        paint
+      
+      surfaceFinish rootSurface
 
 
 createPanel :: Display -> Window -> [Widget.WidgetState] -> Rectangle -> PhiX PanelState