diff options
Diffstat (limited to 'lib/Phi/X11.hs')
| -rw-r--r-- | lib/Phi/X11.hs | 36 |
1 files changed, 21 insertions, 15 deletions
diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs index 3beb47e..709d04a 100644 --- a/lib/Phi/X11.hs +++ b/lib/Phi/X11.hs @@ -35,9 +35,9 @@ import qualified Phi.Bindings.Util as Util data XConfig = XConfig { phiXScreenInfo :: !(Display -> IO [Rectangle]) } -data PhiState = PhiState { phiPhi :: !Phi - , phiRootImage :: !Surface +data PhiState = PhiState { phiRootImage :: !Surface , phiPanels :: ![PanelState] + , phiRepaint :: !Bool } data PanelState = PanelState { panelWindow :: !Window @@ -47,7 +47,8 @@ data PanelState = PanelState { panelWindow :: !Window , panelWidgetStates :: ![Widget.WidgetState] } -data PhiConfig = PhiConfig { phiPanelConfig :: !Panel.PanelConfig +data PhiConfig = PhiConfig { phiPhi :: !Phi + , phiPanelConfig :: !Panel.PanelConfig , phiXConfig :: !XConfig , phiAtoms :: !Atoms } @@ -79,7 +80,7 @@ runPhi xconfig config widgets = do selectInput disp (defaultRootWindow disp) $ propertyChangeMask.|.structureNotifyMask bg <- createImageSurface FormatRGB24 1 1 - runPhiX PhiConfig { phiXConfig = xconfig, phiPanelConfig = config, phiAtoms = atoms } PhiState { phiPhi = phi, phiRootImage = bg, phiPanels = [] } $ do + runPhiX PhiConfig { phiPhi = phi, phiXConfig = xconfig, phiPanelConfig = config, phiAtoms = atoms } PhiState { phiRootImage = bg, phiPanels = [], phiRepaint = True } $ do updateRootImage disp screens <- liftIO $ phiXScreenInfo xconfig disp @@ -97,11 +98,16 @@ runPhi xconfig config widgets = do modify $ \state -> state { phiPanels = panels } - updatePanels disp True - liftIO $ forkIO $ receiveEvents phi dispvar forever $ do + available <- messageAvailable phi + unless available $ do + repaint <- gets phiRepaint + when repaint $ do + Widget.withDisplay dispvar $ flip updatePanels True + modify $ \state -> state {phiRepaint = False} + message <- receiveMessage phi handleMessage dispvar message return () @@ -117,14 +123,14 @@ handleMessage dispvar m = do modify $ \state@PhiState {phiPanels = panels} -> state {phiPanels = map (handlePanel m) panels} case (fromMessage m) of - Just Repaint -> Widget.withDisplay dispvar $ \disp -> - updatePanels disp True + Just Repaint -> + modify $ \state -> state {phiRepaint = True} _ -> case (fromMessage m) of - Just ExposeEvent {} -> Widget.withDisplay dispvar $ \disp -> - updatePanels disp False - Just event@PropertyEvent {} -> Widget.withDisplay dispvar $ \disp -> - handlePropertyUpdate disp event + Just ExposeEvent {} -> + Widget.withDisplay dispvar $ flip updatePanels False + Just event@PropertyEvent {} -> + Widget.withDisplay dispvar $ flip handlePropertyUpdate event _ -> return () @@ -187,19 +193,19 @@ updatePanels disp redraw = do handlePropertyUpdate :: Display -> Event -> PhiX () handlePropertyUpdate disp PropertyEvent { ev_atom = atom } = do + phi <- asks phiPhi atoms <- asks phiAtoms panels <- gets phiPanels when (atom == atom_XROOTPMAP_ID atoms || atom == atom_XROOTMAP_ID atoms) $ do updateRootImage disp - updatePanels disp True + sendMessage phi Repaint updateRootImage :: Display -> PhiX () updateRootImage disp = do atoms <- asks phiAtoms - let screen = defaultScreen disp visual = defaultVisual disp screen rootwin = defaultRootWindow disp @@ -228,7 +234,7 @@ updateRootImage disp = do createPanel :: Display -> [Widget.WidgetState] -> Rectangle -> PhiX PanelState createPanel disp widgets screenRect = do - phi <- gets phiPhi + phi <- asks phiPhi config <- asks phiPanelConfig let rect = panelBounds config screenRect |