{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-}
----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.DraggingVisualizer
-- Description :  Visualize the process of dragging a window.
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-- A helper module to visualize the process of dragging a window by
-- making it follow the mouse cursor. See "XMonad.Layout.WindowSwitcherDecoration"
-- for a module that makes use of this.
--
-----------------------------------------------------------------------------

module XMonad.Layout.DraggingVisualizer
    ( draggingVisualizer,
      DraggingVisualizerMsg (..),
      DraggingVisualizer,
    ) where

import XMonad
import XMonad.Layout.LayoutModifier

newtype DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( ReadPrec [DraggingVisualizer a]
ReadPrec (DraggingVisualizer a)
Int -> ReadS (DraggingVisualizer a)
ReadS [DraggingVisualizer a]
(Int -> ReadS (DraggingVisualizer a))
-> ReadS [DraggingVisualizer a]
-> ReadPrec (DraggingVisualizer a)
-> ReadPrec [DraggingVisualizer a]
-> Read (DraggingVisualizer a)
forall a. ReadPrec [DraggingVisualizer a]
forall a. ReadPrec (DraggingVisualizer a)
forall a. Int -> ReadS (DraggingVisualizer a)
forall a. ReadS [DraggingVisualizer a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DraggingVisualizer a]
$creadListPrec :: forall a. ReadPrec [DraggingVisualizer a]
readPrec :: ReadPrec (DraggingVisualizer a)
$creadPrec :: forall a. ReadPrec (DraggingVisualizer a)
readList :: ReadS [DraggingVisualizer a]
$creadList :: forall a. ReadS [DraggingVisualizer a]
readsPrec :: Int -> ReadS (DraggingVisualizer a)
$creadsPrec :: forall a. Int -> ReadS (DraggingVisualizer a)
Read, Int -> DraggingVisualizer a -> ShowS
[DraggingVisualizer a] -> ShowS
DraggingVisualizer a -> String
(Int -> DraggingVisualizer a -> ShowS)
-> (DraggingVisualizer a -> String)
-> ([DraggingVisualizer a] -> ShowS)
-> Show (DraggingVisualizer a)
forall a. Int -> DraggingVisualizer a -> ShowS
forall a. [DraggingVisualizer a] -> ShowS
forall a. DraggingVisualizer a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DraggingVisualizer a] -> ShowS
$cshowList :: forall a. [DraggingVisualizer a] -> ShowS
show :: DraggingVisualizer a -> String
$cshow :: forall a. DraggingVisualizer a -> String
showsPrec :: Int -> DraggingVisualizer a -> ShowS
$cshowsPrec :: forall a. Int -> DraggingVisualizer a -> ShowS
Show )
draggingVisualizer :: LayoutClass l Window => l Window -> ModifiedLayout DraggingVisualizer l Window
draggingVisualizer :: forall (l :: * -> *).
LayoutClass l Window =>
l Window -> ModifiedLayout DraggingVisualizer l Window
draggingVisualizer = DraggingVisualizer Window
-> l Window -> ModifiedLayout DraggingVisualizer l Window
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (DraggingVisualizer Window
 -> l Window -> ModifiedLayout DraggingVisualizer l Window)
-> DraggingVisualizer Window
-> l Window
-> ModifiedLayout DraggingVisualizer l Window
forall a b. (a -> b) -> a -> b
$ Maybe (Window, Rectangle) -> DraggingVisualizer Window
forall a. Maybe (Window, Rectangle) -> DraggingVisualizer a
DraggingVisualizer Maybe (Window, Rectangle)
forall a. Maybe a
Nothing

data DraggingVisualizerMsg = DraggingWindow Window Rectangle
                                | DraggingStopped
                                deriving DraggingVisualizerMsg -> DraggingVisualizerMsg -> Bool
(DraggingVisualizerMsg -> DraggingVisualizerMsg -> Bool)
-> (DraggingVisualizerMsg -> DraggingVisualizerMsg -> Bool)
-> Eq DraggingVisualizerMsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DraggingVisualizerMsg -> DraggingVisualizerMsg -> Bool
$c/= :: DraggingVisualizerMsg -> DraggingVisualizerMsg -> Bool
== :: DraggingVisualizerMsg -> DraggingVisualizerMsg -> Bool
$c== :: DraggingVisualizerMsg -> DraggingVisualizerMsg -> Bool
Eq
instance Message DraggingVisualizerMsg

