{-# LANGUAGE TupleSections #-}
module XMonad.Actions.WindowNavigation (
withWindowNavigation,
withWindowNavigationKeys,
WNAction(..),
go, swap,
goPure, swapPure,
Direction2D(..), WNState,
) where
import XMonad hiding (state)
import XMonad.Prelude (catMaybes, fromMaybe, sortOn)
import XMonad.Util.Types (Direction2D(..))
import qualified XMonad.StackSet as W
import Control.Arrow (second)
import Data.IORef
import Data.Map (Map())
import Data.List (partition, find)
import qualified Data.Map as M
import qualified Data.Set as S
withWindowNavigation :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l)
withWindowNavigation :: forall (l :: * -> *).
(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} =
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 forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
u), Direction2D -> WNAction
WNSwap Direction2D
U),
((KeyMask
modm forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
l), Direction2D -> WNAction
WNSwap Direction2D
L),
((KeyMask
modm forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
d), Direction2D -> WNAction
WNSwap Direction2D
D),
((KeyMask
modm 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 :: forall (l :: * -> *).
[((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys [((KeyMask, KeySym), WNAction)]
wnKeys XConfig l
conf = do
IORef (Map WorkspaceId Point)
stateRef <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
M.empty
forall (m :: * -> *) a. Monad m => a -> m a
return XConfig l
conf { keys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys = \XConfig Layout
cnf -> forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. (a -> b) -> [a] -> [b]
map (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)
stateRef)) [((KeyMask, KeySym), WNAction)]
wnKeys)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys XConfig l
conf XConfig Layout
cnf,
logHook :: X ()
logHook = forall (l :: * -> *). XConfig l -> X ()
logHook XConfig l
conf forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IORef (Map WorkspaceId Point) -> X ()
trackMovement IORef (Map WorkspaceId Point)
stateRef }
where fromWNAction :: IORef (Map WorkspaceId Point) -> WNAction -> X ()
fromWNAction IORef (Map WorkspaceId Point)
stateRef (WNGo Direction2D
dir) = IORef (Map WorkspaceId Point) -> Direction2D -> X ()
go IORef (Map WorkspaceId Point)
stateRef Direction2D
dir
fromWNAction IORef (Map WorkspaceId Point)
stateRef (WNSwap Direction2D
dir) = IORef (Map WorkspaceId Point) -> Direction2D -> X ()
swap IORef (Map WorkspaceId Point)
stateRef Direction2D
dir
data WNAction = WNGo Direction2D | WNSwap Direction2D
type WNState = Map WorkspaceId Point
go :: IORef WNState -> Direction2D -> X ()
go :: IORef (Map WorkspaceId Point) -> Direction2D -> X ()
go IORef (Map WorkspaceId Point)
stateRef Direction2D
dir = IORef (Map WorkspaceId Point) -> (WNInput X -> X WNOutput) -> X ()
runPureAction IORef (Map WorkspaceId Point)
stateRef (forall (x :: * -> *).
Monad x =>
Direction2D -> WNInput x -> x WNOutput
goPure Direction2D
dir)
swap :: IORef WNState -> Direction2D -> X ()
swap :: IORef (Map WorkspaceId Point) -> Direction2D -> X ()
swap IORef (Map WorkspaceId Point)
stateRef Direction2D
dir = IORef (Map WorkspaceId Point) -> (WNInput X -> X WNOutput) -> X ()
runPureAction IORef (Map WorkspaceId Point)
stateRef (forall (x :: * -> *).
Monad x =>
Direction2D -> WNInput x -> x WNOutput
swapPure Direction2D
dir)
type WindowRectFn x = (Window -> x (Maybe Rectangle))
type WNInput x = (WNState, WindowSet, S.Set Window, WindowRectFn x)
type WNOutput = (WNState, WindowSet)
runPureAction :: IORef WNState -> (WNInput X -> X WNOutput) -> X ()
runPureAction :: IORef (Map WorkspaceId Point) -> (WNInput X -> X WNOutput) -> X ()
runPureAction IORef (Map WorkspaceId Point)
stateRef WNInput X -> X WNOutput
action = do
Map WorkspaceId Point
oldState <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (forall a. IORef a -> IO a
readIORef IORef (Map WorkspaceId Point)
stateRef)
WindowSet
oldWindowSet <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
Set KeySym
mappedWindows <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> Set KeySym
mapped
(Map WorkspaceId Point
newState, WindowSet
newWindowSet) <- WNInput X -> X WNOutput
action (Map WorkspaceId Point
oldState, WindowSet
oldWindowSet, Set KeySym
mappedWindows, KeySym -> X (Maybe Rectangle)
windowRectX)
(WindowSet -> WindowSet) -> X ()
windows (forall a b. a -> b -> a
const WindowSet
newWindowSet)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Map WorkspaceId Point)
stateRef Map WorkspaceId Point
newState
goPure :: Monad x => Direction2D -> WNInput x -> x WNOutput
goPure :: forall (x :: * -> *).
Monad x =>
Direction2D -> WNInput x -> x WNOutput
goPure Direction2D
dir input :: WNInput x
input@(Map WorkspaceId Point
oldState, WindowSet
oldWindowSet, Set KeySym
mappedWindows, WindowRectFn x
_) =
if forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> Set a -> Bool
`S.member` Set KeySym
mappedWindows) forall a b. (a -> b) -> a -> b
$ forall a. Maybe (Stack a) -> [a]
W.integrate' forall a b. (a -> b) -> a -> b
$ forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
oldWindowSet) forall a. Eq a => a -> a -> Bool
== Int
1
then
forall (m :: * -> *) a. Monad m => a -> m a
return ( Map WorkspaceId Point
oldState
, case Direction2D
dir of
Direction2D
U -> forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusUp WindowSet
oldWindowSet
Direction2D
L -> forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusDown WindowSet
oldWindowSet
Direction2D
D -> forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusDown WindowSet
oldWindowSet
Direction2D
R -> forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusUp WindowSet
oldWindowSet
)
else
forall (x :: * -> *).
Monad x =>
(KeySym -> WindowSet -> WindowSet)
-> Direction2D -> WNInput x -> x WNOutput
withTargetWindow 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 Direction2D
dir WNInput x
input
swapPure :: Monad x => Direction2D -> WNInput x -> x WNOutput
swapPure :: forall (x :: * -> *).
Monad x =>
Direction2D -> WNInput x -> x WNOutput
swapPure = forall (x :: * -> *).
Monad x =>
(KeySym -> WindowSet -> WindowSet)
-> Direction2D -> WNInput x -> x WNOutput
withTargetWindow 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 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 -> 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 forall a b. (a -> b) -> a -> b
$
forall {a} {i} {l} {s} {sd}.
(a -> a) -> StackSet i l a s sd -> StackSet i l a s sd
mapWindows (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 = 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 (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 = forall {a} {a}. (a -> a) -> Stack a -> Stack a
mapWindows'' a -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Stack a)
s }
mapWindows'' :: (a -> a) -> Stack a -> Stack a
mapWindows'' a -> a
f (W.Stack a
focused [a]
up [a]
down) = forall a. a -> [a] -> [a] -> Stack a
W.Stack (a -> a
f a
focused) (forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
up) (forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
down)
swapWin :: a -> a -> a -> a
swapWin a
win1 a
win2 a
win
| a
win forall a. Eq a => a -> a -> Bool
== a
win1 = a
win2
| a
win forall a. Eq a => a -> a -> Bool
== a
win2 = a
win1
| Bool
otherwise = a
win
withTargetWindow :: Monad x => (Window -> WindowSet -> WindowSet) -> Direction2D -> WNInput x -> x WNOutput
withTargetWindow :: forall (x :: * -> *).
Monad x =>
(KeySym -> WindowSet -> WindowSet)
-> Direction2D -> WNInput x -> x WNOutput
withTargetWindow KeySym -> WindowSet -> WindowSet
adj Direction2D
dir input :: WNInput x
input@(Map WorkspaceId Point
oldState, WindowSet
oldWindowSet, Set KeySym
_, WindowRectFn x
_) = do
forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' (forall (x :: * -> *).
Monad x =>
WNInput x -> x (Maybe (KeySym, Rectangle, Point))
getCurrentWindow WNInput x
input) (Map WorkspaceId Point
oldState, WindowSet
oldWindowSet) forall a b. (a -> b) -> a -> b
$ \(KeySym
win, Rectangle
winRect, Point
pos) -> do
Maybe (KeySym, Point)
targetMaybe <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
/= KeySym
win) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: * -> *).
Monad x =>
WNInput x
-> Direction2D -> Rectangle -> Point -> x [(KeySym, Point)]
navigableTargets WNInput x
input Direction2D
dir Rectangle
winRect Point
pos
forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' (forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (KeySym, Point)
targetMaybe) (Map WorkspaceId Point
oldState, WindowSet
oldWindowSet) forall a b. (a -> b) -> a -> b
$ \(KeySym
targetWin, Point
newPos) ->
let newWindowSet :: WindowSet
newWindowSet = KeySym -> WindowSet -> WindowSet
adj KeySym
targetWin WindowSet
oldWindowSet
in forall (m :: * -> *) a. Monad m => a -> m a
return (WindowSet
-> Point -> Map WorkspaceId Point -> Map WorkspaceId Point
modifyState WindowSet
newWindowSet Point
newPos Map WorkspaceId Point
oldState, WindowSet
newWindowSet)
trackMovement :: IORef WNState -> X ()
trackMovement :: IORef (Map WorkspaceId Point) -> X ()
trackMovement IORef (Map WorkspaceId Point)
stateRef = do
Map WorkspaceId Point
oldState <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (forall a. IORef a -> IO a
readIORef IORef (Map WorkspaceId Point)
stateRef)
WindowSet
oldWindowSet <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
Set KeySym
mappedWindows <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> Set KeySym
mapped
forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' (forall (x :: * -> *).
Monad x =>
WNInput x -> x (Maybe (KeySym, Rectangle, Point))
getCurrentWindow (Map WorkspaceId Point
oldState, WindowSet
oldWindowSet, Set KeySym
mappedWindows, KeySym -> X (Maybe Rectangle)
windowRectX)) () forall a b. (a -> b) -> a -> b
$ \(KeySym
_, Rectangle
_, Point
pos) -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Map WorkspaceId Point)
stateRef forall a b. (a -> b) -> a -> b
$ WindowSet
-> Point -> Map WorkspaceId Point -> Map WorkspaceId Point
modifyState WindowSet
oldWindowSet Point
pos Map WorkspaceId Point
oldState
getCurrentWindow :: Monad x => WNInput x -> x (Maybe (Window, Rectangle, Point))
getCurrentWindow :: forall (x :: * -> *).
Monad x =>
WNInput x -> x (Maybe (KeySym, Rectangle, Point))
getCurrentWindow input :: WNInput x
input@(Map WorkspaceId Point
_, WindowSet
oldWindowSet, Set KeySym
_, WindowRectFn x
_) =
forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
oldWindowSet) forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ \KeySym
window -> do
(Point
pos, Rectangle
rect) <- forall (x :: * -> *). Monad x => WNInput x -> x (Point, Rectangle)
currentPosition WNInput x
input
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (KeySym
window, Rectangle
rect, Point
pos)
currentPosition :: Monad x => WNInput x -> x (Point, Rectangle)
currentPosition :: forall (x :: * -> *). Monad x => WNInput x -> x (Point, Rectangle)
currentPosition (Map WorkspaceId Point
state, WindowSet
oldWindowSet, Set KeySym
_, WindowRectFn x
windowRect) = do
Rectangle
currentRect <- forall a. a -> Maybe a -> a
fromMaybe (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
0 Dimension
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) WindowRectFn x
windowRect (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
oldWindowSet)
let posMaybe :: Maybe Point
posMaybe = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
oldWindowSet) Map WorkspaceId Point
state
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)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Point
posMaybe of
Maybe Point
Nothing -> (Rectangle -> Point
middleOf Rectangle
currentRect, Rectangle
currentRect)
Just Point
pos -> (Rectangle -> Point -> Point
centerPosition Rectangle
currentRect Point
pos, Rectangle
currentRect)
modifyState :: WindowSet -> Point -> WNState -> WNState
modifyState :: WindowSet
-> Point -> Map WorkspaceId Point -> Map WorkspaceId Point
modifyState WindowSet
oldWindowSet =
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
oldWindowSet)
centerPosition :: Rectangle -> Point -> Point
centerPosition :: Rectangle -> Point -> Point
centerPosition r :: Rectangle
r@(Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) pos :: Point
pos@(Point Position
x Position
y) = do
if Position -> Position -> Rectangle -> Bool
pointWithin Position
x Position
y Rectangle
r
then Point
pos
else Position -> Position -> Point
Point (Position -> Dimension -> Position
midPoint Position
rx Dimension
rw) (Position -> Dimension -> Position
midPoint Position
ry Dimension
rh)
midPoint :: Position -> Dimension -> Position
midPoint :: Position -> Dimension -> Position
midPoint Position
pos Dimension
dim = Position
pos forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
dim forall a. Integral a => a -> a -> a
`div` Position
2
navigableTargets :: Monad x => WNInput x -> Direction2D -> Rectangle -> Point -> x [(Window, Point)]
navigableTargets :: forall (x :: * -> *).
Monad x =>
WNInput x
-> Direction2D -> Rectangle -> Point -> x [(KeySym, Point)]
navigableTargets input :: WNInput x
input@(Map WorkspaceId Point
_, WindowSet
oldWindowSet, Set KeySym
_, WindowRectFn x
_) Direction2D
dir Rectangle
currentRect Point
currentPos = do
[(KeySym, DirRectangle)]
allScreensWindowsAndRectangles <- forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd (Direction2D -> Rectangle -> DirRectangle
rectTransform Direction2D
dir) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: * -> *).
Monad x =>
WNInput x -> x [(KeySym, Rectangle)]
windowRects WNInput x
input
let
screenWindows :: Set KeySym
screenWindows = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a. Maybe (Stack a) -> [a]
W.integrate' forall a b. (a -> b) -> a -> b
$ forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
oldWindowSet
([(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles, [(KeySym, DirRectangle)]
otherScreensWindowsAndRectangles) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(KeySym
w, DirRectangle
_) -> forall a. Ord a => a -> Set a -> Bool
S.member KeySym
w Set KeySym
screenWindows) [(KeySym, DirRectangle)]
allScreensWindowsAndRectangles
pos :: DirPoint
pos = Direction2D -> Point -> DirPoint
pointTransform Direction2D
dir Point
currentPos
wr :: DirRectangle
wr = Direction2D -> Rectangle -> DirRectangle
rectTransform Direction2D
dir Rectangle
currentRect
rectInside :: DirRectangle -> Bool
rectInside DirRectangle
r = (DirRectangle -> Position
rect_p1 DirRectangle
r forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_p1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p1 DirRectangle
r forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_p2 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p2 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_p1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p2 DirRectangle
r forall a. Ord a => a -> a -> Bool
<= DirRectangle -> Position
rect_p2 DirRectangle
wr) Bool -> Bool -> Bool
&&
((DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r forall a. Ord a => a -> a -> Bool
<= DirRectangle -> Position
rect_o2 DirRectangle
wr) Bool -> Bool -> Bool
||
(DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Ord a => a -> a -> Bool
<= DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_o2 DirRectangle
wr))
sortByP2 :: [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByP2 = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (DirRectangle -> Position
rect_p2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
posBeforeEdge :: DirRectangle -> Bool
posBeforeEdge DirRectangle
r = DirPoint -> Position
point_p DirPoint
pos forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_p2 DirRectangle
r
rectOverlapsEdge :: DirRectangle -> Bool
rectOverlapsEdge DirRectangle
r = DirRectangle -> Position
rect_p1 DirRectangle
r forall a. Ord a => a -> a -> Bool
<= DirRectangle -> Position
rect_p2 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p2 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_p2 DirRectangle
wr Bool -> Bool -> Bool
&&
DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_o1 DirRectangle
wr
rectOverlapsOneEdge :: DirRectangle -> Bool
rectOverlapsOneEdge DirRectangle
r = DirRectangle -> Bool
rectOverlapsEdge DirRectangle
r Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p1 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_p1 DirRectangle
wr
rectOverlapsBothEdges :: DirRectangle -> Bool
rectOverlapsBothEdges DirRectangle
r = DirRectangle -> Bool
rectOverlapsEdge DirRectangle
r Bool -> Bool -> Bool
&&
DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
wr Bool -> Bool -> Bool
&& DirPoint -> Position
point_o DirPoint
pos forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_o1 DirRectangle
r Bool -> Bool -> Bool
&& DirPoint -> Position
point_o DirPoint
pos forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
r
distanceToRectEdge :: DirRectangle -> Position
distanceToRectEdge DirRectangle
r = forall a. Ord a => a -> a -> a
max (forall a. Ord a => a -> a -> a
max Position
0 (DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Num a => a -> a -> a
- DirPoint -> Position
point_o DirPoint
pos)) (forall a. Ord a => a -> a -> a
max Position
0 (DirPoint -> Position
point_o DirPoint
pos forall a. Num a => a -> a -> a
+ Position
1 forall a. Num a => a -> a -> a
- DirRectangle -> Position
rect_o2 DirRectangle
r))
distanceToRectCenter :: DirRectangle -> Position
distanceToRectCenter DirRectangle
r =
let distance :: Position
distance = (DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Num a => a -> a -> a
+ DirRectangle -> Position
rect_o2 DirRectangle
r) forall a. Integral a => a -> a -> a
`div` Position
2 forall a. Num a => a -> a -> a
- DirPoint -> Position
point_o DirPoint
pos
in if Position
distance forall a. Ord a => a -> a -> Bool
<= Position
0
then Position
distance forall a. Num a => a -> a -> a
+ Position
1
else Position
distance
sortByPosDistance :: [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((\DirRectangle
r -> (DirRectangle -> Position
rect_p1 DirRectangle
r, DirRectangle -> Position
distanceToRectEdge DirRectangle
r, DirRectangle -> Position
distanceToRectCenter DirRectangle
r)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
rectOutside :: DirRectangle -> Bool
rectOutside DirRectangle
r = DirRectangle -> Position
rect_p1 DirRectangle
r forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_p1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p2 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_p2 DirRectangle
wr Bool -> Bool -> Bool
&&
DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_o2 DirRectangle
wr
sortByLength :: [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByLength = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (DirRectangle -> Dimension
rect_psize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
rectAfterEdge :: DirRectangle -> Bool
rectAfterEdge DirRectangle
r = DirRectangle -> Position
rect_p1 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_p2 DirRectangle
wr
inr :: DirRectangle -> Bool
inr DirRectangle
r = DirPoint -> Position
point_p DirPoint
pos forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_p2 DirRectangle
r Bool -> Bool -> Bool
&& DirPoint -> Position
point_o DirPoint
pos forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_o1 DirRectangle
r Bool -> Bool -> Bool
&& DirPoint -> Position
point_o DirPoint
pos forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
r
clamp :: a -> a -> a -> a
clamp a
v a
v1 a
v2 | a
v forall a. Ord a => a -> a -> Bool
< a
v1 = a
v1
| a
v forall a. Ord a => a -> a -> Bool
>= a
v2 = a
v2 forall a. Num a => a -> a -> a
- a
1
| Bool
otherwise = a
v
dragPos :: DirRectangle -> DirPoint
dragPos DirRectangle
r = Position -> Position -> DirPoint
DirPoint (forall a. Ord a => a -> a -> a
max (DirPoint -> Position
point_p DirPoint
pos) (DirRectangle -> Position
rect_p1 DirRectangle
r)) (forall {a}. (Ord a, Num a) => a -> a -> a -> a
clamp (DirPoint -> Position
point_o DirPoint
pos) (DirRectangle -> Position
rect_o1 DirRectangle
r) (DirRectangle -> Position
rect_o2 DirRectangle
r))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd (Direction2D -> DirPoint -> Point
inversePointTransform Direction2D
dir) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[
forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd DirRectangle -> DirPoint
dragPos forall a b. (a -> b) -> a -> b
$ forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByP2 forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
posBeforeEdge forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
rectInside [(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles
, forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd DirRectangle -> DirPoint
dragPos forall a b. (a -> b) -> a -> b
$ forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
rectOverlapsOneEdge [(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles
, forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd (\DirRectangle
_ -> Position -> Position -> DirPoint
DirPoint (DirRectangle -> Position
rect_p2 DirRectangle
wr) (DirPoint -> Position
point_o DirPoint
pos)) forall a b. (a -> b) -> a -> b
$ forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
rectOverlapsBothEdges [(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles
, forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd (\DirRectangle
_ -> Position -> Position -> DirPoint
DirPoint (DirRectangle -> Position
rect_p2 DirRectangle
wr) (DirPoint -> Position
point_o DirPoint
pos)) forall a b. (a -> b) -> a -> b
$ forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByLength forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
rectOutside [(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles
, forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd DirRectangle -> DirPoint
dragPos forall a b. (a -> b) -> a -> b
$ forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
rectAfterEdge [(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles
, forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd DirRectangle -> DirPoint
dragPos forall a b. (a -> b) -> a -> b
$ forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
inr [(KeySym, DirRectangle)]
otherScreensWindowsAndRectangles
, forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd (\DirRectangle
r -> Position -> Position -> DirPoint
DirPoint (DirRectangle -> Position
rect_p2 DirRectangle
r forall a. Num a => a -> a -> a
- Position
1) (forall {a}. (Ord a, Num a) => a -> a -> a -> a
clamp (DirPoint -> Position
point_o DirPoint
pos) (DirRectangle -> Position
rect_o1 DirRectangle
r) (DirRectangle -> Position
rect_o2 DirRectangle
r))) forall a b. (a -> b) -> a -> b
$
forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByP2 forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirRectangle -> Bool
posBeforeEdge) forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
rectInside [(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles
]
data DirPoint = DirPoint
{ DirPoint -> Position
point_p :: Position
, DirPoint -> Position
point_o :: Position
}
data DirRectangle = DirRectangle
{ DirRectangle -> Position
rect_p1 :: Position
, DirRectangle -> Position
rect_p2 :: Position
, DirRectangle -> Position
rect_o1 :: Position
, DirRectangle -> Position
rect_o2 :: Position
}
rect_psize :: DirRectangle -> Dimension
rect_psize :: DirRectangle -> Dimension
rect_psize DirRectangle
r = forall a b. (Integral a, Num b) => a -> b
fromIntegral (DirRectangle -> Position
rect_p2 DirRectangle
r forall a. Num a => a -> a -> a
- DirRectangle -> Position
rect_p1 DirRectangle
r)
pointTransform :: Direction2D -> Point -> DirPoint
pointTransform :: Direction2D -> Point -> DirPoint
pointTransform Direction2D
dir (Point Position
x Position
y) = case Direction2D
dir of
Direction2D
U -> Position -> Position -> DirPoint
DirPoint (forall a. Num a => a -> a
negate Position
y forall a. Num a => a -> a -> a
- Position
1) Position
x
Direction2D
L -> Position -> Position -> DirPoint
DirPoint (forall a. Num a => a -> a
negate Position
x forall a. Num a => a -> a -> a
- Position
1) (forall a. Num a => a -> a
negate Position
y forall a. Num a => a -> a -> a
- Position
1)
Direction2D
D -> Position -> Position -> DirPoint
DirPoint Position
y (forall a. Num a => a -> a
negate Position
x forall a. Num a => a -> a -> a
- Position
1)
Direction2D
R -> Position -> Position -> DirPoint
DirPoint Position
x Position
y
inversePointTransform :: Direction2D -> DirPoint -> Point
inversePointTransform :: Direction2D -> DirPoint -> Point
inversePointTransform Direction2D
dir DirPoint
p = case Direction2D
dir of
Direction2D
U -> Position -> Position -> Point
Point (DirPoint -> Position
point_o DirPoint
p) (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ DirPoint -> Position
point_p DirPoint
p forall a. Num a => a -> a -> a
+ Position
1)
Direction2D
L -> Position -> Position -> Point
Point (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ DirPoint -> Position
point_p DirPoint
p forall a. Num a => a -> a -> a
+ Position
1) (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ DirPoint -> Position
point_o DirPoint
p forall a. Num a => a -> a -> a
+ Position
1)
Direction2D
D -> Position -> Position -> Point
Point (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ DirPoint -> Position
point_o DirPoint
p forall a. Num a => a -> a -> a
+ Position
1) (DirPoint -> Position
point_p DirPoint
p)
Direction2D
R -> Position -> Position -> Point
Point (DirPoint -> Position
point_p DirPoint
p) (DirPoint -> Position
point_o DirPoint
p)
rectTransform :: Direction2D -> Rectangle -> DirRectangle
rectTransform :: Direction2D -> Rectangle -> DirRectangle
rectTransform Direction2D
dir (Rectangle Position
x Position
y Dimension
w Dimension
h) = case Direction2D
dir of
Direction2D
U -> Position -> Position -> Position -> Position -> DirRectangle
DirRectangle (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h) (forall a. Num a => a -> a
negate Position
y) Position
x (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w)
Direction2D
L -> Position -> Position -> Position -> Position -> DirRectangle
DirRectangle (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w) (forall a. Num a => a -> a
negate Position
x) (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h) (forall a. Num a => a -> a
negate Position
y)
Direction2D
D -> Position -> Position -> Position -> Position -> DirRectangle
DirRectangle Position
y (Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h) (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w) (forall a. Num a => a -> a
negate Position
x)
Direction2D
R -> Position -> Position -> Position -> Position -> DirRectangle
DirRectangle Position
x (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w) Position
y (Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h)
windowRects :: Monad x => WNInput x -> x [(Window, Rectangle)]
windowRects :: forall (x :: * -> *).
Monad x =>
WNInput x -> x [(KeySym, Rectangle)]
windowRects (Map WorkspaceId Point
_, WindowSet
oldWindowSet, Set KeySym
mappedWindows, WindowRectFn x
windowRect) =
let
allWindows :: [KeySym]
allWindows = forall a. (a -> Bool) -> [a] -> [a]
filter (\KeySym
w -> KeySym
w forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
oldWindowSet) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set KeySym
mappedWindows
windowRect2 :: KeySym -> x (Maybe (KeySym, Rectangle))
windowRect2 KeySym
w = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (KeySym
w,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WindowRectFn x
windowRect KeySym
w
in forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM KeySym -> x (Maybe (KeySym, Rectangle))
windowRect2 [KeySym]
allWindows
windowRectX :: Window -> X (Maybe Rectangle)
windowRectX :: KeySym -> X (Maybe Rectangle)
windowRectX KeySym
win = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
(KeySym
_, Position
x, Position
y, Dimension
w, Dimension
h, Dimension
bw, CInt
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> KeySym
-> IO
(KeySym, Position, Position, Dimension, Dimension, Dimension, CInt)
getGeometry Display
dpy KeySym
win
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Dimension
w forall a. Num a => a -> a -> a
+ Dimension
2 forall a. Num a => a -> a -> a
* Dimension
bw) (Dimension
h forall a. Num a => a -> a -> a
+ Dimension
2 forall a. Num a => a -> a -> a
* Dimension
bw)
forall a. X a -> X a -> X a
`catchX` forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
whenJust' :: Monad x => x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' :: forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' x (Maybe a)
monadMaybeValue b
deflt a -> x b
f = do
Maybe a
maybeValue <- x (Maybe a)
monadMaybeValue
case Maybe a
maybeValue of
Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return b
deflt
Just a
value -> a -> x b
f a
value
filterSnd :: (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd :: forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd b -> Bool
f = forall a. (a -> Bool) -> [a] -> [a]
filter (b -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
mapSnd :: (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd :: forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd b -> b'
f = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second b -> b'
f)