{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.WindowSwitcherDecoration
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-----------------------------------------------------------------------------

module XMonad.Layout.WindowSwitcherDecoration
    ( windowSwitcherDecoration
    ) where

import XMonad
import XMonad.Layout.Decoration
import XMonad.Layout.DraggingVisualizer
import qualified XMonad.StackSet as S
import Control.Monad
import Foreign.C.Types(CInt)

windowSwitcherDecoration :: (Eq a, Shrinker s) => s -> Theme
           -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
windowSwitcherDecoration s c = decoration s c $ WindowSwitcherDecoration

data WindowSwitcherDecoration a = WindowSwitcherDecoration deriving (Show, Read)

instance Eq a => DecorationStyle WindowSwitcherDecoration a where
    describeDeco _ = "WindowSwitcherDeco"

    decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y
    decorationAfterDraggingHookAddon _ (mainw, _) hasCrossed = unless hasCrossed $ do
                                                                 sendMessage $ DraggingStopped
                                                                 performWindowSwitching mainw

handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
handleTiledDraggingInProgress ex ey (mainw, r) x y = do
    let rect = Rectangle (x - (fi ex - rect_x r))
                         (y - (fi ey - rect_y r))
                         (rect_width  r)
                         (rect_height r)
    sendMessage $ DraggingWindow mainw rect

performWindowSwitching :: Window -> X ()
performWindowSwitching win =
    withDisplay $ \d -> do
       root <- asks theRoot
       (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root
       ws <- gets windowset
       let allWindows = S.index ws
       -- do a little double check to be sure
       if (win `elem` allWindows) && (selWin `elem` allWindows)
            then do
                let allWindowsSwitched = map (switchEntries win selWin) allWindows
                let (ls, t:rs) = break (win ==) allWindowsSwitched
                let newStack = S.Stack t (reverse ls) rs
                windows $ S.modify' $ \_ -> newStack
            else return ()
    where
        switchEntries a b x
            | x == a    = b
            | x == b    = a
            | otherwise = x