diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Phi/X11.hs | 72 |
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 |