summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lib/Phi/X11.hs72
1 files changed, 56 insertions, 16 deletions
diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs
index dbaaf28..139b40b 100644
--- a/lib/Phi/X11.hs
+++ b/lib/Phi/X11.hs
@@ -172,11 +172,64 @@ handleMessage dispvar m = do
modify $ \state -> state {phiRepaint = True}
_ ->
case (fromMessage m) of
- Just event@PropertyEvent {} ->
- Widget.withDisplay dispvar $ flip handlePropertyUpdate event
+ Just event ->
+ Widget.withDisplay dispvar $ flip handleEvent event
_ ->
return ()
+handleEvent :: (Widget w s c) => Display -> Event -> PhiX w s c ()
+handleEvent 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
+ sendMessage phi ResetBackground
+ sendMessage phi Repaint
+
+handleEvent disp ConfigureEvent { ev_window = window } | window == defaultRootWindow disp = do
+ phi <- asks phiPhi
+ xconfig <- asks phiXConfig
+ config <- asks phiPanelConfig
+ panels <- gets phiPanels
+ let screens = map panelScreenArea panels
+ screens' <- liftIO $ phiXScreenInfo xconfig disp
+
+ when (screens /= screens') $ do
+ liftIO $ do
+ mapM (freePixmap disp . panelPixmap) panels
+ mapM_ (destroyWindow disp . panelWindow) $ drop (length screens') panels
+
+ let panelsScreens = zip screens' $ map Just panels ++ repeat Nothing
+
+ panels' <- forM panelsScreens $ \(screen, mpanel) ->
+ case mpanel of
+ Just panel -> do
+ let rect = panelBounds config screen
+ win = panelWindow panel
+
+ liftIO $ withRectangle rect $ moveResizeWindow disp win
+
+ panel' <- createPanel disp win screen
+ setPanelProperties disp panel'
+
+ return panel'
+ Nothing -> do
+ win <- liftIO $ createPanelWindow disp config screen
+ panel <- createPanel disp win screen
+ setPanelProperties disp panel
+ liftIO $ mapWindow disp $ panelWindow panel
+ return panel
+
+ modify $ \state -> state { phiPanels = panels' }
+
+ sendMessage phi $ UpdateScreens $ map (\panel -> (panelScreenArea panel, panelWindow panel)) panels'
+ sendMessage phi Repaint
+
+handleEvent _ _ = return ()
+
+
receiveEvents :: Phi -> Widget.Display -> IO ()
receiveEvents phi dispvar = do
connection <- Widget.withDisplay dispvar $ return . Fd . connectionNumber
@@ -242,7 +295,6 @@ updatePanels dispvar = do
-- update window
liftIO $ do
(withDimension area $ clearArea disp (panelWindow panel) 0 0) True
- --(withDimension area $ copyArea disp (panelPixmap panel) (panelWindow panel) (defaultGC disp $ defaultScreen disp) 0 0) 0 0
sync disp False
return $ panel { panelWidgetCache = cache' }
@@ -250,18 +302,6 @@ updatePanels dispvar = do
modify $ \state -> state { phiPanels = panels' }
-handlePropertyUpdate :: Display -> Event -> PhiX w s c ()
-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
- sendMessage phi ResetBackground
- sendMessage phi Repaint
-
-
updateRootImage :: Display -> PhiX w s c ()
updateRootImage disp = do
atoms <- asks phiAtoms
@@ -332,7 +372,7 @@ createPanelWindow disp config screenRect = do
rootwin = defaultRootWindow disp
mask = cWEventMask.|.cWColormap.|.cWBackPixel.|.cWBorderPixel
- liftIO $ allocaSetWindowAttributes $ \attr -> do
+ allocaSetWindowAttributes $ \attr -> do
set_colormap attr colormap
set_background_pixel attr 0
set_border_pixel attr 0