-----------------------------------------------------------------------------
-- |
-- 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 :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l)
withWindowNavigation (KeySym
u,KeySym
l,KeySym
d,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 [((KeyMask, KeySym), 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, KeySym) (X ())
keys = \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 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 = (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 t
targetWin 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 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
                Maybe t
Nothing -> StackSet i l t s sd
winSet
        mapWindows :: (t -> t) -> StackSet i l t s sd -> StackSet i l t s sd
mapWindows t -> t
f 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' 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'' t -> b
f (W.Stack t
focused [t]
up [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 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 :: (KeySym -> WindowSet -> WindowSet)
-> IORef (Map WorkspaceId Point) -> Direction2D -> X ()
withTargetWindow KeySym -> WindowSet -> WindowSet
adj IORef (Map WorkspaceId Point)
posRef 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
$ \KeySym
win 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
$ \(KeySym
targetWin, 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 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
$ \KeySym
win Point
pos ->
                           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 IORef (Map WorkspaceId Point)
posRef KeySym -> Point -> X ()
f = (KeySym -> X ()) -> X ()
withFocused ((KeySym -> X ()) -> X ()) -> (KeySym -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \KeySym
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
>>= 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 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 -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
0 Dimension
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 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 [(KeySym, Rectangle)]
navigableTargets Point
point 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 Direction2D
d 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 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
$ \Display
dpy -> do
    (KeySym
_, Position
x, Position
y, Dimension
w, Dimension
h, Dimension
bw, CInt
_) <- IO
  (KeySym, Position, Position, Dimension, Dimension, Dimension, CInt)
-> X (KeySym, Position, Position, Dimension, Dimension, Dimension,
      CInt)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO
   (KeySym, Position, Position, Dimension, Dimension, Dimension, CInt)
 -> X (KeySym, Position, Position, Dimension, Dimension, Dimension,
       CInt))
-> IO
     (KeySym, Position, Position, Dimension, Dimension, Dimension, CInt)
-> X (KeySym, Position, Position, Dimension, Dimension, Dimension,
      CInt)
forall a b. (a -> b) -> a -> b
$ Display
-> KeySym
-> IO
     (KeySym, Position, Position, Dimension, Dimension, Dimension, 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
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 (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 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
_ 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
inr Direction2D
L (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

sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
sortby :: 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