module XMonad.Actions.Warp (
banish,
banishScreen,
Corner(..),
warpToScreen,
warpToWindow
) where
import XMonad.Prelude
import XMonad
import XMonad.StackSet as W
data Corner = UpperLeft | UpperRight | LowerLeft | LowerRight
banish :: Corner -> X ()
banish :: Corner -> X ()
banish Corner
direction = case Corner
direction of
Corner
LowerRight -> Rational -> Rational -> X ()
warpToWindow Rational
1 Rational
1
Corner
LowerLeft -> Rational -> Rational -> X ()
warpToWindow Rational
0 Rational
1
Corner
UpperLeft -> Rational -> Rational -> X ()
warpToWindow Rational
0 Rational
0
Corner
UpperRight -> Rational -> Rational -> X ()
warpToWindow Rational
1 Rational
0
banishScreen :: Corner -> X ()
banishScreen :: Corner -> X ()
banishScreen Corner
direction = case Corner
direction of
Corner
LowerRight -> Rational -> Rational -> X ()
warpToCurrentScreen Rational
1 Rational
1
Corner
LowerLeft -> Rational -> Rational -> X ()
warpToCurrentScreen Rational
0 Rational
1
Corner
UpperLeft -> Rational -> Rational -> X ()
warpToCurrentScreen Rational
0 Rational
0
Corner
UpperRight -> Rational -> Rational -> X ()
warpToCurrentScreen Rational
1 Rational
0
where
warpToCurrentScreen :: Rational -> Rational -> X ()
warpToCurrentScreen Rational
h Rational
v =
do WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
ScreenId -> Rational -> Rational -> X ()
warpToScreen (forall i l a sid sd. Screen i l a sid sd -> sid
W.screen 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
current WindowSet
ws) Rational
h Rational
v
(WindowSet -> WindowSet) -> X ()
windows (forall a b. a -> b -> a
const WindowSet
ws)
fraction :: (Integral a, Integral b) => Rational -> a -> b
fraction :: forall a b. (Integral a, Integral b) => Rational -> a -> b
fraction Rational
f a
x = forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
f forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)
warp :: Window -> Position -> Position -> X ()
warp :: Window -> Position -> Position -> X ()
warp Window
w Position
x Position
y = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> Window
-> Position
-> Position
-> Dimension
-> Dimension
-> Position
-> Position
-> IO ()
warpPointer Display
d Window
none Window
w Position
0 Position
0 Dimension
0 Dimension
0 Position
x Position
y
warpToWindow :: Rational -> Rational -> X ()
warpToWindow :: Rational -> Rational -> X ()
warpToWindow Rational
h Rational
v = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> (Window -> X ()) -> X ()
withFocused forall a b. (a -> b) -> a -> b
$ \Window
w ->
Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
d Window
w forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa ->
Window -> Position -> Position -> X ()
warp Window
w (forall a b. (Integral a, Integral b) => Rational -> a -> b
fraction Rational
h (WindowAttributes -> CInt
wa_width WindowAttributes
wa)) (forall a b. (Integral a, Integral b) => Rational -> a -> b
fraction Rational
v (WindowAttributes -> CInt
wa_height WindowAttributes
wa))
warpToScreen :: ScreenId -> Rational -> Rational -> X ()
warpToScreen :: ScreenId -> Rational -> Rational -> X ()
warpToScreen ScreenId
n Rational
h Rational
v = do
Window
root <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
StackSet{current :: forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
x, visible :: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible = [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
xs} <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ScreenId
nforall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
x forall a. a -> [a] -> [a]
: [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
xs)
forall a b. (a -> b) -> a -> b
$ \Rectangle
r ->
Window -> Position -> Position -> X ()
warp Window
root (Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Integral b) => Rational -> a -> b
fraction Rational
h (Rectangle -> Dimension
rect_width Rectangle
r))
(Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Integral b) => Rational -> a -> b
fraction Rational
v (Rectangle -> Dimension
rect_height Rectangle
r))