diff options
Diffstat (limited to 'lib/Phi/X11.hs')
-rw-r--r-- | lib/Phi/X11.hs | 52 |
1 files changed, 30 insertions, 22 deletions
diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs index d272cb9..057d1ee 100644 --- a/lib/Phi/X11.hs +++ b/lib/Phi/X11.hs @@ -20,7 +20,9 @@ import Control.Monad.State import Control.Monad.Reader import Control.Monad.Trans +import qualified Phi.Types as Phi import qualified Phi.Panel as Panel +import qualified Phi.Widget as Widget import Phi.X11.Atoms import qualified Phi.Bindings.Util as Util @@ -31,12 +33,13 @@ data PhiState = PhiState { phiRootPixmap :: Pixmap , phiPanels :: [PanelState] } -data PanelState = PanelState { panelWindow :: Window - , panelGC :: GC - , panelPixmap :: Pixmap - , panelSurface :: Surface - , panelArea :: Rectangle - , panelScreenArea :: Rectangle +data PanelState = PanelState { panelWindow :: Window + , panelGC :: GC + , panelPixmap :: Pixmap + , panelSurface :: Surface + , panelArea :: Rectangle + , panelScreenArea :: Rectangle + , panelWidgetStates :: [Widget.WidgetState] } data PhiConfig = PhiConfig { phiPanelConfig :: Panel.PanelConfig @@ -70,8 +73,8 @@ defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo } -initPhi :: XConfig -> Panel.PanelConfig -> IO () -initPhi xconfig config = do +initPhi :: XConfig -> Panel.PanelConfig -> [Widget.Widget] -> IO () +initPhi xconfig config widgets = do disp <- openDisplay [] atoms <- initAtoms disp selectInput disp (defaultRootWindow disp) $ propertyChangeMask.|.structureNotifyMask @@ -80,7 +83,7 @@ initPhi xconfig config = do updateRootPixmap screens <- liftIO $ phiXScreenInfo xconfig disp - panels <- mapM createPanel screens + panels <- mapM (createPanel widgets) screens forM_ panels $ \panel -> do setPanelProperties panel liftIO $ mapWindow disp (panelWindow panel) @@ -104,28 +107,34 @@ 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 -> do - when redraw $ do + panels' <- forM panels $ \panel -> do + newPanel <- if not redraw then return panel else do let surface = panelSurface panel area = panelArea panel + layoutedWidgets = Widget.layoutWidgets (panelWidgetStates panel) (fromIntegral $ rect_width area) (fromIntegral $ rect_height area) + panel' = panel { panelWidgetStates = layoutedWidgets } + -- 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) + Widget.renderWidgets layoutedWidgets restore surfaceFlush surface - + return panel' + -- copy pixmap to window liftIO $ withDimension (panelArea panel) (copyArea disp (panelPixmap panel) (panelWindow panel) (panelGC panel) 0 0) 0 0 + return newPanel + + modify $ \state -> state { phiPanels = panels' } handlePropertyUpdate :: Event -> Phi () @@ -149,8 +158,8 @@ updateRootPixmap = do modify $ \state -> state { phiRootPixmap = pixmap } -createPanel :: Rectangle -> Phi PanelState -createPanel screenRect = do +createPanel :: [Widget.Widget] -> Rectangle -> Phi PanelState +createPanel widgets screenRect = do config <- asks phiPanelConfig disp <- asks phiDisplay let rect = panelBounds config screenRect @@ -165,8 +174,7 @@ createPanel screenRect = do 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 } - + return PanelState { panelWindow = win, panelGC = gc, panelPixmap = pixmap, panelSurface = surface, panelArea = rect, panelScreenArea = screenRect, panelWidgetStates = map Widget.createWidgetState widgets } createPanelWindow :: Rectangle -> Phi Window createPanelWindow rect = do @@ -241,8 +249,8 @@ setStruts panel = do makeBottomStruts _ = 0 makeStruts = case position of - Panel.Top -> makeTopStruts - Panel.Bottom -> makeBottomStruts + Phi.Top -> makeTopStruts + Phi.Bottom -> makeBottomStruts liftIO $ do changeProperty32 disp (panelWindow panel) (atom_NET_WM_STRUT atoms) cARDINAL propModeReplace $ take 4 struts @@ -251,8 +259,8 @@ setStruts panel = do panelBounds :: Panel.PanelConfig -> Rectangle -> Rectangle panelBounds config screenBounds = case Panel.panelPosition config of - Panel.Top -> screenBounds { rect_height = fromIntegral $ Panel.panelSize config } - Panel.Bottom -> screenBounds { rect_height = fromIntegral $ Panel.panelSize config, + Phi.Top -> screenBounds { rect_height = fromIntegral $ Panel.panelSize config } + Phi.Bottom -> screenBounds { rect_height = fromIntegral $ Panel.panelSize config, rect_y = (rect_y screenBounds) + (fromIntegral $ rect_height screenBounds) - (fromIntegral $ Panel.panelSize config) } withRectangle :: (Num x, Num y, Num w, Num h) => Rectangle -> (x -> y -> w -> h -> a) -> a |