mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
X.A.WindowNavigation: currentPosition and setPosition share the same inside
logic, now
Aside from documentation, this is pretty much usable, now.
This commit is contained in:
parent
7852e704fa
commit
21dd3fed8f
@ -45,7 +45,7 @@ import Graphics.X11.Xlib
|
|||||||
-- Don't use it! What, are you crazy?
|
-- Don't use it! What, are you crazy?
|
||||||
|
|
||||||
-- TODO:
|
-- TODO:
|
||||||
-- - fix setPosition to use WNState smartly
|
-- - logHook?
|
||||||
-- - cleanup (including inr)
|
-- - cleanup (including inr)
|
||||||
-- - documentation :)
|
-- - documentation :)
|
||||||
-- - tests? (esp. for edge cases in currentPosition)
|
-- - tests? (esp. for edge cases in currentPosition)
|
||||||
@ -109,33 +109,33 @@ withTargetWindow adj posRef dir = fromCurrentPoint $ \win pos -> do
|
|||||||
-- a restart), derives the current position from the current window. Also,
|
-- a restart), derives the current position from the current window. Also,
|
||||||
-- verifies that the position is congruent with the current window (say, if you
|
-- verifies that the position is congruent with the current window (say, if you
|
||||||
-- used mod-j/k or mouse or something).
|
-- used mod-j/k or mouse or something).
|
||||||
-- TODO: factor x + fromIntegral w `div` 2 duplication out
|
|
||||||
currentPosition :: IORef WNState -> X Point
|
currentPosition :: IORef WNState -> X Point
|
||||||
currentPosition posRef = do
|
currentPosition posRef = do
|
||||||
root <- asks theRoot
|
root <- asks theRoot
|
||||||
currentWindow <- gets (W.peek . windowset)
|
currentWindow <- gets (W.peek . windowset)
|
||||||
currentRect@(Rectangle rx ry rw rh) <- maybe (Rectangle 0 0 0 0) snd <$>
|
currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow)
|
||||||
windowRect (fromMaybe root currentWindow)
|
|
||||||
|
|
||||||
wsid <- gets (W.tag . W.workspace . W.current . windowset)
|
wsid <- gets (W.tag . W.workspace . W.current . windowset)
|
||||||
mp <- M.lookup wsid <$> io (readIORef posRef)
|
mp <- M.lookup wsid <$> io (readIORef posRef)
|
||||||
|
|
||||||
case mp of
|
return $ maybe (middleOf currentRect) (`inside` currentRect) mp
|
||||||
Just (Point x y) -> return $ Point (x `inside` (rx, rw)) (y `inside` (ry, rh))
|
|
||||||
_ -> return (middleOf currentRect)
|
|
||||||
|
|
||||||
where pos `inside` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim
|
where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)
|
||||||
then pos
|
|
||||||
else lower + fromIntegral dim `div` 2
|
|
||||||
|
|
||||||
middleOf (Rectangle x y w h) =
|
|
||||||
Point (x + fromIntegral w `div` 2) (y + fromIntegral h `div` 2)
|
|
||||||
|
|
||||||
setPosition :: IORef WNState -> Point -> Rectangle -> X ()
|
setPosition :: IORef WNState -> Point -> Rectangle -> X ()
|
||||||
setPosition posRef _ (Rectangle x y w h) = do
|
setPosition posRef oldPos newRect = do
|
||||||
wsid <- gets (W.tag . W.workspace . W.current . windowset)
|
wsid <- gets (W.tag . W.workspace . W.current . windowset)
|
||||||
let position = Point (x + (fromIntegral w `div` 2)) (y + (fromIntegral h `div` 2))
|
io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect)
|
||||||
io $ modifyIORef posRef $ M.insert wsid position
|
|
||||||
|
inside :: Point -> Rectangle -> Point
|
||||||
|
Point x y `inside` Rectangle rx ry rw rh =
|
||||||
|
Point (x `within` (rx, rw)) (y `within` (ry, rh))
|
||||||
|
where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim
|
||||||
|
then pos
|
||||||
|
else midPoint lower dim
|
||||||
|
|
||||||
|
midPoint :: Position -> Dimension -> Position
|
||||||
|
midPoint pos dim = pos + fromIntegral dim `div` 2
|
||||||
|
|
||||||
navigableTargets :: Point -> Direction -> X [(Window, Rectangle)]
|
navigableTargets :: Point -> Direction -> X [(Window, Rectangle)]
|
||||||
navigableTargets point dir = navigable dir point <$> windowRects
|
navigableTargets point dir = navigable dir point <$> windowRects
|
||||||
|
Loading…
x
Reference in New Issue
Block a user