Added basic rendering functions

1 files changed, 47 insertions, 10 deletions

diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs
index 2645ac2..dd75484 100644
--- a/lib/Phi/X11.hs
+++ b/lib/Phi/X11.hs
@@ -9,6 +9,8 @@ import Graphics.X11.Xlib
 import Graphics.X11.Xlib.Extras
 import Graphics.X11.Xinerama
 
+import Graphics.Rendering.Cairo
+
 import Control.Monad
 import Data.Maybe
 import Data.Bits
@@ -19,6 +21,7 @@ import Control.Monad.Trans
 
 import qualified Phi.Panel as Panel
 import Phi.X11.Atoms
+import qualified Phi.Bindings.Util as Util
 
 data XConfig = XConfig { phiXScreenInfo :: Display -> IO [Rectangle]
                        }
@@ -29,6 +32,8 @@ data PhiState = PhiState { phiRootPixmap :: Pixmap
 
 data PanelState = PanelState { panelWindow     :: Window
                              , panelGC         :: GC
+                             , panelPixmap     :: Pixmap
+                             , panelSurface    :: Surface
                              , panelArea       :: Rectangle
                              , panelScreenArea :: Rectangle
                              }
@@ -55,7 +60,7 @@ liftIOContToPhi :: ((a -> IO (b, PhiState)) -> IO (b, PhiState)) -> (a -> Phi b)
 liftIOContToPhi f c = do
   config <- ask
   state <- get
-  (a, state') <- liftIO $ f $ \x -> runPhi config state $ c x
+  (a, state') <- liftIO $ f $ runPhi config state . c
   put state'
   return a
 
@@ -63,6 +68,7 @@ liftIOContToPhi f c = do
 defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo
                          }
 
+
 initPhi :: XConfig -> Panel.PanelConfig -> IO ()
 initPhi xconfig config = do
   disp <- openDisplay []
@@ -97,9 +103,28 @@ initPhi xconfig config = do
 updatePanels :: Bool -> Phi ()
 updatePanels redraw = do
   disp <- asks phiDisplay
+  panelConfig <- asks phiPanelConfig
+  
   rootPixmap <- gets phiRootPixmap
   panels <- gets phiPanels
-  forM_ panels $ \panel -> liftIO $ withRectangle (panelArea panel) (copyArea disp rootPixmap (panelWindow panel) (panelGC panel)) 0 0
+    
+  forM_ panels $ \panel -> do
+    when redraw $ do
+      let surface = panelSurface panel
+          area = panelArea panel
+      -- draw background
+      liftIO $ withRectangle (panelArea panel) (copyArea disp rootPixmap (panelPixmap panel) (panelGC panel)) 0 0
+      surfaceMarkDirty surface
+      
+      renderWith surface $ do
+        save
+        Panel.render (Panel.panelContent panelConfig) (fromIntegral $ rect_width area) (fromIntegral $ rect_height area)
+        restore
+      
+      surfaceFlush surface
+    
+    -- copy pixmap to window
+    liftIO $ withDimension (panelArea panel) (copyArea disp (panelPixmap panel) (panelWindow panel) (panelGC panel) 0 0) 0 0
 
 
 handlePropertyUpdate :: Event -> Phi ()
@@ -124,13 +149,22 @@ updateRootPixmap = do
 
 
 createPanel :: Rectangle -> Phi PanelState
-createPanel screen = do
+createPanel screenRect = do
   config <- asks phiPanelConfig
   disp <- asks phiDisplay
-  let rect = panelBounds config screen
+  let rect = panelBounds config screenRect
+      
   win <- createPanelWindow rect
   gc <- liftIO $ createGC disp win
-  return PanelState { panelWindow = win, panelGC = gc, panelArea = rect, panelScreenArea = screen }
+  
+  let screen = defaultScreen disp
+      depth = defaultDepth disp screen
+      visual = defaultVisual disp screen
+
+  pixmap <- liftIO $ withDimension rect (createPixmap disp win) depth
+  surface <- liftIO $ withDimension rect $ Util.createXlibSurface disp pixmap visual
+  
+  return PanelState { panelWindow = win, panelGC = gc, panelPixmap = pixmap, panelSurface = surface, panelArea = rect, panelScreenArea = screenRect }
 
 
 createPanelWindow :: Rectangle -> Phi Window
@@ -175,6 +209,9 @@ setPanelProperties panel = do
                                                 , wmh_window_group = 0
                                                 }
     changeProperty32 disp (panelWindow panel) (atom_MOTIF_WM_HINTS atoms) (atom_MOTIF_WM_HINTS atoms) propModeReplace [ 2, 0, 0, 0, 0 ]
+    
+    Util.setClassHint disp (panelWindow panel) ClassHint { resName = "phi", resClass = "Phi" }
+    
   setStruts panel
 
 
@@ -215,11 +252,11 @@ panelBounds config screenBounds = case Panel.panelPosition config of
   Panel.Bottom -> screenBounds { rect_height = fromIntegral $ Panel.panelSize config,
                                         rect_y = (rect_y screenBounds) + (fromIntegral $ rect_height screenBounds) - (fromIntegral $ Panel.panelSize config) }
 
-withRectangle :: Rectangle -> (Position -> Position -> Dimension -> Dimension -> a) -> a
+withRectangle :: (Num x, Num y, Num w, Num h) => Rectangle -> (x -> y -> w -> h -> a) -> a
 withRectangle r = withDimension r . withPosition r
 
-withPosition :: Rectangle -> (Position -> Position -> a) -> a
-withPosition r f = f (rect_x r) (rect_y r)
+withPosition :: (Num x, Num y) => Rectangle -> (x -> y -> a) -> a
+withPosition r f = f (fromIntegral $ rect_x r) (fromIntegral $ rect_y r)
 
-withDimension :: Rectangle -> (Dimension -> Dimension -> a) -> a
-withDimension r f = f (rect_width r) (rect_height r)
+withDimension :: (Num w, Num h) => Rectangle -> (w -> h -> a) -> a
+withDimension r f = f (fromIntegral $ rect_width r) (fromIntegral $ rect_height r)