-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.TiledWindowDragging
-- Description :  Change the position of windows by dragging them.
-- Copyright   :  (c) 2020 Leon Kowarschick
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Leon Kowarschick. <thereal.elkowar@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Provides an action that allows you to change the position of windows by dragging them around.
--
-----------------------------------------------------------------------------

module XMonad.Actions.TiledWindowDragging
  (
  -- * Usage
  -- $usage
    dragWindow
  )
where

import           XMonad
import           XMonad.Prelude
import qualified XMonad.StackSet               as W
import           XMonad.Layout.DraggingVisualizer

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Actions.TiledWindowDragging
-- > import XMonad.Layout.DraggingVisualizer
--
-- then edit your 'layoutHook' by adding the draggingVisualizer to your layout:
--
-- > myLayout = draggingVisualizer $ layoutHook def
--
-- Then add a mouse binding for 'dragWindow':
--
-- > , ((modMask .|. shiftMask, button1), dragWindow)
--
-- For detailed instructions on editing your mouse bindings, see
-- "XMonad.Doc.Extending#Editing_mouse_bindings".



-- | Create a mouse binding for this to be able to drag your windows around.
-- You need "XMonad.Layout.DraggingVisualizer" for this to look good.
dragWindow :: Window -> X ()
dragWindow :: Window -> X ()
dragWindow Window
window = X Bool -> X () -> X ()
whenX (Window -> X Bool
isClient Window
window) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
  Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
dpy Window
window ((WindowAttributes -> X ()) -> X ())
-> (WindowAttributes -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
    Window -> X ()
focus Window
window
    (offsetX, offsetY)                    <- Window -> X (Int, Int)
getPointerOffset Window
window
    let (winX, winY, winWidth, winHeight)  = getWindowPlacement wa

    mouseDrag
        (\Position
posX Position
posY ->
          let rect :: Rectangle
rect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
winX Position -> Position -> Position
forall a. Num a => a -> a -> a
+ (Position
posX Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
offsetX)))
                               (Position -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
winY Position -> Position -> Position
forall a. Num a => a -> a -> a
+ (Position
posY Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
offsetY)))
                               (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
winWidth)
                               (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
winHeight)
          in  DraggingVisualizerMsg -> X ()
forall a. Message a => a -> X ()
sendMessage (DraggingVisualizerMsg -> X ()) -> DraggingVisualizerMsg -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> Rectangle -> DraggingVisualizerMsg
DraggingWindow Window
window Rectangle
rect
        )
        (sendMessage DraggingStopped >> performWindowSwitching window)


-- | get the pointer offset relative to the given windows root coordinates
getPointerOffset :: Window -> X (Int, Int)
getPointerOffset :: Window -> X (Int, Int)
getPointerOffset Window
win = do
    (_, _, _, oX, oY, _, _, _) <- (Display
 -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall a. (Display -> X a) -> X a
withDisplay (\Display
d -> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
 -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
d Window
win)
    return (fi oX, fi oY)

-- | return a tuple of windowX, windowY, windowWidth, windowHeight
getWindowPlacement :: WindowAttributes -> (Int, Int, Int, Int)
getWindowPlacement :: WindowAttributes -> (Int, Int, Int, Int)
getWindowPlacement WindowAttributes
wa = (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
wa, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_width WindowAttributes
wa, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_height WindowAttributes
wa)

performWindowSwitching :: Window -> X ()
performWindowSwitching :: Window -> X ()
performWindowSwitching Window
win = do
    root                          <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
    (_, _, selWin, _, _, _, _, _) <- withDisplay (\Display
d -> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
 -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
d Window
root)
    ws                            <- gets windowset
    let allWindows = WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index WindowSet
ws
    when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do
        let allWindowsSwitched = (Window -> Window) -> [Window] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map (Window -> Window -> Window -> Window
forall {a}. Eq a => a -> a -> a -> a
switchEntries Window
win Window
selWin) [Window]
allWindows
        (ls, t : rs)          <- pure $ break (== win) allWindowsSwitched
        let newStack           = Window -> [Window] -> [Window] -> Stack Window
forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
t ([Window] -> [Window]
forall a. [a] -> [a]
reverse [Window]
ls) [Window]
rs
        windows $ W.modify' $ const newStack
   where
    switchEntries :: a -> a -> a -> a
switchEntries a
a a
b a
x | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a    = a
b
                        | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b    = a
a
                        | Bool
otherwise = a
x