From 7a87ba6f2e3e864fb1c487c097e2cf17bfca2df6 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Mon, 29 Aug 2011 15:10:55 +0200 Subject: Get rid of layout function --- lib/Phi/Widgets/Taskbar.hs | 71 +++++++++++++++++++++------------------------- 1 file changed, 33 insertions(+), 38 deletions(-) (limited to 'lib/Phi/Widgets/Taskbar.hs') diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs index da68c27..31d85ff 100644 --- a/lib/Phi/Widgets/Taskbar.hs +++ b/lib/Phi/Widgets/Taskbar.hs @@ -137,7 +137,8 @@ defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 200 data Taskbar = Taskbar TaskbarConfig -data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window +data TaskbarState = TaskbarState { taskbarScreens :: ![Xlib.Rectangle] + , taskbarActiveWindow :: !Window , taskbarDesktopCount :: !Int , taskbarCurrentDesktop :: !Int , taskbarWindows :: ![Window] @@ -154,11 +155,11 @@ createIcon size surface = do return $ Icon id size surface -data WindowState = WindowState { windowTitle :: !String - , windowDesktop :: !Int - , windowVisible :: !Bool - , windowIcons :: ![Icon] - , windowScreen :: !Xlib.Rectangle +data WindowState = WindowState { windowTitle :: !String + , windowDesktop :: !Int + , windowVisible :: !Bool + , windowIcons :: ![Icon] + , windowGeometry :: !Xlib.Rectangle } deriving (Eq, Show) data WindowCache = WindowCache { createScaledIconCached :: !(IOCache ([Icon], Int) (Maybe Icon)) @@ -205,24 +206,26 @@ data TaskbarMessage = WindowListUpdate ![Xlib.Window] !(M.Map Window WindowState deriving (Typeable, Show) instance Widget Taskbar TaskbarState (M.Map Window WindowCache) where - initWidget (Taskbar _) phi dispvar = do + initWidget (Taskbar _) phi dispvar screens = do phi' <- dupPhi phi forkIO $ taskbarRunner phi' dispvar - return $ TaskbarState 0 0 (-1) [] M.empty + return $ TaskbarState (map fst screens) 0 0 (-1) [] M.empty initCache _ = M.empty minSize _ _ _ _ = 0 weight _ = 1 - render (Taskbar config) TaskbarState { taskbarActiveWindow = activeWindow + render (Taskbar config) TaskbarState { taskbarScreens = screens + , taskbarActiveWindow = activeWindow , taskbarDesktopCount = desktopCount , taskbarCurrentDesktop = currentDesktop , taskbarWindows = windows , taskbarWindowStates = windowStates } _ _ w h screen = do - let screenWindows = filter ((== Just screen) . fmap windowScreen . flip M.lookup windowStates) windows + let windowScreen w = maximumBy (compare `on` unionArea (windowGeometry w)) screens + screenWindows = filter ((== Just screen) . fmap windowScreen . flip M.lookup windowStates) windows desktopNumbers = take desktopCount [0..] desktops = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop desktop) . flip M.lookup windowStates) screenWindows)) desktopNumbers @@ -301,7 +304,9 @@ instance Widget Taskbar TaskbarState (M.Map Window WindowCache) where Just (DesktopCountUpdate count) -> priv {taskbarDesktopCount = count} Just (CurrentDesktopUpdate current) -> priv {taskbarCurrentDesktop = current} Just (ActiveWindowUpdate window) -> priv {taskbarActiveWindow = window} - _ -> priv + _ -> case (fromMessage m) of + Just (UpdateScreens screens) -> priv {taskbarScreens = map fst screens} + _ -> priv renderText :: String -> Int -> Int -> Int -> Int -> String -> Render () @@ -390,9 +395,8 @@ windowOnDesktop desktop state = (windowVisible state) && (desktop == windowDeskt taskbarRunner :: Phi -> Display -> IO () taskbarRunner phi dispvar = do - let screens = getScreens dispvar (windows, states) <- liftIO $ withDisplay dispvar $ \disp -> do - (windows, states) <- getWindowStates disp screens (getAtoms dispvar) M.empty + (windows, states) <- getWindowStates disp (getAtoms dispvar) M.empty desktopCount <- getDesktopCount disp (getAtoms dispvar) current <- getCurrentDesktop disp (getAtoms dispvar) activeWindow <- getActiveWindow disp (getAtoms dispvar) @@ -406,7 +410,7 @@ taskbarRunner phi dispvar = do flip evalStateT (windows, states) $ forever $ do m <- receiveMessage phi case (fromMessage m) of - Just event -> + Just event -> handleEvent phi dispvar event _ -> return () @@ -414,7 +418,6 @@ taskbarRunner phi dispvar = do handleEvent :: Phi -> Display -> XExtras.Event -> StateT ([Window], M.Map Window WindowState) IO () handleEvent phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.ev_window = window} = do let atoms = getAtoms dispvar - let screens = getScreens dispvar when (elem atom $ Xlib.wM_NAME : map ($ atoms) [ atom_NET_ACTIVE_WINDOW , atom_NET_NUMBER_OF_DESKTOPS @@ -442,7 +445,7 @@ handleEvent phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.e sendMessage phi Repaint when (atom == atom_NET_CLIENT_LIST atoms) $ do (windows, windowStates) <- get - (windows', windowStates') <- liftIO $ getWindowStates disp screens atoms windowStates + (windows', windowStates') <- liftIO $ getWindowStates disp atoms windowStates when (windows /= windows') $ do sendMessage phi $ WindowListUpdate windows' windowStates' @@ -476,14 +479,12 @@ handleEvent phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.e return () handleEvent phi dispvar XExtras.ConfigureEvent {XExtras.ev_window = window} = do - let screens = getScreens dispvar - (windows, windowStates) <- get when (elem window windows) $ withDisplay dispvar $ \disp -> do - let screen = fmap windowScreen . M.lookup window $ windowStates - screen' <- liftIO $ getWindowScreen disp screens window - when (screen /= (Just screen')) $ do - let windowStates' = M.update (\state -> Just state {windowScreen = screen'}) window windowStates + let geom = fmap windowGeometry . M.lookup window $ windowStates + geom' <- liftIO $ getWindowGeometry disp window + when (geom /= (Just geom')) $ do + let windowStates' = M.update (\state -> Just state {windowGeometry = geom'}) window windowStates sendMessage phi $ WindowListUpdate windows windowStates' sendMessage phi Repaint put (windows, windowStates') @@ -504,8 +505,8 @@ getActiveWindow :: Xlib.Display -> Atoms -> IO Window getActiveWindow disp atoms = liftM (fromIntegral . fromMaybe 0 . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_ACTIVE_WINDOW atoms) $ Xlib.defaultRootWindow disp -getWindowStates :: Xlib.Display -> [Xlib.Rectangle] -> Atoms -> M.Map Window WindowState -> IO ([Window], M.Map Window WindowState) -getWindowStates disp screens atoms windowStates = do +getWindowStates :: Xlib.Display -> Atoms -> M.Map Window WindowState -> IO ([Window], M.Map Window WindowState) +getWindowStates disp atoms windowStates = do windows <- getWindowList disp atoms let windowStates' = map (\w -> (w, M.lookup w windowStates)) windows @@ -517,20 +518,20 @@ getWindowStates disp screens atoms windowStates = do getWindowState' (window, Just windowState) = return (window, windowState) getWindowState' (window, Nothing) = do Xlib.selectInput disp window $ Xlib.propertyChangeMask .|. Xlib.structureNotifyMask - windowState <- getWindowState disp screens atoms window + windowState <- getWindowState disp atoms window return (window, windowState) -getWindowState :: Xlib.Display -> [Xlib.Rectangle] -> Atoms -> Window -> IO WindowState -getWindowState disp screens atoms window = do +getWindowState :: Xlib.Display -> Atoms -> Window -> IO WindowState +getWindowState disp atoms window = do (name, workspace, visible) <- getWindowInfo disp atoms window icons <- getWindowIcons disp atoms window - screen <- getWindowScreen disp screens window + geom <- getWindowGeometry disp window return $ WindowState { windowTitle = name , windowDesktop = workspace , windowVisible = visible , windowIcons = icons - , windowScreen = screen + , windowGeometry = geom } getWindowInfo :: Xlib.Display -> Atoms -> Window -> IO (String, Int, Bool) @@ -581,18 +582,12 @@ premultiply c = a .|. r .|. g .|. b b = pm bmask -getWindowScreen :: Xlib.Display -> [Xlib.Rectangle] -> Window -> IO Xlib.Rectangle -getWindowScreen disp screens window = flip catch (\_ -> return $ head screens) $ do +getWindowGeometry :: Xlib.Display -> Window -> IO Xlib.Rectangle +getWindowGeometry disp window = flip catch (\_ -> return $ Xlib.Rectangle 0 0 0 0) $ do (_, _, _, width, height, _, _) <- Xlib.getGeometry disp window (ret, x, y, _) <- Xlib.translateCoordinates disp window (Xlib.defaultRootWindow disp) 0 0 - case ret of - True -> do - let windowRect = Xlib.Rectangle x y width height - screen = maximumBy (compare `on` unionArea windowRect) screens - return screen - False -> - return $ head screens + return $ if ret then Xlib.Rectangle x y width height else Xlib.Rectangle 0 0 0 0 showWindow :: Xlib.Display -> Atoms -> Window -> IO Bool -- cgit v1.2.3