From c693ef7e8f685cbef18167393a2628ba7298e487 Mon Sep 17 00:00:00 2001 From: Norbert Zeh Date: Thu, 8 Dec 2011 21:58:42 +0100 Subject: X.A.Navigation2D Ignore-this: 3860cc71bfc08d99bd8279c2e0945186 This is a new module to support directional navigation across multiple screens. As such it is related to X.A.WindowNavigation and X.L.WindowNavigation, but it is more general. For a detailed discussion of the differences, see http://www.cs.dal.ca/~nzeh/xmonad/Navigation2D.pdf. darcs-hash:20111208205842-18a2b-588f34e94f0402a7153d5e9cae60edd322b87c1b.gz --- XMonad/Actions/Navigation2D.hs | 778 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 778 insertions(+) create mode 100644 XMonad/Actions/Navigation2D.hs (limited to 'XMonad/Actions/Navigation2D.hs') diff --git a/XMonad/Actions/Navigation2D.hs b/XMonad/Actions/Navigation2D.hs new file mode 100644 index 0000000..835512c --- /dev/null +++ b/XMonad/Actions/Navigation2D.hs @@ -0,0 +1,778 @@ +{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Navigation2D +-- Copyright : (c) 2011 Norbert Zeh +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Norbert Zeh +-- Stability : unstable +-- Portability : unportable +-- +-- Navigation2D is an xmonad extension that allows easy directional +-- navigation of windows and screens (in a multi-monitor setup). +----------------------------------------------------------------------------- + +module XMonad.Actions.Navigation2D ( -- * Usage + -- $usage + + -- * Finer points + -- $finer_points + + -- * Alternative directional navigation modules + -- $alternatives + + -- * Incompatibilities + -- $incompatibilities + + -- * Detailed technical discussion + -- $technical + + -- * Exported functions and types + -- #Exports# + + withNavigation2DConfig + , Navigation2DConfig(..) + , defaultNavigation2DConfig + , Navigation2D + , lineNavigation + , centerNavigation + , fullScreenRect + , singleWindowRect + , switchLayer + , windowGo + , windowSwap + , windowToScreen + , screenGo + , screenSwap + , Direction2D(..) + ) where + +import Control.Applicative +import qualified Data.List as L +import qualified Data.Map as M +import Data.Maybe +import XMonad hiding (Screen) +import qualified XMonad.StackSet as W +import qualified XMonad.Util.ExtensibleState as XS +import XMonad.Util.Types + +-- $usage +-- #Usage# +-- Navigation2D provides directional navigation (go left, right, up, down) for +-- windows and screens. It treats floating and tiled windows as two separate +-- layers and provides mechanisms to navigate within each layer and to switch +-- between layers. Navigation2D provides two different navigation strategies +-- (see <#Technical_Discussion> for details): /Line navigation/ feels rather +-- natural but may make it impossible to navigate to a given window from the +-- current window, particularly in the floating layer. /Center navigation/ +-- feels less natural in certain situations but ensures that all windows can be +-- reached without the need to involve the mouse. Navigation2D allows different +-- navigation strategies to be used in the two layers and allows customization +-- of the navigation strategy for the tiled layer based on the layout currently +-- in effect. +-- +-- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.Navigation2D +-- +-- Then edit your keybindings: +-- +-- > -- Switch between layers +-- > , ((modm, xK_space), switchLayers) +-- > +-- > -- Directional navigation of windows +-- > , ((modm, xK_Right), windowGo R False) +-- > , ((modm, xK_Left ), windowGo L False) +-- > , ((modm, xK_Up ), windowGo U False) +-- > , ((modm, xK_Down ), windowGo D False) +-- > +-- > -- Swap adjacent windows +-- > , ((modm .|. controlMask, xK_Right), windowSwap R False) +-- > , ((modm .|. controlMask, xK_Left ), windowSwap L False) +-- > , ((modm .|. controlMask, xK_Up ), windowSwap U False) +-- > , ((modm .|. controlMask, xK_Down ), windowSwap D False) +-- > +-- > -- Directional navigation of screens +-- > , ((modm, xK_r ), screenGo R False) +-- > , ((modm, xK_l ), screenGo L False) +-- > , ((modm, xK_u ), screenGo U False) +-- > , ((modm, xK_d ), screenGo D False) +-- > +-- > -- Swap workspaces on adjacent screens +-- > , ((modm .|. controlMask, xK_r ), screenSwap R False) +-- > , ((modm .|. controlMask, xK_l ), screenSwap L False) +-- > , ((modm .|. controlMask, xK_u ), screenSwap U False) +-- > , ((modm .|. controlMask, xK_d ), screenSwap D False) +-- > +-- > -- Send window to adjacent screen +-- > , ((modm .|. mod1Mask, xK_r ), windowToScreen R False) +-- > , ((modm .|. mod1Mask, xK_l ), windowToScreen L False) +-- > , ((modm .|. mod1Mask, xK_u ), windowToScreen U False) +-- > , ((modm .|. mod1Mask, xK_d ), windowToScreen D False) +-- +-- and add the configuration of the module to your main function: +-- +-- > main = xmonad $ withNavigation2DConfig defaultNavigation2DConfig +-- > $ defaultConfig +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- $finer_points +-- #Finer_Points# +-- The above should get you started. Here are some finer points: +-- +-- Navigation2D has the ability to wrap around at screen edges. For example, if +-- you navigated to the rightmost window on the rightmost screen and you +-- continued to go right, this would get you to the leftmost window on the +-- leftmost screen. This feature may be useful for switching between screens +-- that are far apart but may be confusing at least to novice users. Therefore, +-- it is disabled in the above example (e.g., navigation beyond the rightmost +-- window on the rightmost screen is not possible and trying to do so will +-- simply not do anything.) If you want this feature, change all the 'False' +-- values in the above example to 'True'. You could also decide you want +-- wrapping only for a subset of the operations and no wrapping for others. +-- +-- By default, all layouts use the 'defaultTiledNavigation' strategy specified +-- in the 'Navigation2DConfig' (by default, line navigation is used). To +-- override this behaviour for some layouts, add a pair (\"layout name\", +-- navigation strategy) to the 'layoutNavigation' list in the +-- 'Navigation2DConfig', where \"layout name\" is the string reported by the +-- layout's description method (normally what is shown as the layout name in +-- your status bar). For example, all navigation strategies normally allow only +-- navigation between mapped windows. The first step to overcome this, for +-- example, for the Full layout, is to switch to center navigation for the Full +-- layout: +-- +-- > myNavigation2DConfig = defaultNavigation2DConfig { layoutNavigation = [("Full", centerNavigation)] } +-- > +-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig +-- > $ defaultConfig +-- +-- The navigation between windows is based on their screen rectangles, which are +-- available /and meaningful/ only for mapped windows. Thus, as already said, +-- the default is to allow navigation only between mapped windows. However, +-- there are layouts that do not keep all windows mapped. One example is the +-- Full layout, which unmaps all windows except the one that has the focus, +-- thereby preventing navigation to any other window in the layout. To make +-- navigation to unmapped windows possible, unmapped windows need to be assigned +-- rectangles to pretend they are mapped, and a natural way to do this for the +-- Full layout is to pretend all windows occupy the full screen and are stacked +-- on top of each other so that only the frontmost one is visible. This can be +-- done as follows: +-- +-- > myNavigation2DConfig = defaultNavigation2DConfig { layoutNavigation = [("Full", centerNavigation)] +-- > , unmappedWindowRect = [("Full", singleWindowRect)] +-- > } +-- > +-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig +-- > $ defaultConfig +-- +-- With this setup, Left/Up navigation behaves like standard +-- 'XMonad.StackSet.focusUp' and Right/Down navigation behaves like +-- 'XMonad.StackSet.focusDown', thus allowing navigation between windows in the +-- layout. +-- +-- In general, each entry in the 'unmappedWindowRect' association list is a pair +-- (\"layout description\", function), where the function computes a rectangle +-- for each unmapped window from the screen it is on and the window ID. +-- Currently, Navigation2D provides only two functions of this type: +-- 'singleWindowRect' and 'fullScreenRect'. +-- +-- With per-layout navigation strategies, if different layouts are in effect on +-- different screens in a multi-monitor setup, and different navigation +-- strategies are defined for these active layouts, the most general of these +-- navigation strategies is used across all screens (because Navigation2D does +-- not distinguish between windows on different workspaces), where center +-- navigation is more general than line navigation, as discussed formally under +-- <#Technical_Discussion>. + +-- $alternatives +-- #Alternatives# +-- +-- There exist two alternatives to Navigation2D: +-- "XMonad.Actions.WindowNavigation" and "XMonad.Layout.WindowNavigation". +-- X.L.WindowNavigation has the advantage of colouring windows to indicate the +-- window that would receive the focus in each navigation direction, but it does +-- not support navigation across multiple monitors, does not support directional +-- navigation of floating windows, and has a very unintuitive definition of +-- which window receives the focus next in each direction. X.A.WindowNavigation +-- does support navigation across multiple monitors but does not provide window +-- colouring while retaining the unintuitive navigational semantics of +-- X.L.WindowNavigation. This makes it very difficult to predict which window +-- receives the focus next. Neither X.A.WindowNavigation nor +-- X.L.WindowNavigation supports directional navigation of screens. + +-- $technical +-- #Technical_Discussion# +-- An in-depth discussion of the navigational strategies implemented in +-- Navigation2D, including formal proofs of their properties, can be found +-- at . + +-- $incompatibilities +-- #Incompatibilities# +-- Currently Navigation2D is known not to play nicely with tabbed layouts, but +-- it should work well with any other tiled layout. My hope is to address the +-- incompatibility with tabbed layouts in a future version. The navigation to +-- unmapped windows, for example in a Full layout, by assigning rectangles to +-- unmapped windows is more a workaround than a clean solution. Figuring out +-- how to deal with tabbed layouts may also lead to a more general and cleaner +-- solution to query the layout for a window's rectangle that may make this +-- workaround unnecessary. At that point, the 'unmappedWindowRect' field of the +-- 'Navigation2DConfig' will disappear. + +-- | A rectangle paired with an object +type Rect a = (a, Rectangle) + +-- | A shorthand for window-rectangle pairs. Reduces typing. +type WinRect = Rect Window + +-- | A shorthand for workspace-rectangle pairs. Reduces typing. +type WSRect = Rect WorkspaceId + +---------------------------------------------------------------------------------------------------- +---------------------------------------------------------------------------------------------------- +-- -- +-- PUBLIC INTERFACE -- +-- -- +---------------------------------------------------------------------------------------------------- +---------------------------------------------------------------------------------------------------- + +-- | Encapsulates the navigation strategy +data Navigation2D = N Generality (forall a . Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a) + +runNav :: forall a . Eq a => Navigation2D -> (Direction2D -> Rect a -> [Rect a] -> Maybe a) +runNav (N _ nav) = nav + +-- | Score that indicates how general a navigation strategy is +type Generality = Int + +instance Eq Navigation2D where + (N x _) == (N y _) = x == y + +instance Ord Navigation2D where + (N x _) <= (N y _) = x <= y + +-- | Line navigation. To illustrate this navigation strategy, consider +-- navigating to the left from the current window. In this case, we draw a +-- horizontal line through the center of the current window and consider all +-- windows that intersect this horizontal line and whose right boundaries are to +-- the left of the left boundary of the current window. From among these +-- windows, we choose the one with the rightmost right boundary. +lineNavigation :: Navigation2D +lineNavigation = N 1 doLineNavigation + +-- | Center navigation. Again, consider navigating to the left. Then we +-- consider the cone bounded by the two rays shot at 45-degree angles in +-- north-west and south-west direction from the center of the current window. A +-- window is a candidate to receive the focus if its center lies in this cone. +-- We choose the window whose center has minimum L1-distance from the current +-- window center. The tie breaking strategy for windows with the same distance +-- is a bit complicated (see <#Technical_Discussion>) but ensures that all +-- windows can be reached and that windows with the same center are traversed in +-- their order in the window stack, that is, in the order +-- 'XMonad.StackSet.focusUp' and 'XMonad.StackSet.focusDown' would traverse +-- them. +centerNavigation :: Navigation2D +centerNavigation = N 2 doCenterNavigation + +-- | Stores the configuration of directional navigation +data Navigation2DConfig = Navigation2DConfig + { defaultTiledNavigation :: Navigation2D -- ^ default navigation strategy for the tiled layer + , floatNavigation :: Navigation2D -- ^ navigation strategy for the float layer + , screenNavigation :: Navigation2D -- ^ strategy for navigation between screens + , layoutNavigation :: [(String, Navigation2D)] -- ^ association list of customized navigation strategies + -- for different layouts in the tiled layer. Each pair + -- is of the form (\"layout description\", navigation + -- strategy). If there is no pair in this list whose first + -- component is the name of the current layout, the + -- 'defaultTiledNavigation' strategy is used. + , unmappedWindowRect :: [(String, Screen -> Window -> X (Maybe Rectangle))] + -- ^ list associating functions to calculate rectangles + -- for unmapped windows with layouts to which they are + -- to be applied. Each pair in this list is of + -- the form (\"layout description\", function), where the + -- function calculates a rectangle for a given unmapped + -- window from the screen it is on and its window ID. + -- See <#Finer_Points> for how to use this. + } deriving Typeable + +-- | Shorthand for the tedious screen type +type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail + +-- So we can store the configuration in extensible state +instance ExtensionClass Navigation2DConfig where + initialValue = defaultNavigation2DConfig + +-- | Modifies the xmonad configuration to store the Navigation2D configuration +withNavigation2DConfig :: Navigation2DConfig -> XConfig a -> XConfig a +withNavigation2DConfig conf2d xconf = xconf { startupHook = startupHook xconf + >> XS.put conf2d + } + +-- | Default navigation configuration. It uses line navigation for the tiled +-- layer and for navigation between screens, and center navigation for the float +-- layer. No custom navigation strategies or rectangles for unmapped windows are +-- defined for individual layouts. +defaultNavigation2DConfig :: Navigation2DConfig +defaultNavigation2DConfig = Navigation2DConfig { defaultTiledNavigation = lineNavigation + , floatNavigation = centerNavigation + , screenNavigation = lineNavigation + , layoutNavigation = [] + , unmappedWindowRect = [] + } + +-- | Switches focus to the closest window in the other layer (floating if the +-- current window is tiled, tiled if the current window is floating). Closest +-- means that the L1-distance between the centers of the windows is minimized. +switchLayer :: X () +switchLayer = actOnLayer otherLayer + ( \ _ cur wins -> windows + $ doFocusClosestWindow cur wins + ) + ( \ _ cur wins -> windows + $ doFocusClosestWindow cur wins + ) + ( \ _ _ _ -> return () ) + False + +-- | Moves the focus to the next window in the given direction and in the same +-- layer as the current window. The second argument indicates whether +-- navigation should wrap around (e.g., from the left edge of the leftmost +-- screen to the right edge of the rightmost screen). +windowGo :: Direction2D -> Bool -> X () +windowGo dir wrap = actOnLayer thisLayer + ( \ conf cur wins -> windows + $ doTiledNavigation conf dir W.focusWindow cur wins + ) + ( \ conf cur wins -> windows + $ doFloatNavigation conf dir W.focusWindow cur wins + ) + ( \ conf cur wspcs -> windows + $ doScreenNavigation conf dir W.view cur wspcs + ) + wrap + +-- | Swaps the current window with the next window in the given direction and in +-- the same layer as the current window. (In the floating layer, all that +-- changes for the two windows is their stacking order if they're on the same +-- screen. If they're on different screens, each window is moved to the other +-- window's screen but retains its position and size relative to the screen.) +-- The second argument indicates wrapping (see 'windowGo'). +windowSwap :: Direction2D -> Bool -> X () +windowSwap dir wrap = actOnLayer thisLayer + ( \ conf cur wins -> windows + $ doTiledNavigation conf dir swap cur wins + ) + ( \ conf cur wins -> windows + $ doFloatNavigation conf dir swap cur wins + ) + ( \ _ _ _ -> return () ) + wrap + +-- | Moves the current window to the next screen in the given direction. The +-- second argument indicates wrapping (see 'windowGo'). +windowToScreen :: Direction2D -> Bool -> X () +windowToScreen dir wrap = actOnScreens ( \ conf cur wspcs -> windows + $ doScreenNavigation conf dir W.shift cur wspcs + ) + wrap + +-- | Moves the focus to the next screen in the given direction. The second +-- argument indicates wrapping (see 'windowGo'). +screenGo :: Direction2D -> Bool -> X () +screenGo dir wrap = actOnScreens ( \ conf cur wspcs -> windows + $ doScreenNavigation conf dir W.view cur wspcs + ) + wrap + +-- | Swaps the workspace on the current screen with the workspace on the screen +-- in the given direction. The second argument indicates wrapping (see +-- 'windowGo'). +screenSwap :: Direction2D -> Bool -> X () +screenSwap dir wrap = actOnScreens ( \ conf cur wspcs -> windows + $ doScreenNavigation conf dir W.greedyView cur wspcs + ) + wrap + +-- | Maps each window to a fullscreen rect. This may not be the same rectangle the +-- window maps to under the Full layout or a similar layout if the layout +-- respects statusbar struts. In such cases, it may be better to use +-- 'singleWindowRect'. +fullScreenRect :: Screen -> Window -> X (Maybe Rectangle) +fullScreenRect scr _ = return (Just . screenRect . W.screenDetail $ scr) + +-- | Maps each window to the rectangle it would receive if it was the only +-- window in the layout. Useful, for example, for determining the default +-- rectangle for unmapped windows in a Full layout that respects statusbar +-- struts. +singleWindowRect :: Screen -> Window -> X (Maybe Rectangle) +singleWindowRect scr win = listToMaybe + . map snd + . fst + <$> runLayout ((W.workspace scr) { W.stack = W.differentiate [win] }) + (screenRect . W.screenDetail $ scr) + +---------------------------------------------------------------------------------------------------- +---------------------------------------------------------------------------------------------------- +-- -- +-- PRIVATE X ACTIONS -- +-- -- +---------------------------------------------------------------------------------------------------- +---------------------------------------------------------------------------------------------------- + +-- | Acts on the appropriate layer using the given action functions +actOnLayer :: ([WinRect] -> [WinRect] -> [WinRect]) -- ^ Chooses which layer to operate on, relative + -- to the current window (same or other layer) + -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the tiled layer + -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the float layer + -> (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -- ^ The action if the current workspace is empty + -> Bool -- ^ Should navigation wrap around screen edges? + -> X () +actOnLayer choice tiledact floatact wsact wrap = withWindowSet $ \winset -> do + conf <- XS.get + (floating, tiled) <- navigableWindows conf wrap winset + let cur = W.peek winset + case cur of + Nothing -> actOnScreens wsact wrap + Just w | Just rect <- L.lookup w tiled -> tiledact conf (w, rect) (choice tiled floating) + | Just rect <- L.lookup w floating -> floatact conf (w, rect) (choice floating tiled) + | otherwise -> return () + +-- | Returns the list of windows on the currently visible workspaces +navigableWindows :: Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect]) +navigableWindows conf wrap winset = L.partition (\(win, _) -> M.member win (W.floating winset)) + . addWrapping winset wrap + . catMaybes + . concat + <$> + ( mapM ( \scr -> mapM (maybeWinRect scr) + $ W.integrate' + $ W.stack + $ W.workspace scr + ) + . sortedScreens + ) winset + where + maybeWinRect scr win = do + winrect <- windowRect win + rect <- case winrect of + Just _ -> return winrect + Nothing -> maybe (return Nothing) + (\f -> f scr win) + (L.lookup (description . W.layout . W.workspace $ scr) (unmappedWindowRect conf)) + return ((,) win <$> rect) + +-- | Returns the current rectangle of the given window, Nothing if the window isn't mapped +windowRect :: Window -> X (Maybe Rectangle) +windowRect win = withDisplay $ \dpy -> do + mp <- isMapped win + if mp then do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win + return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw) + `catchX` return Nothing + else return Nothing + +-- | Acts on the screens using the given action function +actOnScreens :: (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) + -> Bool -- ^ Should wrapping be used? + -> X () +actOnScreens act wrap = withWindowSet $ \winset -> do + conf <- XS.get + let wsrects = visibleWorkspaces winset wrap + cur = W.tag . W.workspace . W.current $ winset + rect = fromJust $ L.lookup cur wsrects + act conf (cur, rect) wsrects + +-- | Determines whether a given window is mapped +isMapped :: Window -> X Bool +isMapped win = withDisplay + $ \dpy -> io + $ (waIsUnmapped /=) + . wa_map_state + <$> getWindowAttributes dpy win + +---------------------------------------------------------------------------------------------------- +---------------------------------------------------------------------------------------------------- +-- -- +-- PRIVATE PURE FUNCTIONS -- +-- -- +---------------------------------------------------------------------------------------------------- +---------------------------------------------------------------------------------------------------- + +-- | Finds the window closest to the given window and focuses it. Ties are +-- broken by choosing the first window in the window stack among the tied +-- windows. (The stack order is the one produced by integrate'ing each visible +-- workspace's window stack and concatenating these lists for all visible +-- workspaces.) +doFocusClosestWindow :: WinRect + -> [WinRect] + -> (WindowSet -> WindowSet) +doFocusClosestWindow (cur, rect) winrects + | null winctrs = id + | otherwise = W.focusWindow . fst $ L.foldl1' closer winctrs + where + ctr = centerOf rect + winctrs = filter ((cur /=) . fst) + $ map (\(w, r) -> (w, centerOf r)) winrects + closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2 + | otherwise = wc1 + +-- | Implements navigation for the tiled layer +doTiledNavigation :: Navigation2DConfig + -> Direction2D + -> (Window -> WindowSet -> WindowSet) + -> WinRect + -> [WinRect] + -> (WindowSet -> WindowSet) +doTiledNavigation conf dir act cur winrects winset + | Just win <- runNav nav dir cur winrects = act win winset + | otherwise = winset + where + layouts = map (description . W.layout . W.workspace) + $ W.screens winset + nav = maximum + $ map ( fromMaybe (defaultTiledNavigation conf) + . flip L.lookup (layoutNavigation conf) + ) + $ layouts + +-- | Implements navigation for the float layer +doFloatNavigation :: Navigation2DConfig + -> Direction2D + -> (Window -> WindowSet -> WindowSet) + -> WinRect + -> [WinRect] + -> (WindowSet -> WindowSet) +doFloatNavigation conf dir act cur winrects + | Just win <- runNav nav dir cur winrects = act win + | otherwise = id + where + nav = floatNavigation conf + +-- | Implements navigation between screens +doScreenNavigation :: Navigation2DConfig + -> Direction2D + -> (WorkspaceId -> WindowSet -> WindowSet) + -> WSRect + -> [WSRect] + -> (WindowSet -> WindowSet) +doScreenNavigation conf dir act cur wsrects + | Just ws <- runNav nav dir cur wsrects = act ws + | otherwise = id + where + nav = screenNavigation conf + +-- | Implements line navigation. For layouts without overlapping windows, there +-- is no need to break ties between equidistant windows. When windows do +-- overlap, even the best tie breaking rule cannot make line navigation feel +-- natural. Thus, we fairly arbtitrarily break ties by preferring the window +-- that comes first in the window stack. (The stack order is the one produced +-- by integrate'ing each visible workspace's window stack and concatenating +-- these lists for all visible workspaces.) +doLineNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a +doLineNavigation dir (cur, rect) winrects + | null winrects' = Nothing + | otherwise = Just . fst $ L.foldl1' closer winrects' + where + -- The current window's center + ctr@(xc, yc) = centerOf rect + + -- The list of windows that are candidates to receive focus. + winrects' = filter dirFilter + $ filter ((cur /=) . fst) + $ winrects + + -- Decides whether a given window matches the criteria to be a candidate to + -- receive the focus. + dirFilter (_, r) = (dir == L && leftOf r rect && intersectsY yc r) + || (dir == R && leftOf rect r && intersectsY yc r) + || (dir == U && above r rect && intersectsX xc r) + || (dir == D && above rect r && intersectsX xc r) + + -- Decide whether r1 is left of/above r2. + leftOf r1 r2 = rect_x r1 + fi (rect_width r1) <= rect_x r2 + above r1 r2 = rect_y r1 + fi (rect_height r1) <= rect_y r2 + + -- Check whether r's x-/y-range contains the given x-/y-coordinate. + intersectsX x r = rect_x r <= x && rect_x r + fi (rect_width r) >= x + intersectsY y r = rect_y r <= y && rect_y r + fi (rect_height r) >= y + + -- Decides whether r1 is closer to the current window's center than r2 + closer wr1@(_, r1) wr2@(_, r2) | dist ctr r1 > dist ctr r2 = wr2 + | otherwise = wr1 + + -- Returns the distance of r from the point (x, y) + dist (x, y) r | dir == L = x - rect_x r - fi (rect_width r) + | dir == R = rect_x r - x + | dir == U = y - rect_y r - fi (rect_height r) + | otherwise = rect_y r - y + +-- | Implements center navigation +doCenterNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a +doCenterNavigation dir (cur, rect) winrects + | ((w, _):_) <- onCtr' = Just w + | otherwise = closestOffCtr + where + -- The center of the current window + (xc, yc) = centerOf rect + + -- All the windows with their center points relative to the current + -- center rotated so the right cone becomes the relevant cone. + -- The windows are ordered in the order they should be preferred + -- when they are otherwise tied. + winctrs = map (\(w, r) -> (w, dirTransform . centerOf $ r)) + $ stackTransform + $ winrects + + -- Give preference to windows later in the stack for going left or up and to + -- windows earlier in the stack for going right or down. (The stack order + -- is the one produced by integrate'ing each visible workspace's window + -- stack and concatenating these lists for all visible workspaces.) + stackTransform | dir == L || dir == U = reverse + | otherwise = id + + -- Transform a point into a difference to the current window center and + -- rotate it so that the relevant cone becomes the right cone. + dirTransform (x, y) | dir == R = ( x - xc , y - yc ) + | dir == L = (-(x - xc), -(y - yc)) + | dir == D = ( y - yc , x - xc ) + | otherwise = (-(y - yc), -(x - xc)) + + -- Partition the points into points that coincide with the center + -- and points that do not. + (onCtr, offCtr) = L.partition (\(_, (x, y)) -> x == 0 && y == 0) winctrs + + -- All the points that coincide with the current center and succeed it + -- in the (appropriately ordered) window stack. + onCtr' = L.tail $ L.dropWhile ((cur /=) . fst) onCtr + -- tail should be safe here because cur should be in onCtr + + -- All the points that do not coincide with the current center and which + -- lie in the (rotated) right cone. + offCtr' = L.filter (\(_, (x, y)) -> x > 0 && y < x && y >= -x) offCtr + + -- The off-center point closest to the center and + -- closest to the bottom ray of the cone. Nothing if no off-center + -- point is in the cone + closestOffCtr = if null offCtr' then Nothing + else Just $ fst $ L.foldl1' closest offCtr' + + closest wp@(_, p@(_, yp)) wq@(_, q@(_, yq)) + | lDist (0, 0) q < lDist (0, 0) p = wq -- q is closer than p + | lDist (0, 0) p < lDist (0, 0) q = wp -- q is farther away than p + | yq < yp = wq -- q is closer to the bottom ray than p + | otherwise = wp -- q is farther away from the bottom ray than p + -- or it has the same distance but comes later + -- in the window stack + +-- | Swaps the current window with the window given as argument +swap :: Window -> WindowSet -> WindowSet +swap win winset = W.focusWindow cur + $ L.foldl' (flip W.focusWindow) newwinset newfocused + where + -- The current window + cur = fromJust $ W.peek winset + + -- All screens + scrs = W.screens winset + + -- All visible workspaces + visws = map W.workspace scrs + + -- The focused windows of the visible workspaces + focused = mapMaybe (\ws -> W.focus <$> W.stack ws) visws + + -- The window lists of the visible workspaces + wins = map (W.integrate' . W.stack) visws + + -- Update focused windows and window lists to reflect swap of windows. + newfocused = map swapWins focused + newwins = map (map swapWins) wins + + -- Replaces the current window with the argument window and vice versa. + swapWins x | x == cur = win + | x == win = cur + | otherwise = x + + -- Reconstruct the workspaces' window stacks to reflect the swap. + newvisws = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins + newscrs = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws + newwinset = winset { W.current = head newscrs + , W.visible = tail newscrs + } + +-- | Calculates the center of a rectangle +centerOf :: Rectangle -> (Position, Position) +centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r) `div` 2) + +-- | Shorthand for integer conversions +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral + +-- | Functions to choose the subset of windows to operate on +thisLayer, otherLayer :: a -> a -> a +thisLayer = curry fst +otherLayer = curry snd + +-- | Returns the list of visible workspaces and their screen rects +visibleWorkspaces :: WindowSet -> Bool -> [WSRect] +visibleWorkspaces winset wrap = addWrapping winset wrap + $ map ( \scr -> ( W.tag . W.workspace $ scr + , screenRect . W.screenDetail $ scr + ) + ) + $ sortedScreens winset + +-- | Creates five copies of each (window/workspace, rect) pair in the input: the +-- original and four offset one desktop size (desktop = collection of all +-- screens) to the left, to the right, up, and down. Wrap-around at desktop +-- edges is implemented by navigating into these displaced copies. +addWrapping :: WindowSet -- ^ The window set, used to get the desktop size + -> Bool -- ^ Should wrapping be used? Do nothing if not. + -> [Rect a] -- ^ Input set of (window/workspace, rect) pairs + -> [Rect a] +addWrapping _ False wrects = wrects +addWrapping winset True wrects = [ (w, r { rect_x = rect_x r + fi x + , rect_y = rect_y r + fi y + } + ) + | (w, r) <- wrects + , (x, y) <- [(0, 0), (-xoff, 0), (xoff, 0), (0, -yoff), (0, yoff)] + ] + where + (xoff, yoff) = wrapOffsets winset + +-- | Calculates the offsets for window/screen coordinates for the duplication +-- of windows/workspaces that implements wrap-around. +wrapOffsets :: WindowSet -> (Integer, Integer) +wrapOffsets winset = (max_x - min_x, max_y - min_y) + where + min_x = fi $ minimum $ map rect_x rects + min_y = fi $ minimum $ map rect_y rects + max_x = fi $ maximum $ map (\r -> rect_x r + (fi $ rect_width r)) rects + max_y = fi $ maximum $ map (\r -> rect_y r + (fi $ rect_height r)) rects + rects = map snd $ visibleWorkspaces winset False + + +-- | Returns the list of screens sorted primarily by their centers' +-- x-coordinates and secondarily by their y-coordinates. +sortedScreens :: WindowSet -> [Screen] +sortedScreens winset = L.sortBy cmp + $ W.screens winset + where + cmp s1 s2 | x1 < x2 = LT + | x1 > x2 = GT + | y1 < x2 = LT + | y1 > y2 = GT + | otherwise = EQ + where + (x1, y1) = centerOf (screenRect . W.screenDetail $ s1) + (x2, y2) = centerOf (screenRect . W.screenDetail $ s2) + + +-- | Calculates the L1-distance between two points. +lDist :: (Position, Position) -> (Position, Position) -> Int +lDist (x1, y1) (x2, y2) = abs (fi $ x1 - x2) + abs (fi $ y1 - y2) -- cgit v1.2.3