mirror of
https://github.com/elkowar/dots-of-war.git
synced 2024-11-06 11:22:23 +00:00
67 lines
2.2 KiB
Haskell
67 lines
2.2 KiB
Haskell
module TiledDragging
|
|
( tiledDrag
|
|
)
|
|
where
|
|
import XMonad
|
|
|
|
import qualified XMonad.StackSet as W
|
|
import XMonad.Layout.DraggingVisualizer
|
|
import Control.Monad
|
|
|
|
|
|
-- | put this as a mouse mapping to be able to drag windows in tiled mode.
|
|
-- you need DraggingVisualizer for this to look good.
|
|
tiledDrag :: Window -> X ()
|
|
tiledDrag window = whenX (isClient window) $ do
|
|
focus window
|
|
(offsetX, offsetY) <- getPointerOffset window
|
|
(winX, winY, winWidth, winHeight) <- getWindowPlacement window
|
|
|
|
mouseDrag
|
|
(\posX posY ->
|
|
let rect = Rectangle (fInt (fInt winX + (posX - fInt offsetX)))
|
|
(fInt (fInt winY + (posY - fInt offsetY)))
|
|
(fInt winWidth)
|
|
(fInt winHeight)
|
|
in sendMessage $ DraggingWindow window rect
|
|
)
|
|
(sendMessage DraggingStopped >> performWindowSwitching window)
|
|
|
|
|
|
-- | get the pointer offset relative to the given windows root coordinates
|
|
getPointerOffset :: Window -> X (Int, Int)
|
|
getPointerOffset win = do
|
|
(_, _, _, oX, oY, _, _, _) <- withDisplay (\d -> io $ queryPointer d win)
|
|
return (fInt oX, fInt oY)
|
|
|
|
-- | return a tuple of windowX, windowY, windowWidth, windowHeight
|
|
getWindowPlacement :: Window -> X (Int, Int, Int, Int)
|
|
getWindowPlacement window = do
|
|
wa <- withDisplay (\d -> io $ getWindowAttributes d window)
|
|
return
|
|
(fInt $ wa_x wa, fInt $ wa_y wa, fInt $ wa_width wa, fInt $ wa_height wa)
|
|
|
|
|
|
performWindowSwitching :: Window -> X ()
|
|
performWindowSwitching win = do
|
|
root <- asks theRoot
|
|
(_, _, selWin, _, _, _, _, _) <- withDisplay (\d -> io $ queryPointer d root)
|
|
ws <- gets windowset
|
|
let allWindows = W.index ws
|
|
when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do
|
|
let allWindowsSwitched = map (switchEntries win selWin) allWindows
|
|
let (ls, t : rs) = break (== win) allWindowsSwitched
|
|
let newStack = W.Stack t (reverse ls) rs
|
|
windows $ W.modify' $ const newStack
|
|
where
|
|
switchEntries a b x | x == a = b
|
|
| x == b = a
|
|
| otherwise = x
|
|
|
|
|
|
|
|
-- | shorthand for fromIntegral
|
|
fInt :: Integral a => Integral b => a -> b
|
|
fInt = fromIntegral
|
|
|
|
|