-----------------------------------------------------------------------------
-- |
-- 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\/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
    (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 (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
        )
        (DraggingVisualizerMsg -> X ()
forall a. Message a => a -> X ()
sendMessage DraggingVisualizerMsg
DraggingStopped X () -> X () -> X ()
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
_) <- (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)
    (Int, Int) -> X (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
oX, CInt -> Int
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 = (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
    Window
root                          <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
    (Bool
_, Window
_, Window
selWin, CInt
_, CInt
_, CInt
_, CInt
_, Modifier
_) <- (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
root)
    WindowSet
ws                            <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    let allWindows :: [Window]
allWindows = WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index WindowSet
ws
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Window
win Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
allWindows) Bool -> Bool -> Bool
&& (Window
selWin Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
allWindows)) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
        let allWindowsSwitched :: [Window]
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
        ([Window]
ls, Window
t : [Window]
rs)          <- ([Window], [Window]) -> X ([Window], [Window])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Window], [Window]) -> X ([Window], [Window]))
-> ([Window], [Window]) -> X ([Window], [Window])
forall a b. (a -> b) -> a -> b
$ (Window -> Bool) -> [Window] -> ([Window], [Window])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
win) [Window]
allWindowsSwitched
        let newStack :: Stack Window
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
        (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' ((Stack Window -> Stack Window) -> WindowSet -> WindowSet)
-> (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ Stack Window -> Stack Window -> Stack Window
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 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