-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.WindowNavigation
-- Description :  Experimental rewrite of "XMonad.Layout.WindowNavigation".
-- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>,
--                          Devin Mullins <me@twifkak.com>
-- Maintainer  :  Devin Mullins <me@twifkak.com>
-- License     :  BSD3-style (see LICENSE)
-- Stability   :  unstable
-- Portability :  unportable
--
-- This is a rewrite of "XMonad.Layout.WindowNavigation".  WindowNavigation
-- lets you assign keys to move up\/down\/left\/right, based on actual cartesian
-- window coordinates, rather than just going j\/k on the stack.
--
-- This module is experimental. You'll have better luck with the original.
--
-- This module differs from the other in a few ways:
--
--   (1) You can go up\/down\/left\/right across multiple screens.
--
--   (2) It doesn't provide little border colors for your neighboring windows.
--
--   (3) It doesn't provide the \'Move\' action, which seems to be related to
--      the XMonad.Layout.Combo extension.
--
--   (4) It tries to be slightly smarter about tracking your current position.
--
--   (5) Configuration is different.
--
-----------------------------------------------------------------------------

module XMonad.Actions.WindowNavigation (
                                       -- * Usage
                                       -- $usage
                                       withWindowNavigation,
                                       withWindowNavigationKeys,
                                       WNAction(..),
                                       go, swap,
                                       Direction2D(..), WNState,
                                       ) where

import XMonad
import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortOn)
import XMonad.Util.Types (Direction2D(..))
import qualified XMonad.StackSet as W

import Control.Arrow (second)
import Data.IORef
import Data.Map (Map())
import qualified Data.Map as M
import qualified Data.Set as S

-- $usage
--
-- To use it, you're going to apply the 'withWindowNavigation' function.
-- 'withWindowNavigation' performs some IO operations, so the syntax you'll use
-- is the same as the spawnPipe example in "XMonad.Hooks.DynamicLog".
-- In particular:
--
-- > main = do
-- >     config <- withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
-- >             $ def { ... }
-- >     xmonad config
--
-- Or, for the brave souls:
--
-- > main = xmonad =<< withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
-- >             $ def { ... }
--
-- Here, we pass in the keys for navigation in counter-clockwise order from up.
-- It creates keybindings for @modMask@ to move to window, and @modMask .|. shiftMask@
-- to swap windows.
--
-- If you want more flexibility over your keybindings, you can use
-- 'withWindowNavigationKeys', which takes a list of @keys@-esque entries rather
-- than a tuple of the four directional keys. See the source code of
-- 'withWindowNavigation' for an example.

-- TODO:
--  - monad for WNState?
--  - cleanup (including inr)
--  - more documentation
--  - tests? (esp. for edge cases in currentPosition)
--  - screen 1, 1+2/w 3, M-d, M-w, M-2 (1+2/w 2), M-e, M-a - goes to w 3, should be w 2
--  - solve the 2+3, middle right to bottom left problem
--  - command to iteratively swapUp/swapDown instead of directly swapping with target
--  - manageHook to draw window decos?

withWindowNavigation :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l)
withWindowNavigation :: forall (l :: * -> *).
(Window, Window, Window, Window) -> XConfig l -> IO (XConfig l)
withWindowNavigation (Window
u,Window
l,Window
d,Window
r) conf :: XConfig l
conf@XConfig{modMask :: forall (l :: * -> *). XConfig l -> KeyMask
modMask=KeyMask
modm} =
    [((KeyMask, Window), WNAction)] -> XConfig l -> IO (XConfig l)
