diff --git a/CHANGES.md b/CHANGES.md index cafcfe41b..2798f4621 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -92,6 +92,11 @@ - Added screen edge support with `SCTop`, `SCBottom`, `SCLeft` and `SCRight`. Now both corners and edges are supported. + * `XMonad.Actions.WindowNavigation` + + - Improve navigation in presence of floating windows. + - Handle window switching when in `Full` layout. + ### Other changes ## 0.18.0 (February 3, 2024) diff --git a/XMonad/Actions/WindowNavigation.hs b/XMonad/Actions/WindowNavigation.hs index b88970426..e701d080a 100644 --- a/XMonad/Actions/WindowNavigation.hs +++ b/XMonad/Actions/WindowNavigation.hs @@ -1,10 +1,12 @@ +{-# LANGUAGE TupleSections #-} -- I didn't want this, it's hlint's "suggestion" and it's apparently non-negotiable ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.WindowNavigation -- Description : Experimental rewrite of "XMonad.Layout.WindowNavigation". -- Copyright : (c) 2007 David Roundy , -- Devin Mullins --- Maintainer : Devin Mullins +-- Maintainer : Devin Mullins , +-- Platon Pronko -- License : BSD3-style (see LICENSE) -- Stability : unstable -- Portability : unportable @@ -37,17 +39,19 @@ module XMonad.Actions.WindowNavigation ( withWindowNavigationKeys, WNAction(..), go, swap, + goPure, swapPure, Direction2D(..), WNState, ) where -import XMonad -import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortOn) +import XMonad hiding (state) +import XMonad.Prelude (catMaybes, fromMaybe, sortOn) import XMonad.Util.Types (Direction2D(..)) import qualified XMonad.StackSet as W import Control.Arrow (second) import Data.IORef import Data.Map (Map()) +import Data.List (partition, find) import qualified Data.Map as M import qualified Data.Set as S @@ -101,27 +105,60 @@ withWindowNavigation (u,l,d,r) conf@XConfig{modMask=modm} = withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l) withWindowNavigationKeys wnKeys conf = do - posRef <- newIORef M.empty - return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys) + stateRef <- newIORef M.empty + return conf { keys = \cnf -> M.fromList (map (second (fromWNAction stateRef)) wnKeys) `M.union` keys conf cnf, - logHook = logHook conf >> trackMovement posRef } - where fromWNAction posRef (WNGo dir) = go posRef dir - fromWNAction posRef (WNSwap dir) = swap posRef dir + logHook = logHook conf >> trackMovement stateRef } + where fromWNAction stateRef (WNGo dir) = go stateRef dir + fromWNAction stateRef (WNSwap dir) = swap stateRef dir data WNAction = WNGo Direction2D | WNSwap Direction2D type WNState = Map WorkspaceId Point --- go: --- 1. get current position, verifying it matches the current window --- 2. get target windowrect --- 3. focus window --- 4. set new position +-- | Focus window in the given direction. go :: IORef WNState -> Direction2D -> X () -go = withTargetWindow W.focusWindow +go stateRef dir = runPureAction stateRef (goPure dir) +-- | Swap current window with the window in the given direction. +-- Note: doesn't work with floating windows (don't think it makes much sense to swap floating windows). swap :: IORef WNState -> Direction2D -> X () -swap = withTargetWindow swapWithFocused +swap stateRef dir = runPureAction stateRef (swapPure dir) + +type WindowRectFn x = (Window -> x (Maybe Rectangle)) +-- | (state, oldWindowSet, mappedWindows, windowRect) +type WNInput x = (WNState, WindowSet, S.Set Window, WindowRectFn x) +type WNOutput = (WNState, WindowSet) + +-- | Run the pure action inside X monad. +runPureAction :: IORef WNState -> (WNInput X -> X WNOutput) -> X () +runPureAction stateRef action = do + oldState <- io (readIORef stateRef) + oldWindowSet <- gets windowset + mappedWindows <- gets mapped + (newState, newWindowSet) <- action (oldState, oldWindowSet, mappedWindows, windowRectX) + windows (const newWindowSet) + io $ writeIORef stateRef newState + +-- | Version of `go` not dependent on X monad (needed for testing). +goPure :: Monad x => Direction2D -> WNInput x -> x WNOutput +goPure dir input@(oldState, oldWindowSet, mappedWindows, _) = + if length (filter (`S.member` mappedWindows) $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet) == 1 + then + -- Handle the special case of Full layout, when there's only one mapped window on a screen. + return ( oldState + , case dir of + U -> W.focusUp oldWindowSet + L -> W.focusDown oldWindowSet + D -> W.focusDown oldWindowSet + R -> W.focusUp oldWindowSet + ) + else + withTargetWindow W.focusWindow dir input + +-- | Version of `swap` not dependent on X monad (needed for testing). +swapPure :: Monad x => Direction2D -> WNInput x -> x WNOutput +swapPure = withTargetWindow swapWithFocused where swapWithFocused targetWin winSet = case W.peek winSet of Just currentWin -> W.focusWindow currentWin $ @@ -135,87 +172,249 @@ swap = withTargetWindow swapWithFocused | win == win2 = win1 | otherwise = win -withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X () -withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do - targets <- filter ((/= win) . fst) <$> navigableTargets pos dir - whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do - windows (adj targetWin) - setPosition posRef pos targetRect +-- | Select a target window in the given direction and modify the WindowSet. +-- 1. Get current position, verifying it matches the current window (exit if no focused window). +-- 2. Get the target window. +-- 3. Execute an action on the target window and windowset. +-- 4. Set the new position. +withTargetWindow :: Monad x => (Window -> WindowSet -> WindowSet) -> Direction2D -> WNInput x -> x WNOutput +withTargetWindow adj dir input@(oldState, oldWindowSet, _, _) = do + whenJust' (getCurrentWindow input) (oldState, oldWindowSet) $ \(win, winRect, pos) -> do + targetMaybe <- find ((/= win) . fst) <$> navigableTargets input dir winRect pos + whenJust' (pure targetMaybe) (oldState, oldWindowSet) $ \(targetWin, newPos) -> + let newWindowSet = adj targetWin oldWindowSet + in return (modifyState newWindowSet newPos oldState, newWindowSet) +-- | Update position on outside changes in windows. trackMovement :: IORef WNState -> X () -trackMovement posRef = fromCurrentPoint posRef $ \win pos -> - windowRect win >>= flip whenJust (setPosition posRef pos . snd) - -fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X () -fromCurrentPoint posRef f = withFocused $ \win -> - currentPosition posRef >>= f win - --- Gets the current position from the IORef passed in, or if nothing (say, from --- a restart), derives the current position from the current window. Also, --- verifies that the position is congruent with the current window (say, if you --- used mod-j/k or mouse or something). -currentPosition :: IORef WNState -> X Point -currentPosition posRef = do - root <- asks theRoot - currentWindow <- gets (W.peek . windowset) - currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow) - - wsid <- gets (W.currentTag . windowset) - mp <- M.lookup wsid <$> io (readIORef posRef) - - return $ maybe (middleOf currentRect) (`inside` currentRect) mp - - where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h) - -setPosition :: IORef WNState -> Point -> Rectangle -> X () -setPosition posRef oldPos newRect = do - wsid <- gets (W.currentTag . windowset) - io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect) - -inside :: Point -> Rectangle -> Point -Point x y `inside` Rectangle rx ry rw rh = - Point (x `within` (rx, rw)) (y `within` (ry, rh)) - where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim - then pos - else midPoint lower dim +trackMovement stateRef = do + oldState <- io (readIORef stateRef) + oldWindowSet <- gets windowset + mappedWindows <- gets mapped + whenJust' (getCurrentWindow (oldState, oldWindowSet, mappedWindows, windowRectX)) () $ \(_, _, pos) -> do + io $ writeIORef stateRef $ modifyState oldWindowSet pos oldState + +-- | Get focused window and current position. +getCurrentWindow :: Monad x => WNInput x -> x (Maybe (Window, Rectangle, Point)) +getCurrentWindow input@(_, oldWindowSet, _, _) = + whenJust' (pure $ W.peek oldWindowSet) Nothing $ \window -> do + (pos, rect) <- currentPosition input + return $ Just (window, rect, pos) + +-- | Gets the current position from the state passed in, or if nothing +-- (say, from a restart), derives the current position from the current window. +-- Also, verifies that the position is congruent with the current window +-- (say, if you moved focus using mouse or something). +-- Returns the window rectangle for convenience, since we'll need it later anyway. +currentPosition :: Monad x => WNInput x -> x (Point, Rectangle) +currentPosition (state, oldWindowSet, _, windowRect) = do + currentRect <- fromMaybe (Rectangle 0 0 0 0) <$> maybe (pure Nothing) windowRect (W.peek oldWindowSet) + let posMaybe = M.lookup (W.currentTag oldWindowSet) state + middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h) + return $ case posMaybe of + Nothing -> (middleOf currentRect, currentRect) + Just pos -> (centerPosition currentRect pos, currentRect) + +-- | Inserts new position into the state. +modifyState :: WindowSet -> Point -> WNState -> WNState +modifyState oldWindowSet = + M.insert (W.currentTag oldWindowSet) + +-- | "Jumps" the current position into the middle of target rectangle. +-- (keeps the position as-is if it is already inside the target rectangle) +centerPosition :: Rectangle -> Point -> Point +centerPosition r@(Rectangle rx ry rw rh) pos@(Point x y) = do + if pointWithin x y r + then pos + else Point (midPoint rx rw) (midPoint ry rh) midPoint :: Position -> Dimension -> Position midPoint pos dim = pos + fromIntegral dim `div` 2 -navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)] -navigableTargets point dir = navigable dir point <$> windowRects +-- | Make a list of target windows we can navigate to, +-- sorted by desirability of navigation. +navigableTargets :: Monad x => WNInput x -> Direction2D -> Rectangle -> Point -> x [(Window, Point)] +navigableTargets input@(_, oldWindowSet, _, _) dir currentRect currentPos = do + allScreensWindowsAndRectangles <- mapSnd (rectTransform dir) <$> windowRects input + let + screenWindows = S.fromList $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet + (thisScreenWindowsAndRectangles, otherScreensWindowsAndRectangles) = partition (\(w, _) -> S.member w screenWindows) allScreensWindowsAndRectangles + + pos = pointTransform dir currentPos + wr = rectTransform dir currentRect + + rectInside r = (rect_p1 r >= rect_p1 wr && rect_p1 r < rect_p2 wr && rect_p2 r > rect_p1 wr && rect_p2 r <= rect_p2 wr) && + ((rect_o1 r >= rect_o1 wr && rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr && rect_o2 r <= rect_o2 wr) || + (rect_o1 r <= rect_o1 wr && rect_o2 r >= rect_o2 wr)) -- include windows that fully overlaps current on the orthogonal axis + sortByP2 = sortOn (rect_p2 . snd) + posBeforeEdge r = point_p pos < rect_p2 r + + rectOverlapsEdge r = rect_p1 r <= rect_p2 wr && rect_p2 r > rect_p2 wr && + rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr + rectOverlapsOneEdge r = rectOverlapsEdge r && rect_p1 r > rect_p1 wr + rectOverlapsBothEdges r = rectOverlapsEdge r && + rect_o1 r > rect_o1 wr && rect_o2 r < rect_o2 wr && point_o pos >= rect_o1 r && point_o pos < rect_o2 r + distanceToRectEdge r = max (max 0 (rect_o1 r - point_o pos)) (max 0 (point_o pos + 1 - rect_o2 r)) + distanceToRectCenter r = + let distance = (rect_o1 r + rect_o2 r) `div` 2 - point_o pos + in if distance <= 0 + then distance + 1 + else distance + sortByPosDistance = sortOn ((\r -> (rect_p1 r, distanceToRectEdge r, distanceToRectCenter r)) . snd) + + rectOutside r = rect_p1 r < rect_p1 wr && rect_p2 r > rect_p2 wr && + rect_o1 r < rect_o1 wr && rect_o2 r > rect_o2 wr + sortByLength = sortOn (rect_psize . snd) + + rectAfterEdge r = rect_p1 r > rect_p2 wr + + -- Modified from David Roundy and Devin Mullins original implementation of WindowNavigation: + inr r = point_p pos < rect_p2 r && point_o pos >= rect_o1 r && point_o pos < rect_o2 r --- Filters and sorts the windows in terms of what is closest from the Point in --- the Direction2D. -navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] -navigable d pt = sortby d . filter (inr d pt . snd) + clamp v v1 v2 | v < v1 = v1 + | v >= v2 = v2 - 1 + | otherwise = v + dragPos r = DirPoint (max (point_p pos) (rect_p1 r)) (clamp (point_o pos) (rect_o1 r) (rect_o2 r)) --- Produces a list of normal-state windows, on any screen. Rectangles are --- adjusted based on screen position relative to the current screen, because I'm --- bad like that. -windowRects :: X [(Window, Rectangle)] -windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped + return $ mapSnd (inversePointTransform dir) $ concat + [ + -- First, navigate to windows that are fully inside current window + -- and have higher coordinate bigger than current position. + -- ┌──────────────────┐ + -- │ current │ (all examples assume direction=R) + -- │ ┌──────────┐ │ + -- │ ──┼─► inside │ │ + -- │ └──────────┘ │ + -- └──────────────────┘ + -- Also include windows fully overlapping current on the orthogonal axis: + -- ┌──────────────┐ + -- │ overlapping │ + -- ┌───────────┤ ├────┐ + -- │ current ──┼─► │ │ + -- └───────────┤ ├────┘ + -- └──────────────┘ + mapSnd dragPos $ sortByP2 $ filterSnd posBeforeEdge $ filterSnd rectInside thisScreenWindowsAndRectangles -windowRect :: Window -> X (Maybe (Window, Rectangle)) -windowRect win = withDisplay $ \dpy -> do + -- Then navigate to windows that touch or overlap the edge of current window in the chosen direction. + -- ┌──────────────┬─────────────┐ ┌───────────┐ ┌─────────────┐ + -- │ current │ adjacent │ │ current │ │ current │ + -- │ ──┼─► │ │ ┌───┴───────────────┐ │ ┌───┴─────────────┐ + -- │ │ │ │ ──┼─► │ overlapping │ │ ──┼─► │ + -- │ ├─────────────┘ │ └───┬───────────────┘ └─────────┤ overlapping │ + -- │ │ │ │ │ │ + -- └──────────────┘ └───────────┘ └─────────────────┘ + , mapSnd dragPos $ sortByPosDistance $ filterSnd rectOverlapsOneEdge thisScreenWindowsAndRectangles + + -- Windows fully overlapping current window "in the middle" on the parallel axis are also included, + -- if position is inside them: + -- ┌───────────┐ + -- │ current │ + -- ┌───┤-----------├────────────────┐ + -- │ │ * ──┼─► overlapping │ + -- └───┤-----------├────────────────┘ + -- └───────────┘ + , mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByPosDistance $ filterSnd rectOverlapsBothEdges thisScreenWindowsAndRectangles + + -- Then navigate to windows that fully encompass the current window. + -- ┌─────────────────────┐ + -- │ outer │ + -- │ ┌─────────────┐ │ + -- │ │ current ──┼─► │ + -- │ └─────────────┘ │ + -- └─────────────────────┘ + , mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByLength $ filterSnd rectOutside thisScreenWindowsAndRectangles + + -- Then navigate to windows that are fully after current window in the chosen direction. + -- ┌──────────────┐ + -- │ current │ ┌────────────────┐ + -- │ │ │ │ + -- │ ──┼──┼─► not adjacent │ + -- │ │ │ │ + -- │ │ └────────────────┘ + -- └──────────────┘ + , mapSnd dragPos $ sortByPosDistance $ filterSnd rectAfterEdge thisScreenWindowsAndRectangles + + -- Cast a ray from the current position, jump to the first window (on another screen) that intersects this ray. + , mapSnd dragPos $ sortByPosDistance $ filterSnd inr otherScreensWindowsAndRectangles + + -- If everything else fails, then navigate to the window that is fully inside current window, + -- but is before the current position. + -- This can happen when we are at the last window on a screen, and attempt to navigate even further. + -- In this case it seems okay to jump to the remaining inner windows, since we don't have any other choice anyway, + -- and user is probably not so fully aware of the precise position anyway. + , mapSnd (\r -> DirPoint (rect_p2 r - 1) (clamp (point_o pos) (rect_o1 r) (rect_o2 r))) $ + sortByP2 $ filterSnd (not . posBeforeEdge) $ filterSnd rectInside thisScreenWindowsAndRectangles + ] + +-- Structs for direction-independent space - equivalent to rotating points and rectangles such that +-- navigation direction points to the right. +-- Allows us to abstract over direction in the navigation functions. +data DirPoint = DirPoint + { point_p :: Position -- coordinate parallel to the direction + , point_o :: Position -- coordinate orthogonal to the direction + } +data DirRectangle = DirRectangle + { rect_p1 :: Position -- lower rectangle coordinate parallel to the direction + , rect_p2 :: Position -- higher rectangle coordinate parallel to the direction + , rect_o1 :: Position -- lower rectangle coordinate orthogonal to the direction + , rect_o2 :: Position -- higher rectangle coordinate orthogonal to the direction + } +{- HLINT ignore "Use camelCase" -} +rect_psize :: DirRectangle -> Dimension +rect_psize r = fromIntegral (rect_p2 r - rect_p1 r) + +-- | Transform a point from screen space into direction-independent space. +pointTransform :: Direction2D -> Point -> DirPoint +pointTransform dir (Point x y) = case dir of + U -> DirPoint (negate y - 1) x + L -> DirPoint (negate x - 1) (negate y - 1) + D -> DirPoint y (negate x - 1) + R -> DirPoint x y + +-- | Transform a point from direction-independent space back into screen space. +inversePointTransform :: Direction2D -> DirPoint -> Point +inversePointTransform dir p = case dir of + U -> Point (point_o p) (negate $ point_p p + 1) + L -> Point (negate $ point_p p + 1) (negate $ point_o p + 1) + D -> Point (negate $ point_o p + 1) (point_p p) + R -> Point (point_p p) (point_o p) + +-- | Transform a rectangle from screen space into direction-independent space. +rectTransform :: Direction2D -> Rectangle -> DirRectangle +rectTransform dir (Rectangle x y w h) = case dir of + U -> DirRectangle (negate $ y + fromIntegral h) (negate y) x (x + fromIntegral w) + L -> DirRectangle (negate $ x + fromIntegral w) (negate x) (negate $ y + fromIntegral h) (negate y) + D -> DirRectangle y (y + fromIntegral h) (negate $ x + fromIntegral w) (negate x) + R -> DirRectangle x (x + fromIntegral w) y (y + fromIntegral h) + +-- | Produces a list of normal-state windows on all screens, excluding currently focused window. +windowRects :: Monad x => WNInput x -> x [(Window, Rectangle)] +windowRects (_, oldWindowSet, mappedWindows, windowRect) = + let + allWindows = filter (\w -> w `notElem` W.peek oldWindowSet) $ S.toList mappedWindows + windowRect2 w = fmap (w,) <$> windowRect w + in catMaybes <$> mapM windowRect2 allWindows + +windowRectX :: Window -> X (Maybe Rectangle) +windowRectX win = withDisplay $ \dpy -> do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win - return $ Just (win, Rectangle x y (w + 2 * bw) (h + 2 * bw)) + return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw) `catchX` return Nothing --- Modified from droundy's implementation of WindowNavigation: - -inr :: Direction2D -> Point -> Rectangle -> Bool -inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w && - py < ry + fromIntegral h -inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w && - py > ry -inr R (Point px py) (Rectangle rx ry w h) = px < rx + fromIntegral w && - py >= ry && py < ry + fromIntegral h -inr L (Point px py) (Rectangle rx ry _ h) = px > rx && - py >= ry && py < ry + fromIntegral h - -sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)] -sortby D = sortOn (rect_y . snd) -sortby R = sortOn (rect_x . snd) -sortby U = reverse . sortby D -sortby L = reverse . sortby R +-- Maybe below functions can be replaced with some standard helper functions? + +-- | Execute a monadic action on the contents if Just, otherwise wrap default value and return it. +whenJust' :: Monad x => x (Maybe a) -> b -> (a -> x b) -> x b +whenJust' monadMaybeValue deflt f = do + maybeValue <- monadMaybeValue + case maybeValue of + Nothing -> return deflt + Just value -> f value + +-- | Filter a list of tuples on the second tuple member. +filterSnd :: (b -> Bool) -> [(a, b)] -> [(a, b)] +filterSnd f = filter (f . snd) + +-- | Map a second tuple member in a list of tuples. +mapSnd :: (b -> b') -> [(a, b)] -> [(a, b')] +mapSnd f = map (second f) diff --git a/tests/Main.hs b/tests/Main.hs index 813ba921f..35fc8d778 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -14,6 +14,7 @@ import qualified CycleRecentWS import qualified OrgMode import qualified GridSelect import qualified EZConfig +import qualified WindowNavigation main :: IO () main = hspec $ do @@ -53,3 +54,4 @@ main = hspec $ do context "OrgMode" OrgMode.spec context "GridSelect" GridSelect.spec context "EZConfig" EZConfig.spec + context "WindowNavigation" WindowNavigation.spec diff --git a/tests/WindowNavigation.hs b/tests/WindowNavigation.hs new file mode 100644 index 000000000..1176dcac1 --- /dev/null +++ b/tests/WindowNavigation.hs @@ -0,0 +1,635 @@ +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module WindowNavigation where + +import Test.Hspec + +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Functor.Identity + +import XMonad +import XMonad.Util.Types (Direction2D(..)) +import XMonad.Actions.WindowNavigation (goPure, swapPure, WNState) +import qualified XMonad.StackSet as W + +spec :: Spec +spec = do + it "two-window adjacent go right (empty state)" $ do + -- Simplest case - just move the focus once. + -- ┌─────┬──────┐ + -- │ 1 ──┼─► 2 │ + -- └─────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect) + runNav R M.empty (mkws 1 [] [2]) + `shouldBe` (mkstate 960 640, mkws 2 [1] []) + + it "two-window adjacent go right (populated state)" $ do + -- Like the previous test, but this time internal stat is already populated with a position. + -- ┌─────┬──────┐ + -- │ 1 ──┼─► 2 │ + -- └─────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect) + runNav R (mkstate 100 100) (mkws 1 [] [2]) + `shouldBe` (mkstate 960 100, mkws 2 [1] []) + + it "two-window adjacent go right (incorrectly-populated state)" $ do + -- This time we set the position incorrectly, testing if it will be reset to the center of focused window. + -- ┌─────┬──────┐ + -- │ 1 ──┼─► 2 │ + -- └─────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect) + runNav R (mkstate 1000 100) (mkws 1 [] [2]) + `shouldBe` (mkstate 960 640, mkws 2 [1] []) + + it "swap windows" $ do + -- Swap windows around. + -- ┌─────┬──────┐ + -- │ 1 ◄─┼─► 2 │ + -- └─────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + ] + runIdentity (swapPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect)) + `shouldBe` (mkstate 960 640, mkws 1 [2] []) + + it "tall layout, go up" $ do + -- ┌─────┬─────┐ + -- │ │ 2 ▲ │ + -- │ 1 ├───┼─┤ + -- │ │ 3 │ │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 640) + , (3, Rectangle 960 640 960 640) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2, 3], windowRect) + runNav U M.empty (mkws 3 [] [1, 2]) + `shouldBe` (mkstate 1440 639, mkws 2 [1, 3] []) + + it "tall layout, go down" $ do + -- ┌─────┬─────┐ + -- │ │ 2 │ + -- │ ├─────┤ + -- │ 1 │ 3 │ │ + -- │ ├───┼─┤ + -- │ │ 4 ▼ │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + runNav D M.empty (mkws 3 [] [1, 2, 4]) + `shouldBe` (mkstate 1440 800, mkws 4 [2, 1, 3] []) + + it "tall layout, go left" $ do + -- ┌─────┬─────┐ + -- │ ◄─┼── 2 │ + -- │ ├─────┤ + -- │ 1 │ 3 │ + -- │ ├─────┤ + -- │ │ 4 │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + runNav L M.empty (mkws 2 [] [1, 3, 4]) + `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4]) + + it "tall layout, go left and then right (window 2)" $ do + -- ┌─────┬─────┐ + -- │ ◄─┼── 2 │ + -- │ ──┼─► │ + -- │ ├─────┤ + -- │ 1 │ 3 │ + -- │ ├─────┤ + -- │ │ 4 │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav L M.empty (mkws 2 [] [1, 3, 4]) + (st2, ws2) `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4]) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 960 200, mkws 2 [] [1, 3, 4]) + + it "tall layout, go left and then right (window 3)" $ do + -- ┌─────┬─────┐ + -- │ │ 2 │ + -- │ ├─────┤ + -- │ 1 ◄─┼── 3 │ + -- │ ──┼─► │ + -- │ ├─────┤ + -- │ │ 4 │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav L M.empty (mkws 3 [] [1, 2, 4]) + (st2, ws2) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4]) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 960 600, mkws 3 [] [1, 2, 4]) + + it "tall layout, go left and then right (window 4)" $ do + -- ┌─────┬─────┐ + -- │ │ 2 │ + -- │ ├─────┤ + -- │ 1 │ 3 │ + -- │ ├─────┤ + -- │ ◄─┼── 4 │ + -- │ ──┼─► │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav L M.empty (mkws 4 [] [1, 2, 3]) + (st2, ws2) `shouldBe` (mkstate 959 1040, mkws 1 [4] [2, 3]) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 960 1040, mkws 4 [] [1, 2, 3]) + + it "grid layout, go in a circle" $ do + -- ┌─────┬─────┐ + -- │ 1 ──┼─► 2 │ + -- │ │ │ + -- │ ▲ │ │ │ + -- ├─┼───┼───┼─┤ + -- │ │ │ ▼ │ + -- │ │ │ + -- │ 3 ◄─┼── 4 │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 640) + , (2, Rectangle 960 0 960 640) + , (3, Rectangle 0 640 960 640) + , (4, Rectangle 960 640 960 640) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3, 4]) + (st2, ws2) `shouldBe` (mkstate 960 320, mkws 2 [1] [3, 4]) + let (st3, ws3) = runNav D st2 ws2 + (st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [3, 2, 1] []) + let (st4, ws4) = runNav L st3 ws3 + (st4, ws4) `shouldBe` (mkstate 959 640, mkws 3 [2, 1] [4]) + let (st5, ws5) = runNav U st4 ws4 + (st5, ws5) `shouldBe` (mkstate 959 639, mkws 1 [] [2, 3, 4]) + + it "ignore window that fully overlaps the current window in parallel direction when pos is outside it" $ do + -- ┌─────┬──────┬──────┐ + -- │ ┌───┴──────┴────┐ │ + -- │ │ | 4 | │ │ + -- │ └───┬──────┬────┘ │ + -- │ 1 │ 2 ──┼─► 3 │ + -- └─────┴──────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 600 1280) + , (2, Rectangle 600 0 600 1280) + , (3, Rectangle 1200 0 720 1280) + , (4, Rectangle 200 200 1520 400) + ] + runIdentity (goPure R (mkstate 900 900, mkws 2 [] [1, 3, 4], S.fromList [1..4], windowRect)) + `shouldBe` (mkstate 1200 900, mkws 3 [1,2] [4]) + + it "go to window that fully overlaps the current window in parallel direction when pos is inside it" $ do + -- ┌─────────────────┐ + -- │ ┌──────┐ │ + -- │ 1 │ │ │ + -- ├─────┤------├────┤ + -- │ │ │ │ + -- │ 2 │ 4 ──┼─► │ + -- │ │ │ │ + -- ├─────┤------├────┤ + -- │ 3 │ │ │ + -- │ └──────┘ │ + -- └─────────────────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 1920 400) + , (2, Rectangle 0 400 1920 400) + , (3, Rectangle 0 800 1920 480) + , (4, Rectangle 800 200 400 880) + ] + runIdentity (goPure R (mkstate 1000 600, mkws 4 [] [1, 2, 3], S.fromList [1..4], windowRect)) + `shouldBe` (mkstate 1200 600, mkws 2 [1,4] [3]) + + it "go from inner window to outer" $ do + -- ┌───────────────┐ + -- │ ┌──────┐ │ + -- │ 1 ◄─┼── 2 │ │ + -- │ └──────┘ │ + -- └───────────────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 1920 1280) + , (2, Rectangle 600 600 600 600) + ] + runIdentity (goPure L (M.empty, mkws 2 [] [1], S.fromList [1, 2], windowRect)) + `shouldBe` (mkstate 599 900, mkws 1 [2] []) + + it "if there are multiple outer windows, go to the smaller one" $ do + -- ┌────────────────────────┐ + -- │ ┌───────────────┐ │ + -- │ │ ┌──────┐ │ │ + -- │ │ 2 ◄─┼── 3 │ │ 1 │ + -- │ │ └──────┘ │ │ + -- │ └───────────────┘ │ + -- └────────────────────────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 1920 1280) + , (2, Rectangle 200 200 1520 880) + , (3, Rectangle 400 400 400 400) + ] + runIdentity (goPure L (M.empty, mkws 3 [] [1, 2], S.fromList [1..3], windowRect)) + `shouldBe` (mkstate 399 600, mkws 2 [1, 3] []) + + it "two tiled and one floating, floating fully inside" $ do + -- ┌───────────────────┬─────┐ + -- │ ┌───────┐ │ │ + -- │ ──┼─► ──┼─► ──┼─► │ + -- │ │ 3 │ 1 │ 2 │ + -- │ │ ◄─┼── ◄─┼── │ + -- │ └───────┘ │ │ + -- └───────────────────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + , (3, Rectangle 400 400 400 400) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect) + let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3]) + (st2, ws2) `shouldBe` (mkstate 400 400, mkws 3 [2, 1] []) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 800 400, mkws 1 [] [2, 3]) + let (st4, ws4) = runNav R st3 ws3 + (st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1] [3]) + let (st5, ws5) = runNav L st4 ws4 + (st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [] [2, 3]) + let (st6, ws6) = runNav L st5 ws5 + (st6, ws6) `shouldBe` (mkstate 799 400, mkws 3 [2, 1] []) + + it "two floating windows inside one big tiled one" $ do + -- ┌─────────┐ + -- │ │ │ + -- │ ┌──┼──┐ │ + -- │ │ ▼ │ │ + -- │ │ 3 │ │ + -- │ └──┼──┘ │ + -- │ ▼ │ + -- │ 1 │ + -- │ ┌──┼──┐ │ + -- │ │ ▼ │ │ + -- │ │ 4 │ │ + -- │ └──┼──┘ │ + -- │ ▼ │ + -- ├────┼────┤ + -- │ ▼ │ + -- │ 2 │ + -- └─────────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 1920 640) + , (2, Rectangle 0 640 1920 640) + , (3, Rectangle 200 200 100 100) + , (4, Rectangle 1000 400 100 100) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav D (mkstate 1000 250) (mkws 1 [] [2, 3, 4]) + (st2, ws2) `shouldBe` (mkstate 299 250, mkws 3 [2, 1] [4]) + let (st3, ws3) = runNav D st2 ws2 + (st3, ws3) `shouldBe` (mkstate 299 300, mkws 1 [] [2, 3, 4]) + let (st4, ws4) = runNav D st3 ws3 + (st4, ws4) `shouldBe` (mkstate 1000 400, mkws 4 [3, 2, 1] []) + let (st5, ws5) = runNav D st4 ws4 + (st5, ws5) `shouldBe` (mkstate 1000 500, mkws 1 [] [2, 3, 4]) + let (st6, ws6) = runNav D st5 ws5 + (st6, ws6) `shouldBe` (mkstate 1000 640, mkws 2 [1] [3, 4]) + + it "floating window between two tiled ones" $ do + -- ┌───────┬────────┐ + -- │ 1 ┌───┴───┐ 2 │ + -- │ ──┼─► 3 ──┼─► │ + -- │ └───┬───┘ │ + -- └───────┴────────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + , (3, Rectangle 860 540 200 200) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect) + let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3]) + (st2, ws2) `shouldBe` (mkstate 860 640, mkws 3 [2, 1] []) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 960 640, mkws 2 [1] [3]) + + it "floating window overlapping four tiled ones" $ do + -- ┌───────┬───────┐ + -- │ ┌───┴───┐ │ + -- │ 1 │ │ 2 │ + -- ├───┤ ├───┤ + -- │ ──┼─► 5 ──┼─► │ + -- │ 3 └───┬───┘ 4 │ + -- └───────┴───────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 640) + , (2, Rectangle 960 0 960 640) + , (3, Rectangle 0 640 960 640) + , (4, Rectangle 960 640 960 640) + , (5, Rectangle 760 440 400 400) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect) + let (st2, ws2) = runNav R (mkstate 480 640) (mkws 3 [] [1, 2, 4, 5]) + (st2, ws2) `shouldBe` (mkstate 760 640, mkws 5 [4, 2, 1, 3] []) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [2, 1, 3] [5]) + + it "sequential inner floating windows" $ do + -- ┌───────────────────────────────────┬──────┐ + -- │ ┌───────┐ │ │ + -- │ │ │ ┌───────┐ │ │ + -- │ ──┼─► 3 ──┼─► 1 ──┼─► 4 ──┼─► ──┼─► 2 │ + -- │ ◄─┼── ◄─┼── ◄─┼── ◄─┼── ◄─┼── │ + -- │ └───────┘ │ │ │ │ + -- │ └───────┘ │ │ + -- └───────────────────────────────────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + , (3, Rectangle 200 200 200 200) + , (4, Rectangle 600 600 200 200) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3, 4]) + (st2, ws2) `shouldBe` (mkstate 200 200, mkws 3 [2,1] [4]) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 400 200, mkws 1 [] [2, 3, 4]) + let (st4, ws4) = runNav R st3 ws3 + (st4, ws4) `shouldBe` (mkstate 600 600, mkws 4 [3, 2, 1] []) + let (st5, ws5) = runNav R st4 ws4 + (st5, ws5) `shouldBe` (mkstate 800 600, mkws 1 [] [2, 3, 4]) + let (st6, ws6) = runNav R st5 ws5 + (st6, ws6) `shouldBe` (mkstate 960 600, mkws 2 [1] [3, 4]) + let (st7, ws7) = runNav L st6 ws6 + (st7, ws7) `shouldBe` (mkstate 959 600, mkws 1 [] [2, 3, 4]) + let (st8, ws8) = runNav L st7 ws7 + (st8, ws8) `shouldBe` (mkstate 799 600, mkws 4 [3, 2, 1] []) + let (st9, ws9) = runNav L st8 ws8 + (st9, ws9) `shouldBe` (mkstate 599 600, mkws 1 [] [2, 3, 4]) + let (st10, ws10) = runNav L st9 ws9 + (st10, ws10) `shouldBe` (mkstate 399 399, mkws 3 [2, 1] [4]) + let (st11, ws11) = runNav L st10 ws10 + (st11, ws11) `shouldBe` (mkstate 199 399, mkws 1 [] [2, 3, 4]) + + it "overlapping inner floating windows" $ do + -- ┌─────────────────────┬──────┐ + -- │ ┌─────────┐ │ │ + -- │ │ 3 ┌────┴─┐ │ │ + -- │ │ ──┼─► ──┼─► 1 ──┼─► 2 │ + -- │ │ ◄─┼── ◄─┼── ◄─┼── │ + -- │ │ │ 4 │ │ │ + -- │ └────┤ │ │ │ + -- │ └──────┘ │ │ + -- └─────────────────────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + , (3, Rectangle 200 200 400 400) + , (4, Rectangle 300 300 400 400) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav R M.empty (mkws 3 [] [1, 2, 4]) + (st2, ws2) `shouldBe` (mkstate 400 400, mkws 4 [2, 1, 3] []) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 700 400, mkws 1 [3] [2, 4]) + let (st4, ws4) = runNav R st3 ws3 + (st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1, 3] [4]) + let (st5, ws5) = runNav L st4 ws4 + (st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [3] [2, 4]) + let (st6, ws6) = runNav L st5 ws5 + (st6, ws6) `shouldBe` (mkstate 699 400, mkws 4 [2, 1, 3] []) + let (st7, ws7) = runNav L st6 ws6 + (st7, ws7) `shouldBe` (mkstate 599 400, mkws 3 [] [1, 2, 4]) + + it "bounce back from the wall to the floating window" $ do + -- ┌────────────────┬─────┐ + -- │ 1 ┌──────┐ │ │ + -- │ ┌───┼─► 3 │ │ 2 │ + -- │ └── │ │ │ │ + -- │ └──────┘ │ │ + -- └────────────────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + , (3, Rectangle 400 400 200 200) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect) + runNav L (mkstate 100 640) (mkws 1 [] [2, 3]) + `shouldBe` (mkstate 400 599, mkws 3 [2, 1] []) + + it "jump between screens" $ do + -- ┌─────┬──────┐ ┌────────┐ + -- │ │ 2 │ │ 5 │ + -- │ ├──────┤ ├────────┤ + -- │ 1 │ 3 ──┼──┼─► 6 │ + -- │ ├──────┤ └────────┘ + -- │ │ 4 │ + -- └─────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + , (5, Rectangle 1920 0 1280 384) + , (6, Rectangle 1920 384 1280 384) + ] + initWindowSet = + W.StackSet + { W.current = + W.Screen + { W.workspace = + W.Workspace + { W.tag = "A" + , W.layout = Layout NullLayout + , W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] } + } + , W.screen = 1 + , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 } + } + , W.visible = + [ W.Screen + { W.workspace = + W.Workspace + { W.tag = "B" + , W.layout = Layout NullLayout + , W.stack = Just $ W.Stack { W.focus = 5, W.up = [], W.down = [6] } + } + , W.screen = 2 + , W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 } + } + ] + , W.hidden = [] + , W.floating = M.empty + } + expectedWindowSet = + W.StackSet + { W.current = + W.Screen + { W.workspace = + W.Workspace + { W.tag = "B" + , W.layout = Layout NullLayout + , W.stack = Just $ W.Stack { W.focus = 6, W.up = [5], W.down = [] } + } + , W.screen = 2 + , W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 } + } + , W.visible = + [ W.Screen + { W.workspace = + W.Workspace + { W.tag = "A" + , W.layout = Layout NullLayout + , W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] } + } + , W.screen = 1 + , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 } + } + ] + , W.hidden = [] + , W.floating = M.empty + } + + runIdentity (goPure R (M.empty, initWindowSet, S.fromList [1..6], windowRect)) + `shouldBe` (M.fromList [("B", Point 1920 600)], expectedWindowSet) + + it "floating window overlapping fully in the orthogonal direction" $ do + -- ┌─────┬──────────────────┐ + -- │ │ ┌───────┐ │ + -- │ │ 2 │ │ │ + -- │ ├──────┤-------├───┤ + -- │ 1 │ 3 │ │ 3 │ + -- │ ◄─┼── ◄─┼── 5 ◄─┼── │ + -- │ ├──────┤-------├───┤ + -- │ │ 4 │ │ │ + -- │ │ └───────┘ │ + -- └─────┴──────────────────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + , (5, Rectangle 1360 200 200 800) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect) + let (st2, ws2) = runNav L (mkstate 1800 600) (mkws 3 [] [1, 2, 4, 5]) + (st2, ws2) `shouldBe` (mkstate 1559 600, mkws 5 [4, 2, 1, 3] []) + let (st3, ws3) = runNav L st2 ws2 + (st3, ws3) `shouldBe` (mkstate 1359 600, mkws 3 [] [1, 2, 4, 5]) + let (st4, ws4) = runNav L st3 ws3 + (st4, ws4) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4, 5]) + + it "navigation to free-floating windows on the same screen" $ do + -- ┌──────┐ + -- │ │ ┌──────┐ + -- │ │ │ │ + -- │ ──┼──┼─► 2 │ + -- │ │ │ │ + -- │ 1 │ └──────┘ + -- │ │ + -- │ │ + -- └──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 1200 400 400 400) + ] + runIdentity (goPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect)) + `shouldBe` (mkstate 1200 640, mkws 2 [1] []) + + it "switch between windows in Full layout" $ do + let windowRect w = Identity $ M.lookup w $ M.fromList [(1, Rectangle 0 0 1920 1280)] + runIdentity (goPure D (M.empty, mkws 1 [] [2, 3], S.fromList [1], windowRect)) + `shouldBe` (M.empty, mkws 2 [1] [3]) + +data NullLayout a = NullLayout deriving (Show, Read, Eq) +instance LayoutClass NullLayout a + +-- to make WindowSets comparable +instance Eq (Layout w) where + (==) a b = show a == show b + (/=) a b = show a /= show b + +-- make a state with a position for a single workspace +mkstate :: Position -> Position -> WNState +mkstate px py = M.fromList [("A", Point px py)] + +-- make a single-workspace WindowSet +mkws :: Window -> [Window] -> [Window] -> WindowSet +mkws focusedWindow upWindows downWindows = W.StackSet + { W.current = W.Screen + { W.workspace = W.Workspace + { W.tag = "A" + , W.layout = Layout NullLayout + , W.stack = Just $ W.Stack { W.focus = focusedWindow, W.up = upWindows, W.down = downWindows } + } + , W.screen = 1 + , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 } + } + , W.visible = [] + , W.hidden = [] + , W.floating = M.empty + } diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index cb00b4423..8d1c37376 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -429,6 +429,7 @@ test-suite tests RotateSome Selective SwapWorkspaces + WindowNavigation Utils XMonad.Actions.CopyWindow XMonad.Actions.CycleRecentWS @@ -443,6 +444,7 @@ test-suite tests XMonad.Actions.TagWindows XMonad.Actions.WindowBringer XMonad.Actions.WindowGo + XMonad.Actions.WindowNavigation XMonad.Hooks.ManageDocks XMonad.Hooks.ManageHelpers XMonad.Hooks.UrgencyHook