From 499eaf95fb37b7ae14cf44c1f60f4a268ac10f52 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Mon, 29 Aug 2011 16:51:02 +0200
Subject: Handle changes of resolution and screen configuration

---
 lib/Phi/X11.hs | 72 +++++++++++++++++++++++++++++++++++++++++++++-------------
 1 file 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
-- 
cgit v1.2.3