forall (l :: * -> *).
[((KeyMask, Window), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys [ ((KeyMask
modm              , Window
u), Direction2D -> WNAction
WNGo   Direction2D
U),
                               ((KeyMask
modm              , Window
l), Direction2D -> WNAction
WNGo   Direction2D
L),
                               ((KeyMask
modm              , Window
d), Direction2D -> WNAction
WNGo   Direction2D
D),
                               ((KeyMask
modm              , Window
r), Direction2D -> WNAction
WNGo   Direction2D
R),
                               ((KeyMask
modm KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
u), Direction2D -> WNAction
WNSwap Direction2D
U),
                               ((KeyMask
modm KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
l), Direction2D -> WNAction
WNSwap Direction2D
L),
                               ((KeyMask
modm KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
d), Direction2D -> WNAction
WNSwap Direction2D
D),
                               ((KeyMask
modm KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
r), Direction2D -> WNAction
WNSwap Direction2D
R) ]
                             XConfig l
conf

withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys :: forall (l :: * -> *).
[((KeyMask, Window), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys [((KeyMask, Window), WNAction)]
wnKeys XConfig l
conf = do
    IORef (Map WorkspaceId Point)
posRef <- Map WorkspaceId Point -> IO (IORef (Map WorkspaceId Point))
forall a. a -> IO (IORef a)
newIORef Map WorkspaceId Point
forall k a. Map k a
M.empty
    XConfig l -> IO (XConfig l)
forall (m :: * -> *) a. Monad m => a -> m a
return XConfig l
conf { keys :: XConfig Layout -> Map (KeyMask, Window) (X ())
keys = \XConfig Layout
cnf -> [((KeyMask, Window), X ())] -> Map (KeyMask, Window) (X ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((((KeyMask, Window), WNAction) -> ((KeyMask, Window), X ()))
-> [((KeyMask, Window), WNAction)] -> [((KeyMask, Window), X ())]
forall a b. (a -> b) -> [a] -> [b]
map ((WNAction -> X ())
-> ((KeyMask, Window), WNAction) -> ((KeyMask, Window), X ())
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (IORef (Map WorkspaceId Point) -> WNAction -> X ()
fromWNAction IORef (Map WorkspaceId Point)
posRef)) [((KeyMask, Window), WNAction)]
wnKeys)
                                 Map (KeyMask, Window) (X ())
-> Map (KeyMask, Window) (X ()) -> Map (KeyMask, Window) (X ())
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` XConfig l -> XConfig Layout -> Map (KeyMask, Window) (X ())
forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, Window) (X ())
keys XConfig l
conf XConfig Layout
cnf,
                  logHook :: X ()
logHook = XConfig l -> X ()
forall (l :: * -> *). XConfig l -> X ()
logHook XConfig l
conf X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IORef (Map WorkspaceId Point) -> X ()
trackMovement IORef (Map WorkspaceId Point)
posRef }
  where fromWNAction :: IORef (Map WorkspaceId Point) -> WNAction -> X ()
fromWNAction IORef (Map WorkspaceId Point)
posRef (WNGo Direction2D
dir)   = IORef (Map WorkspaceId Point) -> Direction2D -> X ()
go   IORef (Map WorkspaceId Point)
posRef Direction2D
dir
        fromWNAction IORef (Map WorkspaceId Point)
posRef (WNSwap Direction2D
dir) = IORef (Map WorkspaceId Point) -> Direction2D -> X ()
swap IORef (Map WorkspaceId Point)
posRef Direction2D
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
go :: IORef WNState -> Direction2D -> X ()
go :: IORef (Map WorkspaceId Point) -> Direction2D -> X ()
go = (Window -> WindowSet -> WindowSet)
-> IORef (Map WorkspaceId Point) -> Direction2D -> X ()
withTargetWindow Window -> WindowSet -> WindowSet
forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow

swap :: IORef WNState -> Direction2D -> X ()
swap :: IORef (Map WorkspaceId Point) -> Direction2D -> X ()
swap = (Window -> WindowSet -> WindowSet)
-> IORef (Map WorkspaceId Point) -> Direction2D -> X ()
withTargetWindow Window -> WindowSet -> WindowSet
forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
swapWithFocused
  where swapWithFocused :: a -> StackSet i l a s sd -> StackSet i l a s sd
swapWithFocused a
targetWin StackSet i l a s sd
winSet =
            case StackSet i l a s sd -> Maybe a
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek StackSet i l a s sd
winSet of
                Just a
currentWin -> a -> StackSet i l a s sd -> StackSet i l a s sd
forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow a
currentWin (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$
                                   (a -> a) -> StackSet i l a s sd -> StackSet i l a s sd
forall {a} {i} {l} {s} {sd}.
(a -> a) -> StackSet i l a s sd -> StackSet i l a s sd
mapWindows (a -> a -> a -> a
forall {a}. Eq a => a -> a -> a -> a
swapWin a
currentWin a
targetWin) StackSet i l a s sd
winSet
                Maybe a
Nothing -> StackSet i l a s sd
winSet
        mapWindows :: (a -> a) -> StackSet i l a s sd -> StackSet i l a s sd
mapWindows a -> a
f = (Workspace i l a -> Workspace i l a)
-> StackSet i l a s sd -> StackSet i l a s sd
forall i l a s sd.
(Workspace i l a -> Workspace i l a)
-> StackSet i l a s sd -> StackSet i l a s sd
W.mapWorkspace ((a -> a) -> Workspace i l a -> Workspace i l a
forall {a} {a} {i} {l}.
(a -> a) -> Workspace i l a -> Workspace i l a
mapWindows' a -> a
f)
        mapWindows' :: (a -> a) -> Workspace i l a -> Workspace i l a
mapWindows' a -> a
f ws :: Workspace i l a
ws@W.Workspace{ stack :: forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack = Maybe (Stack a)
s } = Workspace i l a
ws { stack :: Maybe (Stack a)
W.stack = (a -> a) -> Stack a -> Stack a
forall {a} {b}. (a -> b) -> Stack a -> Stack b
mapWindows'' a -> a
f (Stack a -> Stack a) -> Maybe (Stack a) -> Maybe (Stack a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Stack a)
s }
        mapWindows'' :: (a -> b) -> Stack a -> Stack b
mapWindows'' a -> b
f (W.Stack a
focused [a]
up [a]
down) = b -> [b] -> [b] -> Stack b
forall a. a -> [a] -> [a] -> Stack a
W.Stack (a -> b
f a
focused) ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
up) ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
down)
        swapWin :: a -> a -> a -> a
swapWin a
win1 a
win2 a
win
          | a
win a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
win1 = a
win2
          | a
win a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
win2 = a
win1
          | Bool
otherwise = a
win

withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()
withTargetWindow :: (Window -> WindowSet -> WindowSet)
-> IORef (Map WorkspaceId Point) -> Direction2D -> X ()
withTargetWindow Window -> WindowSet -> WindowSet
adj IORef (Map WorkspaceId Point)
posRef Direction2D
dir = IORef (Map WorkspaceId Point) -> (Window -> Point -> X ()) -> X ()
fromCurrentPoint IORef (Map WorkspaceId Point)
posRef ((Window -> Point -> X ()) -> X ())
-> (Window -> Point -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
win Point
pos -> do
    [(Window, Rectangle)]
targets <- ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window
win) (Window -> Bool)
-> ((Window, Rectangle) -> Window) -> (Window, Rectangle) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst) ([(Window, Rectangle)] -> [(Window, Rectangle)])
-> X [(Window, Rectangle)] -> X [(Window, Rectangle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> Direction2D -> X [(Window, Rectangle)]
navigableTargets Point
pos Direction2D
dir
    Maybe (Window, Rectangle) -> ((Window, Rectangle) -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust ([(Window, Rectangle)] -> Maybe (Window, Rectangle)
forall a. [a] -> Maybe a
listToMaybe [(Window, Rectangle)]
targets) (((Window, Rectangle) -> X ()) -> X ())
-> ((Window, Rectangle) -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \(Window
targetWin, Rectangle
targetRect) -> do
      (WindowSet -> WindowSet) -> X ()
windows (Window -> WindowSet -> WindowSet
adj Window
targetWin)
      IORef (Map WorkspaceId Point) -> Point -> Rectangle -> X ()
setPosition IORef (Map WorkspaceId Point)
posRef Point
pos Rectangle
targetRect

trackMovement :: IORef WNState -> X ()
trackMovement :: IORef (Map WorkspaceId Point) -> X ()
trackMovement IORef (Map WorkspaceId Point)
posRef = IORef (Map WorkspaceId Point) -> (Window -> Point -> X ()) -> X ()
fromCurrentPoint IORef (Map WorkspaceId Point)
posRef ((Window -> Point -> X ()) -> X ())
-> (Window -> Point -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
win Point
pos ->
                           Window -> X (Maybe (Window, Rectangle))
windowRect Window
win X (Maybe (Window, Rectangle))
-> (Maybe (Window, Rectangle) -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe (Window, Rectangle)
 -> ((Window, Rectangle) -> X ()) -> X ())
-> ((Window, Rectangle) -> X ())
-> Maybe (Window, Rectangle)
-> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe (Window, Rectangle) -> ((Window, Rectangle) -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (IORef (Map WorkspaceId Point) -> Point -> Rectangle -> X ()
setPosition IORef (Map WorkspaceId Point)
posRef Point
pos (Rectangle -> X ())
-> ((Window, Rectangle) -> Rectangle)
-> (Window, Rectangle)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd)

fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
fromCurrentPoint :: IORef (Map WorkspaceId Point) -> (Window -> Point -> X ()) -> X ()
fromCurrentPoint IORef (Map WorkspaceId Point)
posRef Window -> Point -> X ()
f = (Window -> X ()) -> X ()
withFocused ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
win ->
                                IORef (Map WorkspaceId Point) -> X Point
currentPosition IORef (Map WorkspaceId Point)
posRef X Point -> (Point -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Window -> Point -> X ()
f Window
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 :: IORef (Map WorkspaceId Point) -> X Point
currentPosition IORef (Map WorkspaceId Point)
posRef = do
    Window
root <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
    Maybe Window
currentWindow <- (XState -> Maybe Window) -> X (Maybe Window)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek (WindowSet -> Maybe Window)
-> (XState -> WindowSet) -> XState -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
    Rectangle
currentRect <- Rectangle
-> ((Window, Rectangle) -> Rectangle)
-> Maybe (Window, Rectangle)
-> Rectangle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
0 Dimension
0) (Window, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd (Maybe (Window, Rectangle) -> Rectangle)
-> X (Maybe (Window, Rectangle)) -> X Rectangle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> X (Maybe (Window, Rectangle))
windowRect (Window -> Maybe Window -> Window
forall a. a -> Maybe a -> a
fromMaybe Window
root Maybe Window
currentWindow)

    WorkspaceId
wsid <- (XState -> WorkspaceId) -> X WorkspaceId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WindowSet -> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag (WindowSet -> WorkspaceId)
-> (XState -> WindowSet) -> XState -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
    Maybe Point
mp <- WorkspaceId -> Map WorkspaceId Point -> Maybe Point
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WorkspaceId
wsid (Map WorkspaceId Point -> Maybe Point)
-> X (Map WorkspaceId Point) -> X (Maybe Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Map WorkspaceId Point) -> X (Map WorkspaceId Point)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IORef (Map WorkspaceId Point) -> IO (Map WorkspaceId Point)
forall a. IORef a -> IO a
readIORef IORef (Map WorkspaceId Point)
posRef)

    Point -> X Point
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> X Point) -> Point -> X Point
forall a b. (a -> b) -> a -> b
$ Point -> (Point -> Point) -> Maybe Point -> Point
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Rectangle -> Point
middleOf Rectangle
currentRect) (Point -> Rectangle -> Point
`inside` Rectangle
currentRect) Maybe Point
mp

  where middleOf :: Rectangle -> Point
middleOf (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Point
Point (Position -> Dimension -> Position
midPoint Position
x Dimension
w) (Position -> Dimension -> Position
midPoint Position
y Dimension
h)

setPosition :: IORef WNState -> Point -> Rectangle -> X ()
setPosition :: IORef (Map WorkspaceId Point) -> Point -> Rectangle -> X ()
setPosition IORef (Map WorkspaceId Point)
posRef Point
oldPos Rectangle
newRect = do
    WorkspaceId
wsid <- (XState -> WorkspaceId) -> X WorkspaceId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WindowSet -> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag (WindowSet -> WorkspaceId)
-> (XState -> WindowSet) -> XState -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ IORef (Map WorkspaceId Point)
-> (Map WorkspaceId Point -> Map WorkspaceId Point) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Map WorkspaceId Point)
posRef ((Map WorkspaceId Point -> Map WorkspaceId Point) -> IO ())
-> (Map WorkspaceId Point -> Map WorkspaceId Point) -> IO ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId
-> Point -> Map WorkspaceId Point -> Map WorkspaceId Point
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
wsid (Point
oldPos Point -> Rectangle -> Point
`inside` Rectangle
newRect)

inside :: Point -> Rectangle -> Point
Point Position
x Position
y inside :: Point -> Rectangle -> Point
`inside` Rectangle Position
rx Position
ry Dimension
rw Dimension
rh =
    Position -> Position -> Point
Point (Position
x Position -> (Position, Dimension) -> Position
`within` (Position
rx, Dimension
rw)) (Position
y Position -> (Position, Dimension) -> Position
`within` (Position
ry, Dimension
rh))
  where Position
pos within :: Position -> (Position, Dimension) -> Position
`within` (Position
lower, Dimension
dim) = if Position
pos Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= Position
lower Bool -> Bool -> Bool
&& Position
pos Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
lower Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
dim
                                    then Position
pos
                                    else Position -> Dimension -> Position
midPoint Position
lower Dimension
dim

midPoint :: Position -> Dimension -> Position
midPoint :: Position -> Dimension -> Position
midPoint Position
pos Dimension
dim = Position
pos Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
dim Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2

navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]
navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]
navigableTargets Point
point Direction2D
dir = Direction2D
-> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable Direction2D
dir Point
point ([(Window, Rectangle)] -> [(Window, Rectangle)])
-> X [(Window, Rectangle)] -> X [(Window, Rectangle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X [(Window, Rectangle)]
windowRects

-- 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 :: Direction2D
-> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable Direction2D
d Point
pt = Direction2D -> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
sortby Direction2D
d ([(Window, Rectangle)] -> [(Window, Rectangle)])
-> ([(Window, Rectangle)] -> [(Window, Rectangle)])
-> [(Window, Rectangle)]
-> [(Window, Rectangle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Direction2D -> Point -> Rectangle -> Bool
inr Direction2D
d Point
pt (Rectangle -> Bool)
-> ((Window, Rectangle) -> Rectangle)
-> (Window, Rectangle)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd)

-- 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 :: X [(Window, Rectangle)]
windowRects = ([Maybe (Window, Rectangle)] -> [(Window, Rectangle)])
-> X [Maybe (Window, Rectangle)] -> X [(Window, Rectangle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (Window, Rectangle)] -> [(Window, Rectangle)]
forall a. [Maybe a] -> [a]
catMaybes (X [Maybe (Window, Rectangle)] -> X [(Window, Rectangle)])
-> (Set Window -> X [Maybe (Window, Rectangle)])
-> Set Window
-> X [(Window, Rectangle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> X (Maybe (Window, Rectangle)))
-> [Window] -> X [Maybe (Window, Rectangle)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X (Maybe (Window, Rectangle))
windowRect ([Window] -> X [Maybe (Window, Rectangle)])
-> (Set Window -> [Window])
-> Set Window
-> X [Maybe (Window, Rectangle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Window -> [Window]
forall a. Set a -> [a]
S.toList (Set Window -> X [(Window, Rectangle)])
-> X (Set Window) -> X [(Window, Rectangle)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (XState -> Set Window) -> X (Set Window)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> Set Window
mapped

windowRect :: Window -> X (Maybe (Window, Rectangle))
windowRect :: Window -> X (Maybe (Window, Rectangle))
windowRect Window
win = (Display -> X (Maybe (Window, Rectangle)))
-> X (Maybe (Window, Rectangle))
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X (Maybe (Window, Rectangle)))
 -> X (Maybe (Window, Rectangle)))
-> (Display -> X (Maybe (Window, Rectangle)))
-> X (Maybe (Window, Rectangle))
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    (Window
_, Position
x, Position
y, Dimension
w, Dimension
h, Dimension
bw, CInt
_) <- IO
  (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
-> X (Window, Position, Position, Dimension, Dimension, Dimension,
      CInt)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO
   (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
 -> X (Window, Position, Position, Dimension, Dimension, Dimension,
       CInt))
-> IO
     (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
-> X (Window, Position, Position, Dimension, Dimension, Dimension,
      CInt)
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO
     (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
getGeometry Display
dpy Window
win
    Maybe (Window, Rectangle) -> X (Maybe (Window, Rectangle))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Window, Rectangle) -> X (Maybe (Window, Rectangle)))
-> Maybe (Window, Rectangle) -> X (Maybe (Window, Rectangle))
forall a b. (a -> b) -> a -> b
$ (Window, Rectangle) -> Maybe (Window, Rectangle)
forall a. a -> Maybe a
Just (Window
win, Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Dimension
w Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Dimension
2 Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension
bw) (Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Dimension
2 Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension
bw))
    X (Maybe (Window, Rectangle))
-> X (Maybe (Window, Rectangle)) -> X (Maybe (Window, Rectangle))
forall a. X a -> X a -> X a
`catchX` Maybe (Window, Rectangle) -> X (Maybe (Window, Rectangle))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Window, Rectangle)
forall a. Maybe a
Nothing

-- Modified from droundy's implementation of WindowNavigation:

inr :: Direction2D -> Point -> Rectangle -> Bool
inr :: Direction2D -> Point -> Rectangle -> Bool
inr Direction2D
D (Point Position
px Position
py) (Rectangle Position
rx Position
ry Dimension
w Dimension
h) = Position
px Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= Position
rx Bool -> Bool -> Bool
&& Position
px Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
                                                        Position
py Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
ry Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h
inr Direction2D
U (Point Position
px Position
py) (Rectangle Position
rx Position
ry Dimension
w Dimension
_) = Position
px Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= Position
rx Bool -> Bool -> Bool
&& Position
px Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
                                            Position
py Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>  Position
ry
inr Direction2D
R (Point Position
px Position
py) (Rectangle Position
rx Position
ry Dimension
w Dimension
h) =             Position
px Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
                                            Position
py Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= Position
ry Bool -> Bool -> Bool
&& Position
py Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
ry Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h
inr Direction2D
L (Point Position
px Position
py) (Rectangle Position
rx Position
ry Dimension
_ Dimension
h) = Position
px Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>  Position
rx Bool -> Bool -> Bool
&&
                                            Position
py Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= Position
ry Bool -> Bool -> Bool
&& Position
py Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
ry Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h

sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
sortby :: forall a. Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
sortby Direction2D
D = ((a, Rectangle) -> Position)
-> [(a, Rectangle)] -> [(a, Rectangle)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Rectangle -> Position
rect_y (Rectangle -> Position)
-> ((a, Rectangle) -> Rectangle) -> (a, Rectangle) -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd)
sortby Direction2D
R = ((a, Rectangle) -> Position)
-> [(a, Rectangle)] -> [(a, Rectangle)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Rectangle -> Position
rect_x (Rectangle -> Position)
-> ((a, Rectangle) -> Rectangle) -> (a, Rectangle) -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd)
sortby Direction2D
U = [(a, Rectangle)] -> [(a, Rectangle)]
forall a. [a] -> [a]
reverse ([(a, Rectangle)] -> [(a, Rectangle)])
-> ([(a, Rectangle)] -> [(a, Rectangle)])
-> [(a, Rectangle)]
-> [(a, Rectangle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
sortby Direction2D
D
sortby Direction2D
L = [(a, Rectangle)] -> [(a, Rectangle)]
forall a. [a] -> [a]
reverse ([(a, Rectangle)] -> [(a, Rectangle)])
-> ([(a, Rectangle)] -> [(a, Rectangle)])
-> [(a, Rectangle)]
-> [(a, Rectangle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
sortby Direction2D
R