-----------------------------------------------------------------------------
-- |
-- 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) forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
  Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
dpy Window
window forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
    Window -> X ()
focus Window
window
    (Int
offsetX, Int
offsetY)                    <- Window -> X (Int, Int)
getPointerOffset Window
window
    let (Int
winX, Int
winY, Int
winWidth, Int
winHeight)  = WindowAttributes -> (Int, Int, Int, Int)
getWindowPlacement WindowAttributes
wa

    (Position -> Position -> X ()) -> X () -> X ()
mouseDrag
        (\Position
posX Position
posY ->
          let rect :: Rectangle
rect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a b. (Integral a, Num b) => a -> b
fi (forall a b. (Integral a, Num b) => a -> b
fi Int
winX forall a. Num a => a -> a -> a
+ (Position
posX forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Int
offsetX)))
                               (forall a b. (Integral a, Num b) => a -> b
fi (forall a b. (Integral a, Num b) => a -> b
fi Int
winY forall a. Num a => a -> a -> a
+ (Position
posY forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Int
offsetY)))
                               (forall a b. (Integral a, Num b) => a -> b
fi Int
winWidth)
                               (forall a b. (Integral a, Num b) => a -> b
fi Int
winHeight)
          in  forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Window -> Rectangle -> DraggingVisualizerMsg
DraggingWindow Window
window Rectangle
rect
        )
        (forall a. Message a => a -> X ()
sendMessage DraggingVisualizerMsg
DraggingStopped forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X ()
performWindowSwitching Window
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
    (Bool
_, Window
_, Window
_, CInt
oX, CInt
oY, CInt
_, CInt
_, Modifier
_) <- forall a. (Display -> X a) -> X a
withDisplay (\Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
d Window
win)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fi CInt
oX, forall a b. (Integral a, Num b) => a -> b
fi CInt
oY)

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

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