{-# 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)
ReadS [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
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 = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall a b. (a -> b) -> a -> b
$ forall a. Maybe (Window, Rectangle) -> DraggingVisualizer a
DraggingVisualizer forall a. Maybe a
Nothing

data DraggingVisualizerMsg = DraggingWindow Window Rectangle
                                | DraggingStopped
                                deriving DraggingVisualizerMsg -> DraggingVisualizerMsg -> Bool
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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Window, Rectangle)]
wrs
                then ((Window, Rectangle)
dragged forall a. a -> [a] -> [a]
: [(Window, Rectangle)]
rest, forall a. Maybe a
Nothing)
                else ([(Window, Rectangle)]
wrs, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Maybe (Window, Rectangle) -> DraggingVisualizer a
DraggingVisualizer forall a. Maybe a
Nothing)
        where
            rest :: [(Window, Rectangle)]
rest = forall a. (a -> Bool) -> [a] -> [a]
filter (\(Window
w, Rectangle
_) -> Window
w 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, forall a. Maybe a
Nothing)

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