instance LayoutModifier DraggingVisualizer Window where
    modifierDescription :: DraggingVisualizer Window -> String
modifierDescription (DraggingVisualizer Maybe (Window, Rectangle)
_) = String
"DraggingVisualizer"
    pureModifier :: DraggingVisualizer Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> ([(Window, Rectangle)], Maybe (DraggingVisualizer Window))
pureModifier (DraggingVisualizer (Just dragged :: (Window, Rectangle)
dragged@(Window
draggedWin, Rectangle
_))) Rectangle
_ Maybe (Stack Window)
_ [(Window, Rectangle)]
wrs =
            if Window
draggedWin Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Window, Rectangle) -> Window)
-> [(Window, Rectangle)] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst [(Window, Rectangle)]
wrs
                then ((Window, Rectangle)
dragged (Window, Rectangle)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. a -> [a] -> [a]
: [(Window, Rectangle)]
rest, Maybe (DraggingVisualizer Window)
forall a. Maybe a
Nothing)
                else ([(Window, Rectangle)]
wrs, DraggingVisualizer Window -> Maybe (DraggingVisualizer Window)
forall a. a -> Maybe a
Just (DraggingVisualizer Window -> Maybe (DraggingVisualizer Window))
-> DraggingVisualizer Window -> Maybe (DraggingVisualizer Window)
forall a b. (a -> b) -> a -> b
$ Maybe (Window, Rectangle) -> DraggingVisualizer Window
forall a. Maybe (Window, Rectangle) -> DraggingVisualizer a
DraggingVisualizer Maybe (Window, Rectangle)
forall a. Maybe a
Nothing)
        where
            rest :: [(Window, Rectangle)]
rest = ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Window
w, Rectangle
_) -> Window
w Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window
draggedWin) [(Window, Rectangle)]
wrs
    pureModifier DraggingVisualizer Window
_ Rectangle
_ Maybe (Stack Window)
_ [(Window, Rectangle)]
wrs = ([(Window, Rectangle)]
wrs, Maybe (DraggingVisualizer Window)
forall a. Maybe a
Nothing)

    pureMess :: DraggingVisualizer Window
-> SomeMessage -> Maybe (DraggingVisualizer Window)
pureMess (DraggingVisualizer Maybe (Window, Rectangle)
_) SomeMessage
m = case SomeMessage -> Maybe DraggingVisualizerMsg
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m of
        Just (DraggingWindow Window
w Rectangle
rect) -> DraggingVisualizer Window -> Maybe (DraggingVisualizer Window)
forall a. a -> Maybe a
Just (DraggingVisualizer Window -> Maybe (DraggingVisualizer Window))
-> DraggingVisualizer Window -> Maybe (DraggingVisualizer Window)
forall a b. (a -> b) -> a -> b
$ Maybe (Window, Rectangle) -> DraggingVisualizer Window
forall a. Maybe (Window, Rectangle) -> DraggingVisualizer a
DraggingVisualizer (Maybe (Window, Rectangle) -> DraggingVisualizer Window)
-> Maybe (Window, Rectangle) -> DraggingVisualizer Window
forall a b. (a -> b) -> a -> b
$ (Window, Rectangle) -> Maybe (Window, Rectangle)
forall a. a -> Maybe a
Just (Window
w, Rectangle
rect)
        Just DraggingVisualizerMsg
DraggingStopped -> DraggingVisualizer Window -> Maybe (DraggingVisualizer Window)
forall a. a -> Maybe a
Just (DraggingVisualizer Window -> Maybe (DraggingVisualizer Window))
-> DraggingVisualizer Window -> Maybe (DraggingVisualizer Window)
forall a b. (a -> b) -> a -> b
$ Maybe (Window, Rectangle) -> DraggingVisualizer Window
forall a. Maybe (Window, Rectangle) -> DraggingVisualizer a
DraggingVisualizer Maybe (Window, Rectangle)
forall a. Maybe a
Nothing
        Maybe DraggingVisualizerMsg
_ -> Maybe (DraggingVisualizer Window)
forall a. Maybe a
Nothing