-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.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.Util.Types (Direction2D(..))
import qualified XMonad.StackSet as W

import Control.Applicative ((<$>))
import Control.Arrow (second)
import Data.IORef
import Data.List (sortBy)
import Data.Map (Map())
import qualified Data.Map as M
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
import Data.Ord (comparing)
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
--
-- 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 :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l)
withWindowNavigation (u :: KeySym
u,l :: KeySym
l,d :: KeySym
d,r :: KeySym
r) conf :: XConfig l
conf@XConfig{modMask :: forall (l :: * -> *). XConfig l -> KeyMask
modMask=KeyMask
modm} =
    [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
forall (l :: * -> *).
[((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys [ ((KeyMask
modm              , KeySym
u), Direction2D -> WNAction
WNGo   Direction2D
U),
                               ((KeyMask
modm              , KeySym
l), Direction2D -> WNAction
WNGo   Direction2D
L),
                               ((KeyMask
modm              , KeySym
d), Direction2D -> WNAction
WNGo   Direction2D
D),
                               ((KeyMask
modm              , KeySym
r), Direction2D -> WNAction
WNGo   Direction2D
R),
                               ((KeyMask
modm KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
u), Direction2D -> WNAction
WNSwap Direction2D
U),
                               ((KeyMask
modm KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
l), Direction2D -> WNAction
WNSwap Direction2D
L),
                               ((KeyMask
modm KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
d), Direction2D -> WNAction
WNSwap Direction2D
D),
                               ((KeyMask
modm KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
r), Direction2D -> WNAction
WNSwap Direction2D
R) ]
                             XConfig l
conf

withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys wnKeys :: [((KeyMask, KeySym), WNAction)]
wnKeys conf :: 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, KeySym) (X ())
keys = \cnf :: XConfig Layout
cnf -> [((KeyMask, KeySym), X ())] -> Map (KeyMask, KeySym) (X ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((((KeyMask, KeySym), WNAction) -> ((KeyMask, KeySym), X ()))
-> [((KeyMask, KeySym), WNAction)] -> [((KeyMask, KeySym), X ())]
forall a b. (a -> b) -> [a] -> [b]
map ((WNAction -> X ())
-> ((KeyMask, KeySym), WNAction) -> ((KeyMask, KeySym), 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, KeySym), WNAction)]
wnKeys)
                                 Map (KeyMask, KeySym) (X ())
-> Map (KeyMask, KeySym) (X ()) -> Map (KeyMask, KeySym) (X ())
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (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 posRef :: IORef (Map WorkspaceId Point)
posRef (WNGo dir :: Direction2D
dir)   = IORef (Map WorkspaceId Point) -> Direction2D -> X ()
go   IORef (Map WorkspaceId Point)
posRef Direction2D
dir
        fromWNAction posRef :: IORef (Map WorkspaceId Point)
posRef (WNSwap dir :: 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 = (KeySym -> WindowSet -> WindowSet)
-> IORef (Map WorkspaceId Point) -> Direction2D -> X ()
withTargetWindow KeySym -> 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 = (KeySym -> WindowSet -> WindowSet)
-> IORef (Map WorkspaceId Point) -> Direction2D -> X ()
withTargetWindow KeySym -> 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 :: t -> StackSet i l t s sd -> StackSet i l t s sd
swapWithFocused targetWin :: t
targetWin winSet :: StackSet i l t s sd
winSet =
            case StackSet i l t s sd -> Maybe t
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek StackSet i l t s sd
winSet of
                Just currentWin :: t
currentWin -> t -> StackSet i l t s sd -> StackSet i l t 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 t
currentWin (StackSet i l t s sd -> StackSet i l t s sd)
-> StackSet i l t s sd -> StackSet i l t s sd
forall a b. (a -> b) -> a -> b
$
                                   (t -> t) -> StackSet i l t s sd -> StackSet i l t s sd
forall t i l s sd.
(t -> t) -> StackSet i l t s sd -> StackSet i l t s sd
mapWindows (t -> t -> t -> t
forall a. Eq a => a -> a -> a -> a
swapWin t
currentWin t
targetWin) StackSet i l t s sd
winSet
                Nothing -> StackSet i l t s sd
winSet
        mapWindows :: (t -> t) -> StackSet i l t s sd -> StackSet i l t s sd
mapWindows f :: t -> t
f ss :: StackSet i l t s sd
ss = (Workspace i l t -> Workspace i l t)
-> StackSet i l t s sd -> StackSet i l t 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 ((t -> t) -> Workspace i l t -> Workspace i l t
forall t a i l. (t -> a) -> Workspace i l t -> Workspace i l a
mapWindows' t -> t
f) StackSet i l t s sd
ss
        mapWindows' :: (t -> a) -> Workspace i l t -> Workspace i l a
mapWindows' f :: t -> a
f ws :: Workspace i l t
ws@(W.Workspace { stack :: forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack = Maybe (Stack t)
s }) = Workspace i l t
ws { stack :: Maybe (Stack a)
W.stack = (t -> a) -> Stack t -> Stack a
forall t b. (t -> b) -> Stack t -> Stack b
mapWindows'' t -> a
f (Stack t -> Stack a) -> Maybe (Stack t) -> Maybe (Stack a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Stack t)
s }
        mapWindows'' :: (t -> b) -> Stack t -> Stack b
mapWindows'' f :: t -> b
f (W.Stack focused :: t
focused up :: [t]
up down :: [t]
down) = b -> [b] -> [b] -> Stack b
forall a. a -> [a] -> [a] -> Stack a
W.Stack (t -> b
f t
focused) ((t -> b) -> [t] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map t -> b
f [t]
up) ((t -> b) -> [t] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map t -> b
f [t]
down)
        swapWin :: a -> a -> a -> a
swapWin win1 :: a
win1 win2 :: a
win2 win :: a
win = if a
win a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
win1 then a
win2 else if a
win a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
win2 then a
win1 else a
win

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

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

setPosition :: IORef WNState -> Point -> Rectangle -> X ()
setPosition :: IORef (Map WorkspaceId Point) -> Point -> Rectangle -> X ()
setPosition posRef :: IORef (Map WorkspaceId Point)
posRef oldPos :: Point
oldPos newRect :: 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 x :: Position
x y :: Position
y inside :: Point -> Rectangle -> Point
`inside` Rectangle rx :: Position
rx ry :: Position
ry rw :: KeySym
rw rh :: KeySym
rh =
    Position -> Position -> Point
Point (Position
x Position -> (Position, KeySym) -> Position
`within` (Position
rx, KeySym
rw)) (Position
y Position -> (Position, KeySym) -> Position
`within` (Position
ry, KeySym
rh))
  where pos :: Position
pos within :: Position -> (Position, KeySym) -> Position
`within` (lower :: Position
lower, dim :: KeySym
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
+ KeySym -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral KeySym
dim
                                    then Position
pos
                                    else Position -> KeySym -> Position
midPoint Position
lower KeySym
dim

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

navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]
navigableTargets :: Point -> Direction2D -> X [(KeySym, Rectangle)]
navigableTargets point :: Point
point dir :: Direction2D
dir = Direction2D
-> Point -> [(KeySym, Rectangle)] -> [(KeySym, Rectangle)]
navigable Direction2D
dir Point
point ([(KeySym, Rectangle)] -> [(KeySym, Rectangle)])
-> X [(KeySym, Rectangle)] -> X [(KeySym, Rectangle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X [(KeySym, 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 -> [(KeySym, Rectangle)] -> [(KeySym, Rectangle)]
navigable d :: Direction2D
d pt :: Point
pt = Direction2D -> [(KeySym, Rectangle)] -> [(KeySym, Rectangle)]
forall a. Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
sortby Direction2D
d ([(KeySym, Rectangle)] -> [(KeySym, Rectangle)])
-> ([(KeySym, Rectangle)] -> [(KeySym, Rectangle)])
-> [(KeySym, Rectangle)]
-> [(KeySym, Rectangle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((KeySym, Rectangle) -> Bool)
-> [(KeySym, Rectangle)] -> [(KeySym, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Direction2D -> Point -> Rectangle -> Bool
inr Direction2D
d Point
pt (Rectangle -> Bool)
-> ((KeySym, Rectangle) -> Rectangle)
-> (KeySym, Rectangle)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeySym, 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 [(KeySym, Rectangle)]
windowRects = ([Maybe (KeySym, Rectangle)] -> [(KeySym, Rectangle)])
-> X [Maybe (KeySym, Rectangle)] -> X [(KeySym, Rectangle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (KeySym, Rectangle)] -> [(KeySym, Rectangle)]
forall a. [Maybe a] -> [a]
catMaybes (X [Maybe (KeySym, Rectangle)] -> X [(KeySym, Rectangle)])
-> (Set KeySym -> X [Maybe (KeySym, Rectangle)])
-> Set KeySym
-> X [(KeySym, Rectangle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeySym -> X (Maybe (KeySym, Rectangle)))
-> [KeySym] -> X [Maybe (KeySym, Rectangle)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM KeySym -> X (Maybe (KeySym, Rectangle))
windowRect ([KeySym] -> X [Maybe (KeySym, Rectangle)])
-> (Set KeySym -> [KeySym])
-> Set KeySym
-> X [Maybe (KeySym, Rectangle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set KeySym -> [KeySym]
forall a. Set a -> [a]
S.toList (Set KeySym -> X [(KeySym, Rectangle)])
-> X (Set KeySym) -> X [(KeySym, Rectangle)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (XState -> Set KeySym) -> X (Set KeySym)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> Set KeySym
mapped

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

-- Modified from droundy's implementation of WindowNavigation:

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

sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
sortby :: Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
sortby D = ((a, Rectangle) -> (a, Rectangle) -> Ordering)
-> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((a, Rectangle) -> (a, Rectangle) -> Ordering)
 -> [(a, Rectangle)] -> [(a, Rectangle)])
-> ((a, Rectangle) -> (a, Rectangle) -> Ordering)
-> [(a, Rectangle)]
-> [(a, Rectangle)]
forall a b. (a -> b) -> a -> b
$ ((a, Rectangle) -> Position)
-> (a, Rectangle) -> (a, Rectangle) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (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 R = ((a, Rectangle) -> (a, Rectangle) -> Ordering)
-> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((a, Rectangle) -> (a, Rectangle) -> Ordering)
 -> [(a, Rectangle)] -> [(a, Rectangle)])
-> ((a, Rectangle) -> (a, Rectangle) -> Ordering)
-> [(a, Rectangle)]
-> [(a, Rectangle)]
forall a b. (a -> b) -> a -> b
$ ((a, Rectangle) -> Position)
-> (a, Rectangle) -> (a, Rectangle) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (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 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 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