{-# LANGUAGE MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}
module XMonad.Actions.Navigation2D (
navigation2D
, navigation2DP
, additionalNav2DKeys
, additionalNav2DKeysP
, withNavigation2DConfig
, Navigation2DConfig(..)
, def
, Navigation2D
, lineNavigation
, centerNavigation
, sideNavigation
, sideNavigationWithBias
, hybridOf
, fullScreenRect
, singleWindowRect
, switchLayer
, windowGo
, windowSwap
, windowToScreen
, screenGo
, screenSwap
, Direction2D(..)
) where
import qualified Data.List as L
import qualified Data.Map as M
import Control.Arrow (second)
import XMonad.Prelude
import XMonad hiding (Screen)
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.EZConfig (additionalKeys, additionalKeysP)
import XMonad.Util.Types
import qualified Data.List.NonEmpty as NE
type Rect a = (a, Rectangle)
type WinRect = Rect Window
type WSRect = Rect WorkspaceId
data Navigation2D = N Generality (forall a . Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
runNav :: forall a . Eq a => Navigation2D -> (Direction2D -> Rect a -> [Rect a] -> Maybe a)
runNav :: forall a.
Eq a =>
Navigation2D -> Direction2D -> Rect a -> [Rect a] -> Maybe a
runNav (N Int
_ forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
nav) = forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
nav
type Generality = Int
instance Eq Navigation2D where
(N Int
x forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
_) == :: Navigation2D -> Navigation2D -> Bool
== (N Int
y forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
_) = Int
x forall a. Eq a => a -> a -> Bool
== Int
y
instance Ord Navigation2D where
(N Int
x forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
_) <= :: Navigation2D -> Navigation2D -> Bool
<= (N Int
y forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
_) = Int
x forall a. Ord a => a -> a -> Bool
<= Int
y
lineNavigation :: Navigation2D
lineNavigation :: Navigation2D
lineNavigation = Int
-> (forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
-> Navigation2D
N Int
1 forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doLineNavigation
centerNavigation :: Navigation2D
centerNavigation :: Navigation2D
centerNavigation = Int
-> (forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
-> Navigation2D
N Int
2 forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doCenterNavigation
sideNavigation :: Navigation2D
sideNavigation :: Navigation2D
sideNavigation = Int
-> (forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
-> Navigation2D
N Int
1 (forall a.
Eq a =>
Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
doSideNavigationWithBias Int
1)
sideNavigationWithBias :: Int -> Navigation2D
sideNavigationWithBias :: Int -> Navigation2D
sideNavigationWithBias Int
b = Int
-> (forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
-> Navigation2D
N Int
1 (forall a.
Eq a =>
Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
doSideNavigationWithBias Int
b)
hybridOf :: Navigation2D -> Navigation2D -> Navigation2D
hybridOf :: Navigation2D -> Navigation2D -> Navigation2D
hybridOf (N Int
g1 forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
s1) (N Int
g2 forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
s2) = Int
-> (forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
-> Navigation2D
N (forall a. Ord a => a -> a -> a
max Int
g1 Int
g2) forall a b. (a -> b) -> a -> b
$ forall {f :: * -> *} {t} {t} {t} {a}.
Alternative f =>
(t -> t -> t -> f a) -> (t -> t -> t -> f a) -> t -> t -> t -> f a
applyToBoth forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
s1 forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
s2
where
applyToBoth :: (t -> t -> t -> f a) -> (t -> t -> t -> f a) -> t -> t -> t -> f a
applyToBoth t -> t -> t -> f a
f t -> t -> t -> f a
g t
a t
b t
c = t -> t -> t -> f a
f t
a t
b t
c forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> t -> t -> t -> f a
g t
a t
b t
c
data Navigation2DConfig = Navigation2DConfig
{ Navigation2DConfig -> Navigation2D
defaultTiledNavigation :: Navigation2D
, Navigation2DConfig -> Navigation2D
floatNavigation :: Navigation2D
, Navigation2DConfig -> Navigation2D
screenNavigation :: Navigation2D
, Navigation2DConfig -> [(WorkspaceId, Navigation2D)]
layoutNavigation :: [(String, Navigation2D)]
, Navigation2DConfig
-> [(WorkspaceId, Screen -> Window -> X (Maybe Rectangle))]
unmappedWindowRect :: [(String, Screen -> Window -> X (Maybe Rectangle))]
}
type Screen = WindowScreen
navigation2D :: Navigation2DConfig -> (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] ->
Bool -> XConfig l -> XConfig l
navigation2D :: forall (l :: * -> *).
Navigation2DConfig
-> (Window, Window, Window, Window)
-> [(ButtonMask, Direction2D -> Bool -> X ())]
-> Bool
-> XConfig l
-> XConfig l
navigation2D Navigation2DConfig
navConfig (Window
u, Window
l, Window
d, Window
r) [(ButtonMask, Direction2D -> Bool -> X ())]
modifiers Bool
wrap XConfig l
xconfig =
forall (l :: * -> *).
(Window, Window, Window, Window)
-> [(ButtonMask, Direction2D -> Bool -> X ())]
-> Bool
-> XConfig l
-> XConfig l
additionalNav2DKeys (Window
u, Window
l, Window
d, Window
r) [(ButtonMask, Direction2D -> Bool -> X ())]
modifiers Bool
wrap forall a b. (a -> b) -> a -> b
$
forall (a :: * -> *). Navigation2DConfig -> XConfig a -> XConfig a
withNavigation2DConfig Navigation2DConfig
navConfig XConfig l
xconfig
navigation2DP :: Navigation2DConfig -> (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] ->
Bool -> XConfig l -> XConfig l
navigation2DP :: forall (l :: * -> *).
Navigation2DConfig
-> (WorkspaceId, WorkspaceId, WorkspaceId, WorkspaceId)
-> [(WorkspaceId, Direction2D -> Bool -> X ())]
-> Bool
-> XConfig l
-> XConfig l
navigation2DP Navigation2DConfig
navConfig (WorkspaceId
u, WorkspaceId
l, WorkspaceId
d, WorkspaceId
r) [(WorkspaceId, Direction2D -> Bool -> X ())]
modifiers Bool
wrap XConfig l
xconfig =
forall (l :: * -> *).
(WorkspaceId, WorkspaceId, WorkspaceId, WorkspaceId)
-> [(WorkspaceId, Direction2D -> Bool -> X ())]
-> Bool
-> XConfig l
-> XConfig l
additionalNav2DKeysP (WorkspaceId
u, WorkspaceId
l, WorkspaceId
d, WorkspaceId
r) [(WorkspaceId, Direction2D -> Bool -> X ())]
modifiers Bool
wrap forall a b. (a -> b) -> a -> b
$
forall (a :: * -> *). Navigation2DConfig -> XConfig a -> XConfig a
withNavigation2DConfig Navigation2DConfig
navConfig XConfig l
xconfig
additionalNav2DKeys :: (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] ->
Bool -> XConfig l -> XConfig l
additionalNav2DKeys :: forall (l :: * -> *).
(Window, Window, Window, Window)
-> [(ButtonMask, Direction2D -> Bool -> X ())]
-> Bool
-> XConfig l
-> XConfig l
additionalNav2DKeys (Window
u, Window
l, Window
d, Window
r) [(ButtonMask, Direction2D -> Bool -> X ())]
modifiers Bool
wrap =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (a :: * -> *).
XConfig a -> [((ButtonMask, Window), X ())] -> XConfig a
additionalKeys [((ButtonMask
modif, Window
k), Direction2D -> Bool -> X ()
func Direction2D
dir Bool
wrap) | (ButtonMask
modif, Direction2D -> Bool -> X ()
func) <- [(ButtonMask, Direction2D -> Bool -> X ())]
modifiers, (Window
k, Direction2D
dir) <- [(Window, Direction2D)]
dirKeys]
where dirKeys :: [(Window, Direction2D)]
dirKeys = [(Window
u, Direction2D
U), (Window
l, Direction2D
L), (Window
d, Direction2D
D), (Window
r, Direction2D
R)]
additionalNav2DKeysP :: (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] ->
Bool -> XConfig l -> XConfig l
additionalNav2DKeysP :: forall (l :: * -> *).
(WorkspaceId, WorkspaceId, WorkspaceId, WorkspaceId)
-> [(WorkspaceId, Direction2D -> Bool -> X ())]
-> Bool
-> XConfig l
-> XConfig l
additionalNav2DKeysP (WorkspaceId
u, WorkspaceId
l, WorkspaceId
d, WorkspaceId
r) [(WorkspaceId, Direction2D -> Bool -> X ())]
modifiers Bool
wrap =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (l :: * -> *).
XConfig l -> [(WorkspaceId, X ())] -> XConfig l
additionalKeysP [(WorkspaceId
modif forall a. [a] -> [a] -> [a]
++ WorkspaceId
k, Direction2D -> Bool -> X ()
func Direction2D
dir Bool
wrap) | (WorkspaceId
modif, Direction2D -> Bool -> X ()
func) <- [(WorkspaceId, Direction2D -> Bool -> X ())]
modifiers, (WorkspaceId
k, Direction2D
dir) <- [(WorkspaceId, Direction2D)]
dirKeys]
where dirKeys :: [(WorkspaceId, Direction2D)]
dirKeys = [(WorkspaceId
u, Direction2D
U), (WorkspaceId
l, Direction2D
L), (WorkspaceId
d, Direction2D
D), (WorkspaceId
r, Direction2D
R)]
instance ExtensionClass Navigation2DConfig where
initialValue :: Navigation2DConfig
initialValue = forall a. Default a => a
def
withNavigation2DConfig :: Navigation2DConfig -> XConfig a -> XConfig a
withNavigation2DConfig :: forall (a :: * -> *). Navigation2DConfig -> XConfig a -> XConfig a
withNavigation2DConfig Navigation2DConfig
conf2d XConfig a
xconf = XConfig a
xconf { startupHook :: X ()
startupHook = forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig a
xconf
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put Navigation2DConfig
conf2d
}
instance Default Navigation2DConfig where
def :: Navigation2DConfig
def = Navigation2DConfig { defaultTiledNavigation :: Navigation2D
defaultTiledNavigation = Navigation2D -> Navigation2D -> Navigation2D
hybridOf Navigation2D
lineNavigation Navigation2D
sideNavigation
, floatNavigation :: Navigation2D
floatNavigation = Navigation2D
centerNavigation
, screenNavigation :: Navigation2D
screenNavigation = Navigation2D
lineNavigation
, layoutNavigation :: [(WorkspaceId, Navigation2D)]
layoutNavigation = []
, unmappedWindowRect :: [(WorkspaceId, Screen -> Window -> X (Maybe Rectangle))]
unmappedWindowRect = []
}
switchLayer :: X ()
switchLayer :: X ()
switchLayer = ([WinRect] -> [WinRect] -> [WinRect])
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
-> Bool
-> X ()
actOnLayer forall a. a -> a -> a
otherLayer
( \ Navigation2DConfig
_ WinRect
cur [WinRect]
wins -> (WindowSet -> WindowSet) -> X ()
windows
forall a b. (a -> b) -> a -> b
$ WinRect -> [WinRect] -> WindowSet -> WindowSet
doFocusClosestWindow WinRect
cur [WinRect]
wins
)
( \ Navigation2DConfig
_ WinRect
cur [WinRect]
wins -> (WindowSet -> WindowSet) -> X ()
windows
forall a b. (a -> b) -> a -> b
$ WinRect -> [WinRect] -> WindowSet -> WindowSet
doFocusClosestWindow WinRect
cur [WinRect]
wins
)
( \ Navigation2DConfig
_ WSRect
_ [WSRect]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return () )
Bool
False
windowGo :: Direction2D -> Bool -> X ()
windowGo :: Direction2D -> Bool -> X ()
windowGo Direction2D
dir = ([WinRect] -> [WinRect] -> [WinRect])
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
-> Bool
-> X ()
actOnLayer forall a. a -> a -> a
thisLayer
( \ Navigation2DConfig
conf WinRect
cur [WinRect]
wins -> (WindowSet -> WindowSet) -> X ()
windows
forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> WindowSet
-> WindowSet
doTiledNavigation Navigation2DConfig
conf Direction2D
dir 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 WinRect
cur [WinRect]
wins
)
( \ Navigation2DConfig
conf WinRect
cur [WinRect]
wins -> (WindowSet -> WindowSet) -> X ()
windows
forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> WindowSet
-> WindowSet
doFloatNavigation Navigation2DConfig
conf Direction2D
dir 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 WinRect
cur [WinRect]
wins
)
( \ Navigation2DConfig
conf WSRect
cur [WSRect]
wspcs -> (WindowSet -> WindowSet) -> X ()
windows
forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (WorkspaceId -> WindowSet -> WindowSet)
-> WSRect
-> [WSRect]
-> WindowSet
-> WindowSet
doScreenNavigation Navigation2DConfig
conf Direction2D
dir forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view WSRect
cur [WSRect]
wspcs
)
windowSwap :: Direction2D -> Bool -> X ()
windowSwap :: Direction2D -> Bool -> X ()
windowSwap Direction2D
dir = ([WinRect] -> [WinRect] -> [WinRect])
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
-> Bool
-> X ()
actOnLayer forall a. a -> a -> a
thisLayer
( \ Navigation2DConfig
conf WinRect
cur [WinRect]
wins -> (WindowSet -> WindowSet) -> X ()
windows
forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> WindowSet
-> WindowSet
doTiledNavigation Navigation2DConfig
conf Direction2D
dir Window -> WindowSet -> WindowSet
swap WinRect
cur [WinRect]
wins
)
( \ Navigation2DConfig
conf WinRect
cur [WinRect]
wins -> (WindowSet -> WindowSet) -> X ()
windows
forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> WindowSet
-> WindowSet
doFloatNavigation Navigation2DConfig
conf Direction2D
dir Window -> WindowSet -> WindowSet
swap WinRect
cur [WinRect]
wins
)
( \ Navigation2DConfig
_ WSRect
_ [WSRect]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return () )
windowToScreen :: Direction2D -> Bool -> X ()
windowToScreen :: Direction2D -> Bool -> X ()
windowToScreen Direction2D
dir = (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -> Bool -> X ()
actOnScreens ( \ Navigation2DConfig
conf WSRect
cur [WSRect]
wspcs -> (WindowSet -> WindowSet) -> X ()
windows
forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (WorkspaceId -> WindowSet -> WindowSet)
-> WSRect
-> [WSRect]
-> WindowSet
-> WindowSet
doScreenNavigation Navigation2DConfig
conf Direction2D
dir forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift WSRect
cur [WSRect]
wspcs
)
screenGo :: Direction2D -> Bool -> X ()
screenGo :: Direction2D -> Bool -> X ()
screenGo Direction2D
dir = (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -> Bool -> X ()
actOnScreens ( \ Navigation2DConfig
conf WSRect
cur [WSRect]
wspcs -> (WindowSet -> WindowSet) -> X ()
windows
forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (WorkspaceId -> WindowSet -> WindowSet)
-> WSRect
-> [WSRect]
-> WindowSet
-> WindowSet
doScreenNavigation Navigation2DConfig
conf Direction2D
dir forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view WSRect
cur [WSRect]
wspcs
)
screenSwap :: Direction2D -> Bool -> X ()
screenSwap :: Direction2D -> Bool -> X ()
screenSwap Direction2D
dir = (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -> Bool -> X ()
actOnScreens ( \ Navigation2DConfig
conf WSRect
cur [WSRect]
wspcs -> (WindowSet -> WindowSet) -> X ()
windows
forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (WorkspaceId -> WindowSet -> WindowSet)
-> WSRect
-> [WSRect]
-> WindowSet
-> WindowSet
doScreenNavigation Navigation2DConfig
conf Direction2D
dir forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.greedyView WSRect
cur [WSRect]
wspcs
)
fullScreenRect :: Screen -> Window -> X (Maybe Rectangle)
fullScreenRect :: Screen -> Window -> X (Maybe Rectangle)
fullScreenRect Screen
scr Window
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall a b. (a -> b) -> a -> b
$ Screen
scr)
singleWindowRect :: Screen -> Window -> X (Maybe Rectangle)
singleWindowRect :: Screen -> Window -> X (Maybe Rectangle)
singleWindowRect Screen
scr Window
win = forall a. [a] -> Maybe a
listToMaybe
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd
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 (layout :: * -> *) a.
LayoutClass layout a =>
Workspace WorkspaceId (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout ((forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen
scr) { stack :: Maybe (Stack Window)
W.stack = forall a. [a] -> Maybe (Stack a)
W.differentiate [Window
win] })
(ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall a b. (a -> b) -> a -> b
$ Screen
scr)
actOnLayer :: ([WinRect] -> [WinRect] -> [WinRect])
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
-> Bool
-> X ()
actOnLayer :: ([WinRect] -> [WinRect] -> [WinRect])
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
-> Bool
-> X ()
actOnLayer [WinRect] -> [WinRect] -> [WinRect]
choice Navigation2DConfig -> WinRect -> [WinRect] -> X ()
tiledact Navigation2DConfig -> WinRect -> [WinRect] -> X ()
floatact Navigation2DConfig -> WSRect -> [WSRect] -> X ()
wsact Bool
wrap = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
winset -> do
Navigation2DConfig
conf <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
([WinRect]
floating, [WinRect]
tiled) <- Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect])
navigableWindows Navigation2DConfig
conf Bool
wrap WindowSet
winset
let cur :: Maybe Window
cur = forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
winset
case Maybe Window
cur of
Maybe Window
Nothing -> (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -> Bool -> X ()
actOnScreens Navigation2DConfig -> WSRect -> [WSRect] -> X ()
wsact Bool
wrap
Just Window
w | Just Rectangle
rect <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Window
w [WinRect]
tiled -> Navigation2DConfig -> WinRect -> [WinRect] -> X ()
tiledact Navigation2DConfig
conf (Window
w, Rectangle
rect) ([WinRect] -> [WinRect] -> [WinRect]
choice [WinRect]
tiled [WinRect]
floating)
| Just Rectangle
rect <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Window
w [WinRect]
floating -> Navigation2DConfig -> WinRect -> [WinRect] -> X ()
floatact Navigation2DConfig
conf (Window
w, Rectangle
rect) ([WinRect] -> [WinRect] -> [WinRect]
choice [WinRect]
floating [WinRect]
tiled)
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
navigableWindows :: Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect])
navigableWindows :: Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect])
navigableWindows Navigation2DConfig
conf Bool
wrap WindowSet
winset = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (\(Window
win, Rectangle
_) -> forall k a. Ord k => k -> Map k a -> Bool
M.member Window
win (forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating WindowSet
winset))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. WindowSet -> Bool -> [Rect a] -> [Rect a]
addWrapping WindowSet
winset Bool
wrap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
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 ( \Screen
scr -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Screen -> Window -> X (Maybe WinRect)
maybeWinRect Screen
scr)
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 Screen
scr
)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> [Screen]
sortedScreens
) WindowSet
winset
where
maybeWinRect :: Screen -> Window -> X (Maybe WinRect)
maybeWinRect Screen
scr Window
win = do
Maybe Rectangle
winrect <- Window -> X (Maybe Rectangle)
windowRect Window
win
Maybe Rectangle
rect <- case Maybe Rectangle
winrect of
Just Rectangle
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Rectangle
winrect
Maybe Rectangle
Nothing -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
(\Screen -> Window -> X (Maybe Rectangle)
f -> Screen -> Window -> X (Maybe Rectangle)
f Screen
scr Window
win)
(forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup (forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> WorkspaceId
description forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> l
W.layout forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
$ Screen
scr) (Navigation2DConfig
-> [(WorkspaceId, Screen -> Window -> X (Maybe Rectangle))]
unmappedWindowRect Navigation2DConfig
conf))
forall (m :: * -> *) a. Monad m => a -> m a
return ((,) Window
win forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Rectangle
rect)
windowRect :: Window -> X (Maybe Rectangle)
windowRect :: Window -> X (Maybe Rectangle)
windowRect Window
win = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
Bool
mp <- Window -> X Bool
isMapped Window
win
if Bool
mp then do (Window
_, 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
-> Window
-> IO
(Window, Position, Position, Dimension, Dimension, Dimension, CInt)
getGeometry Display
dpy Window
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
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
actOnScreens :: (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
-> Bool
-> X ()
actOnScreens :: (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -> Bool -> X ()
actOnScreens Navigation2DConfig -> WSRect -> [WSRect] -> X ()
act Bool
wrap = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
winset -> do
Navigation2DConfig
conf <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
let wsrects :: [WSRect]
wsrects = WindowSet -> Bool -> [WSRect]
visibleWorkspaces WindowSet
winset Bool
wrap
cur :: WorkspaceId
cur = forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall a b. (a -> b) -> a -> b
$ WindowSet
winset
rect :: Rectangle
rect = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup WorkspaceId
cur [WSRect]
wsrects
Navigation2DConfig -> WSRect -> [WSRect] -> X ()
act Navigation2DConfig
conf (WorkspaceId
cur, Rectangle
rect) [WSRect]
wsrects
isMapped :: Window -> X Bool
isMapped :: Window -> X Bool
isMapped = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((CInt
waIsUnmapped forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowAttributes -> CInt
wa_map_state))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> X (Maybe WindowAttributes)
safeGetWindowAttributes
doFocusClosestWindow :: WinRect
-> [WinRect]
-> (WindowSet -> WindowSet)
doFocusClosestWindow :: WinRect -> [WinRect] -> WindowSet -> WindowSet
doFocusClosestWindow (Window
cur, Rectangle
rect) [WinRect]
winrects
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Window, (Position, Position))]
winctrs = forall a. a -> a
id
| Bool
otherwise = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> [a] -> a
L.foldl1' forall {a}.
(a, (Position, Position))
-> (a, (Position, Position)) -> (a, (Position, Position))
closer [(Window, (Position, Position))]
winctrs
where
ctr :: (Position, Position)
ctr = Rectangle -> (Position, Position)
centerOf Rectangle
rect
winctrs :: [(Window, (Position, Position))]
winctrs = forall a. (a -> Bool) -> [a] -> [a]
filter ((Window
cur forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Rectangle -> (Position, Position)
centerOf) [WinRect]
winrects
closer :: (a, (Position, Position))
-> (a, (Position, Position)) -> (a, (Position, Position))
closer wc1 :: (a, (Position, Position))
wc1@(a
_, (Position, Position)
c1) wc2 :: (a, (Position, Position))
wc2@(a
_, (Position, Position)
c2) | (Position, Position) -> (Position, Position) -> Int
lDist (Position, Position)
ctr (Position, Position)
c1 forall a. Ord a => a -> a -> Bool
> (Position, Position) -> (Position, Position) -> Int
lDist (Position, Position)
ctr (Position, Position)
c2 = (a, (Position, Position))
wc2
| Bool
otherwise = (a, (Position, Position))
wc1
doTiledNavigation :: Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> (WindowSet -> WindowSet)
doTiledNavigation :: Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> WindowSet
-> WindowSet
doTiledNavigation Navigation2DConfig
conf Direction2D
dir Window -> WindowSet -> WindowSet
act WinRect
cur [WinRect]
winrects WindowSet
winset
| Just Window
win <- forall a.
Eq a =>
Navigation2D -> Direction2D -> Rect a -> [Rect a] -> Maybe a
runNav Navigation2D
nav Direction2D
dir WinRect
cur [WinRect]
winrects = Window -> WindowSet -> WindowSet
act Window
win WindowSet
winset
| Bool
otherwise = WindowSet
winset
where
layouts :: [WorkspaceId]
layouts = forall a b. (a -> b) -> [a] -> [b]
map (forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> WorkspaceId
description forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> l
W.layout forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens WindowSet
winset
nav :: Navigation2D
nav = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ( forall a. a -> Maybe a -> a
fromMaybe (Navigation2DConfig -> Navigation2D
defaultTiledNavigation Navigation2DConfig
conf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup (Navigation2DConfig -> [(WorkspaceId, Navigation2D)]
layoutNavigation Navigation2DConfig
conf)
) [WorkspaceId]
layouts
doFloatNavigation :: Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> (WindowSet -> WindowSet)
doFloatNavigation :: Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> WindowSet
-> WindowSet
doFloatNavigation Navigation2DConfig
conf Direction2D
dir Window -> WindowSet -> WindowSet
act WinRect
cur [WinRect]
winrects
| Just Window
win <- forall a.
Eq a =>
Navigation2D -> Direction2D -> Rect a -> [Rect a] -> Maybe a
runNav Navigation2D
nav Direction2D
dir WinRect
cur [WinRect]
winrects = Window -> WindowSet -> WindowSet
act Window
win
| Bool
otherwise = forall a. a -> a
id
where
nav :: Navigation2D
nav = Navigation2DConfig -> Navigation2D
floatNavigation Navigation2DConfig
conf
doScreenNavigation :: Navigation2DConfig
-> Direction2D
-> (WorkspaceId -> WindowSet -> WindowSet)
-> WSRect
-> [WSRect]
-> (WindowSet -> WindowSet)
doScreenNavigation :: Navigation2DConfig
-> Direction2D
-> (WorkspaceId -> WindowSet -> WindowSet)
-> WSRect
-> [WSRect]
-> WindowSet
-> WindowSet
doScreenNavigation Navigation2DConfig
conf Direction2D
dir WorkspaceId -> WindowSet -> WindowSet
act WSRect
cur [WSRect]
wsrects
| Just WorkspaceId
ws <- forall a.
Eq a =>
Navigation2D -> Direction2D -> Rect a -> [Rect a] -> Maybe a
runNav Navigation2D
nav Direction2D
dir WSRect
cur [WSRect]
wsrects = WorkspaceId -> WindowSet -> WindowSet
act WorkspaceId
ws
| Bool
otherwise = forall a. a -> a
id
where
nav :: Navigation2D
nav = Navigation2DConfig -> Navigation2D
screenNavigation Navigation2DConfig
conf
doLineNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doLineNavigation :: forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doLineNavigation Direction2D
dir (a
cur, Rectangle
rect) [(a, Rectangle)]
winrects
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, Rectangle)]
winrects' = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> [a] -> a
L.foldl1' forall {a}. (a, Rectangle) -> (a, Rectangle) -> (a, Rectangle)
closer [(a, Rectangle)]
winrects'
where
ctr :: (Position, Position)
ctr@(Position
xc, Position
yc) = Rectangle -> (Position, Position)
centerOf Rectangle
rect
winrects' :: [(a, Rectangle)]
winrects' = forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (a, Rectangle) -> Bool
dirFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((a
cur forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall a b. (a -> b) -> a -> b
$ [(a, Rectangle)]
winrects
dirFilter :: (a, Rectangle) -> Bool
dirFilter (a
_, Rectangle
r) = (Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
L Bool -> Bool -> Bool
&& Rectangle -> Rectangle -> Bool
leftOf Rectangle
r Rectangle
rect Bool -> Bool -> Bool
&& Position -> Rectangle -> Bool
intersectsY Position
yc Rectangle
r)
Bool -> Bool -> Bool
|| (Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
R Bool -> Bool -> Bool
&& Rectangle -> Rectangle -> Bool
leftOf Rectangle
rect Rectangle
r Bool -> Bool -> Bool
&& Position -> Rectangle -> Bool
intersectsY Position
yc Rectangle
r)
Bool -> Bool -> Bool
|| (Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
U Bool -> Bool -> Bool
&& Rectangle -> Rectangle -> Bool
above Rectangle
r Rectangle
rect Bool -> Bool -> Bool
&& Position -> Rectangle -> Bool
intersectsX Position
xc Rectangle
r)
Bool -> Bool -> Bool
|| (Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
D Bool -> Bool -> Bool
&& Rectangle -> Rectangle -> Bool
above Rectangle
rect Rectangle
r Bool -> Bool -> Bool
&& Position -> Rectangle -> Bool
intersectsX Position
xc Rectangle
r)
leftOf :: Rectangle -> Rectangle -> Bool
leftOf Rectangle
r1 Rectangle
r2 = Rectangle -> Position
rect_x Rectangle
r1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
r1) forall a. Ord a => a -> a -> Bool
<= Rectangle -> Position
rect_x Rectangle
r2
above :: Rectangle -> Rectangle -> Bool
above Rectangle
r1 Rectangle
r2 = Rectangle -> Position
rect_y Rectangle
r1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r1) forall a. Ord a => a -> a -> Bool
<= Rectangle -> Position
rect_y Rectangle
r2
intersectsX :: Position -> Rectangle -> Bool
intersectsX Position
x Rectangle
r = Rectangle -> Position
rect_x Rectangle
r forall a. Ord a => a -> a -> Bool
<= Position
x Bool -> Bool -> Bool
&& Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
r) forall a. Ord a => a -> a -> Bool
>= Position
x
intersectsY :: Position -> Rectangle -> Bool
intersectsY Position
y Rectangle
r = Rectangle -> Position
rect_y Rectangle
r forall a. Ord a => a -> a -> Bool
<= Position
y Bool -> Bool -> Bool
&& Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r) forall a. Ord a => a -> a -> Bool
>= Position
y
closer :: (a, Rectangle) -> (a, Rectangle) -> (a, Rectangle)
closer wr1 :: (a, Rectangle)
wr1@(a
_, Rectangle
r1) wr2 :: (a, Rectangle)
wr2@(a
_, Rectangle
r2) | (Position, Position) -> Rectangle -> Position
dist (Position, Position)
ctr Rectangle
r1 forall a. Ord a => a -> a -> Bool
> (Position, Position) -> Rectangle -> Position
dist (Position, Position)
ctr Rectangle
r2 = (a, Rectangle)
wr2
| Bool
otherwise = (a, Rectangle)
wr1
dist :: (Position, Position) -> Rectangle -> Position
dist (Position
x, Position
y) Rectangle
r | Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
L = Position
x forall a. Num a => a -> a -> a
- Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
r)
| Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
R = Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
- Position
x
| Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
U = Position
y forall a. Num a => a -> a -> a
- Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r)
| Bool
otherwise = Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
- Position
y
doCenterNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doCenterNavigation :: forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doCenterNavigation Direction2D
dir (a
cur, Rectangle
rect) [(a, Rectangle)]
winrects
| ((a
w, (Position, Position)
_):[(a, (Position, Position))]
_) <- [(a, (Position, Position))]
onCtr' = forall a. a -> Maybe a
Just a
w
| Bool
otherwise = Maybe a
closestOffCtr
where
(Position
xc, Position
yc) = Rectangle -> (Position, Position)
centerOf Rectangle
rect
winctrs :: [(a, (Position, Position))]
winctrs = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Position, Position) -> (Position, Position)
dirTransform forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> (Position, Position)
centerOf))
forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a]
stackTransform [(a, Rectangle)]
winrects
stackTransform :: [a] -> [a]
stackTransform | Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
L Bool -> Bool -> Bool
|| Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
U = forall {a}. [a] -> [a]
reverse
| Bool
otherwise = forall a. a -> a
id
dirTransform :: (Position, Position) -> (Position, Position)
dirTransform (Position
x, Position
y) | Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
R = ( Position
x forall a. Num a => a -> a -> a
- Position
xc , Position
y forall a. Num a => a -> a -> a
- Position
yc )
| Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
L = (-(Position
x forall a. Num a => a -> a -> a
- Position
xc), -(Position
y forall a. Num a => a -> a -> a
- Position
yc))
| Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
D = ( Position
y forall a. Num a => a -> a -> a
- Position
yc , Position
x forall a. Num a => a -> a -> a
- Position
xc )
| Bool
otherwise = (-(Position
y forall a. Num a => a -> a -> a
- Position
yc), -(Position
x forall a. Num a => a -> a -> a
- Position
xc))
([(a, (Position, Position))]
onCtr, [(a, (Position, Position))]
offCtr) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (\(a
_, (Position
x, Position
y)) -> Position
x forall a. Eq a => a -> a -> Bool
== Position
0 Bool -> Bool -> Bool
&& Position
y forall a. Eq a => a -> a -> Bool
== Position
0) [(a, (Position, Position))]
winctrs
onCtr' :: [(a, (Position, Position))]
onCtr' = forall a. Int -> [a] -> [a]
L.drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
L.dropWhile ((a
cur forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(a, (Position, Position))]
onCtr
offCtr' :: [(a, (Position, Position))]
offCtr' = forall a. (a -> Bool) -> [a] -> [a]
L.filter (\(a
_, (Position
x, Position
y)) -> Position
x forall a. Ord a => a -> a -> Bool
> Position
0 Bool -> Bool -> Bool
&& Position
y forall a. Ord a => a -> a -> Bool
< Position
x Bool -> Bool -> Bool
&& Position
y forall a. Ord a => a -> a -> Bool
>= -Position
x) [(a, (Position, Position))]
offCtr
closestOffCtr :: Maybe a
closestOffCtr = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, (Position, Position))]
offCtr' then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> [a] -> a
L.foldl1' forall {a}.
(a, (Position, Position))
-> (a, (Position, Position)) -> (a, (Position, Position))
closest [(a, (Position, Position))]
offCtr'
closest :: (a, (Position, Position))
-> (a, (Position, Position)) -> (a, (Position, Position))
closest wp :: (a, (Position, Position))
wp@(a
_, p :: (Position, Position)
p@(Position
_, Position
yp)) wq :: (a, (Position, Position))
wq@(a
_, q :: (Position, Position)
q@(Position
_, Position
yq))
| (Position, Position) -> (Position, Position) -> Int
lDist (Position
0, Position
0) (Position, Position)
q forall a. Ord a => a -> a -> Bool
< (Position, Position) -> (Position, Position) -> Int
lDist (Position
0, Position
0) (Position, Position)
p = (a, (Position, Position))
wq
| (Position, Position) -> (Position, Position) -> Int
lDist (Position
0, Position
0) (Position, Position)
p forall a. Ord a => a -> a -> Bool
< (Position, Position) -> (Position, Position) -> Int
lDist (Position
0, Position
0) (Position, Position)
q = (a, (Position, Position))
wp
| Position
yq forall a. Ord a => a -> a -> Bool
< Position
yp = (a, (Position, Position))
wq
| Bool
otherwise = (a, (Position, Position))
wp
data SideRect = SideRect { SideRect -> Int
x1 :: Int, SideRect -> Int
x2 :: Int, SideRect -> Int
y1 :: Int, SideRect -> Int
y2 :: Int }
deriving Int -> SideRect -> ShowS
[SideRect] -> ShowS
SideRect -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [SideRect] -> ShowS
$cshowList :: [SideRect] -> ShowS
show :: SideRect -> WorkspaceId
$cshow :: SideRect -> WorkspaceId
showsPrec :: Int -> SideRect -> ShowS
$cshowsPrec :: Int -> SideRect -> ShowS
Show
toSR :: Rectangle -> SideRect
toSR :: Rectangle -> SideRect
toSR (Rectangle Position
x Position
y Dimension
w Dimension
h) = Int -> Int -> Int -> Int -> SideRect
SideRect (forall a b. (Integral a, Num b) => a -> b
fi Position
x) (forall a b. (Integral a, Num b) => a -> b
fi Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
w) (-forall a b. (Integral a, Num b) => a -> b
fi Position
y forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
h) (-forall a b. (Integral a, Num b) => a -> b
fi Position
y)
doSideNavigationWithBias ::
Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
doSideNavigationWithBias :: forall a.
Eq a =>
Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
doSideNavigationWithBias Int
bias Direction2D
dir (a
cur, Rectangle
rect)
= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn forall {a}. (a, SideRect) -> Int
dist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. (a, SideRect) -> [(a, SideRect)] -> [(a, SideRect)]
acClosest []
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall {a} {a}. (a, SideRect) -> (a, SideRect) -> Bool
`toRightOf` (a
cur, Rectangle -> SideRect
transform Rectangle
rect))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rectangle -> SideRect
transform)
where
cOf :: SideRect -> (Int, Int)
cOf SideRect
r = ((SideRect -> Int
x1 SideRect
r forall a. Num a => a -> a -> a
+ SideRect -> Int
x2 SideRect
r) forall a. Integral a => a -> a -> a
`div` Int
2, (SideRect -> Int
y1 SideRect
r forall a. Num a => a -> a -> a
+ SideRect -> Int
y2 SideRect
r) forall a. Integral a => a -> a -> a
`div` Int
2)
(Int
x0, Int
y0) = SideRect -> (Int, Int)
cOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> SideRect
toSR forall a b. (a -> b) -> a -> b
$ Rectangle
rect
translate :: SideRect -> SideRect
translate SideRect
r = Int -> Int -> Int -> Int -> SideRect
SideRect (SideRect -> Int
x1 SideRect
r forall a. Num a => a -> a -> a
- Int
x0) (SideRect -> Int
x2 SideRect
r forall a. Num a => a -> a -> a
- Int
x0) (SideRect -> Int
y1 SideRect
r forall a. Num a => a -> a -> a
- Int
y0) (SideRect -> Int
y2 SideRect
r forall a. Num a => a -> a -> a
- Int
y0)
rHalfPiCC :: SideRect -> SideRect
rHalfPiCC SideRect
r = Int -> Int -> Int -> Int -> SideRect
SideRect (-SideRect -> Int
y2 SideRect
r) (-SideRect -> Int
y1 SideRect
r) (SideRect -> Int
x1 SideRect
r) (SideRect -> Int
x2 SideRect
r)
rotateToR :: Direction2D -> SideRect -> SideRect
rotateToR Direction2D
d = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Direction2D
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Direction2D
R, Direction2D
D, Direction2D
L, Direction2D
U] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> a -> [a]
iterate SideRect -> SideRect
rHalfPiCC
transform :: Rectangle -> SideRect
transform = Direction2D -> SideRect -> SideRect
rotateToR Direction2D
dir forall b c a. (b -> c) -> (a -> b) -> a -> c
. SideRect -> SideRect
translate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> SideRect
toSR
toRightOf :: (a, SideRect) -> (a, SideRect) -> Bool
toRightOf (a
_, SideRect
r) (a
_, SideRect
c) = (SideRect -> Int
x2 SideRect
r forall a. Ord a => a -> a -> Bool
> SideRect -> Int
x2 SideRect
c) Bool -> Bool -> Bool
&& (SideRect -> Int
y2 SideRect
r forall a. Ord a => a -> a -> Bool
> SideRect -> Int
y1 SideRect
c) Bool -> Bool -> Bool
&& (SideRect -> Int
y1 SideRect
r forall a. Ord a => a -> a -> Bool
< SideRect -> Int
y2 SideRect
c)
acClosest :: (a, SideRect) -> [(a, SideRect)] -> [(a, SideRect)]
acClosest (a
w, SideRect
r) l :: [(a, SideRect)]
l@((a
_, SideRect
r'):[(a, SideRect)]
_) | SideRect -> Int
x1 SideRect
r forall a. Eq a => a -> a -> Bool
== SideRect -> Int
x1 SideRect
r' = (a
w, SideRect
r) forall a. a -> [a] -> [a]
: [(a, SideRect)]
l
| SideRect -> Int
x1 SideRect
r forall a. Ord a => a -> a -> Bool
> SideRect -> Int
x1 SideRect
r' = [(a, SideRect)]
l
acClosest (a
w, SideRect
r) [(a, SideRect)]
_ = [(a
w, SideRect
r)]
dist :: (a, SideRect) -> Int
dist (a
_, SideRect
r) | (SideRect -> Int
y1 SideRect
r forall a. Ord a => a -> a -> Bool
<= Int
bias) Bool -> Bool -> Bool
&& (Int
bias forall a. Ord a => a -> a -> Bool
<= SideRect -> Int
y2 SideRect
r) = Int
0
| Bool
otherwise = forall a. Ord a => a -> a -> a
min (forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ SideRect -> Int
y1 SideRect
r forall a. Num a => a -> a -> a
- Int
bias) (forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ SideRect -> Int
y2 SideRect
r forall a. Num a => a -> a -> a
- Int
bias)
swap :: Window -> WindowSet -> WindowSet
swap :: Window -> WindowSet -> WindowSet
swap Window
win WindowSet
winset = 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 Window
cur
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip 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) WindowSet
newwinset [Window]
newfocused
where
cur :: Window
cur = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
winset
scrs :: [Screen]
scrs = forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens WindowSet
winset
visws :: [Workspace WorkspaceId (Layout Window) Window]
visws = forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace [Screen]
scrs
focused :: [Window]
focused = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Stack a -> a
W.focus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack) [Workspace WorkspaceId (Layout Window) Window]
visws
wins :: [[Window]]
wins = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Maybe (Stack a) -> [a]
W.integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack) [Workspace WorkspaceId (Layout Window) Window]
visws
newfocused :: [Window]
newfocused = forall a b. (a -> b) -> [a] -> [b]
map Window -> Window
swapWins [Window]
focused
newwins :: [[Window]]
newwins = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Window -> Window
swapWins) [[Window]]
wins
swapWins :: Window -> Window
swapWins Window
x | Window
x forall a. Eq a => a -> a -> Bool
== Window
cur = Window
win
| Window
x forall a. Eq a => a -> a -> Bool
== Window
win = Window
cur
| Bool
otherwise = Window
x
newvisws :: [Workspace WorkspaceId (Layout Window) Window]
newvisws = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Workspace WorkspaceId (Layout Window) Window
ws [Window]
wns -> Workspace WorkspaceId (Layout Window) Window
ws { stack :: Maybe (Stack Window)
W.stack = forall a. [a] -> Maybe (Stack a)
W.differentiate [Window]
wns }) [Workspace WorkspaceId (Layout Window) Window]
visws [[Window]]
newwins
newscrs :: [Screen]
newscrs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Screen
scr Workspace WorkspaceId (Layout Window) Window
ws -> Screen
scr { workspace :: Workspace WorkspaceId (Layout Window) Window
W.workspace = Workspace WorkspaceId (Layout Window) Window
ws }) [Screen]
scrs [Workspace WorkspaceId (Layout Window) Window]
newvisws
newwinset :: WindowSet
newwinset = WindowSet
winset { current :: Screen
W.current = forall a. NonEmpty a -> a
NE.head (forall a. HasCallStack => [a] -> NonEmpty a
notEmpty [Screen]
newscrs)
, visible :: [Screen]
W.visible = forall a. Int -> [a] -> [a]
drop Int
1 [Screen]
newscrs
}
centerOf :: Rectangle -> (Position, Position)
centerOf :: Rectangle -> (Position, Position)
centerOf Rectangle
r = (Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
r) forall a. Integral a => a -> a -> a
`div` Position
2, Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r) forall a. Integral a => a -> a -> a
`div` Position
2)
thisLayer, otherLayer :: a -> a -> a
thisLayer :: forall a. a -> a -> a
thisLayer = forall a b. a -> b -> a
const
otherLayer :: forall a. a -> a -> a
otherLayer a
_ a
x = a
x
visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
visibleWorkspaces WindowSet
winset Bool
wrap = forall a. WindowSet -> Bool -> [Rect a] -> [Rect a]
addWrapping WindowSet
winset Bool
wrap
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ( \Screen
scr -> ( forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
$ Screen
scr
, ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall a b. (a -> b) -> a -> b
$ Screen
scr
)
)
forall a b. (a -> b) -> a -> b
$ WindowSet -> [Screen]
sortedScreens WindowSet
winset
addWrapping :: WindowSet
-> Bool
-> [Rect a]
-> [Rect a]
addWrapping :: forall a. WindowSet -> Bool -> [Rect a] -> [Rect a]
addWrapping WindowSet
_ Bool
False [Rect a]
wrects = [Rect a]
wrects
addWrapping WindowSet
winset Bool
True [Rect a]
wrects = [ (a
w, Rectangle
r { rect_x :: Position
rect_x = Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Integer
x
, rect_y :: Position
rect_y = Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Integer
y
}
)
| (a
w, Rectangle
r) <- [Rect a]
wrects
, (Integer
x, Integer
y) <- [(Integer
0, Integer
0), (-Integer
xoff, Integer
0), (Integer
xoff, Integer
0), (Integer
0, -Integer
yoff), (Integer
0, Integer
yoff)]
]
where
(Integer
xoff, Integer
yoff) = WindowSet -> (Integer, Integer)
wrapOffsets WindowSet
winset
wrapOffsets :: WindowSet -> (Integer, Integer)
wrapOffsets :: WindowSet -> (Integer, Integer)
wrapOffsets WindowSet
winset = (Integer
max_x forall a. Num a => a -> a -> a
- Integer
min_x, Integer
max_y forall a. Num a => a -> a -> a
- Integer
min_y)
where
min_x :: Integer
min_x = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Position
rect_x [Rectangle]
rects
min_y :: Integer
min_y = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Position
rect_y [Rectangle]
rects
max_x :: Integer
max_x = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Rectangle
r -> Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
r)) [Rectangle]
rects
max_y :: Integer
max_y = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Rectangle
r -> Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r)) [Rectangle]
rects
rects :: [Rectangle]
rects = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ WindowSet -> Bool -> [WSRect]
visibleWorkspaces WindowSet
winset Bool
False
sortedScreens :: WindowSet -> [Screen]
sortedScreens :: WindowSet -> [Screen]
sortedScreens WindowSet
winset = forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy forall {i} {l} {a} {sid} {i} {l} {a} {sid}.
Screen i l a sid ScreenDetail
-> Screen i l a sid ScreenDetail -> Ordering
cmp
forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens WindowSet
winset
where
cmp :: Screen i l a sid ScreenDetail
-> Screen i l a sid ScreenDetail -> Ordering
cmp Screen i l a sid ScreenDetail
s1 Screen i l a sid ScreenDetail
s2 | Position
x forall a. Ord a => a -> a -> Bool
< Position
x' = Ordering
LT
| Position
x forall a. Ord a => a -> a -> Bool
> Position
x' = Ordering
GT
| Position
y forall a. Ord a => a -> a -> Bool
< Position
x' = Ordering
LT
| Position
y forall a. Ord a => a -> a -> Bool
> Position
y' = Ordering
GT
| Bool
otherwise = Ordering
EQ
where
(Position
x , Position
y ) = Rectangle -> (Position, Position)
centerOf (ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall a b. (a -> b) -> a -> b
$ Screen i l a sid ScreenDetail
s1)
(Position
x', Position
y') = Rectangle -> (Position, Position)
centerOf (ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall a b. (a -> b) -> a -> b
$ Screen i l a sid ScreenDetail
s2)
lDist :: (Position, Position) -> (Position, Position) -> Int
lDist :: (Position, Position) -> (Position, Position) -> Int
lDist (Position
x, Position
y) (Position
x', Position
y') = forall a. Num a => a -> a
abs (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Position
x forall a. Num a => a -> a -> a
- Position
x') forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
abs (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Position
y forall a. Num a => a -> a -> a
- Position
y')