content: {-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  XMonad.Layout.DragPane
  -- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>
  --                    David Roundy <droundy@darcs.net>,
  --                    Andrea Rossato <andrea.rossato@unibz.it>
  -- License     :  BSD3-style (see LICENSE)
  --
  -- Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>
  -- Stability   :  unstable
  -- Portability :  unportable
  --
  -- Layouts that splits the screen either horizontally or vertically and
  -- shows two windows.  The first window is always the master window, and
  -- the other is either the currently focused window or the second window in
  -- layout order.
  
  -----------------------------------------------------------------------------
  
  module XMonad.Layout.DragPane (
                                 -- * Usage
                                 -- $usage
                                  dragPane
                                , DragPane, DragType (..)
                                ) where
  
  import XMonad
  import Data.Unique
  
  import qualified XMonad.StackSet as W
  import XMonad.Util.Invisible
  import XMonad.Util.XUtils
  
  -- $usage
  -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
  --
  -- > import XMonad.Layout.DragPane
  --
  -- Then edit your @layoutHook@ by adding the DragPane layout:
  --
  -- > myLayout = dragPane Horizontal 0.1 0.5 ||| Full ||| etc..
  -- > main = xmonad def { layoutHook = myLayout }
  --
  -- For more detailed instructions on editing the layoutHook see:
  --
  -- "XMonad.Doc.Extending#Editing_the_layout_hook"
  
  halfHandleWidth :: Integral a => a
  halfHandleWidth = 1
  
  handleColor :: String
  handleColor = "#000000"
  
  dragPane :: DragType -> Double -> Double -> DragPane a
  dragPane t x y = DragPane (I Nothing) t x y
  
  data DragPane a =
      DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double
               deriving ( Show, Read )
  
  data DragType = Horizontal | Vertical deriving ( Show, Read )
  
  instance LayoutClass DragPane a where
      doLayout d@(DragPane _ Vertical   _ _) = doLay id d
      doLayout d@(DragPane _ Horizontal _ _) = doLay mirrorRect d
      handleMessage = handleMess
  
  data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq, Typeable )
  instance Message SetFrac
  
  handleMess :: DragPane a -> SomeMessage -> X (Maybe (DragPane a))
  handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x
      | Just e <- fromMessage x :: Maybe Event = do handleEvent d e
                                                    return Nothing
      | Just Hide             <- fromMessage x = do hideWindow win
                                                    return $ Just (DragPane mb ty delta split)
      | Just ReleaseResources <- fromMessage x = do deleteWindow win
                                                    return $ Just (DragPane (I Nothing) ty delta split)
      -- layout specific messages
      | Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta))
      | Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta))
      | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = do
                                       return $ Just (DragPane mb ty delta frac)
  handleMess _ _ = return Nothing
  
  handleEvent :: DragPane a -> Event -> X ()
  handleEvent (DragPane (I (Just (win,r,ident))) ty _ _)
              (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })
      | t == buttonPress && thisw == win || thisbw == win  = do
    mouseDrag (\ex ey -> do
               let frac = case ty of
                          Vertical   -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width  r)
                          Horizontal -> (fromIntegral ey - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r)
               sendMessage (SetFrac ident frac))
              (return ())
  handleEvent _ _  = return ()
  
  doLay :: (Rectangle -> Rectangle) -> DragPane a -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a))
  doLay mirror (DragPane mw ty delta split) r s = do
    let r' = mirror r
        (left', right') = splitHorizontallyBy split r'
        left = case left' of Rectangle x y w h ->
                                 mirror $ Rectangle x y (w-halfHandleWidth) h
        right = case right' of
                  Rectangle x y w h ->
                      mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
        handr = case left' of
                  Rectangle x y w h ->
                      mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h
        wrs = case reverse (W.up s) of
                (master:_) -> [(master,left),(W.focus s,right)]
                [] -> case W.down s of
                        (next:_) -> [(W.focus s,left),(next,right)]
                        [] -> [(W.focus s, r)]
    if length wrs > 1
       then case mw of
              I (Just (w,_,ident)) -> do
                      w' <- deleteWindow w >> newDragWin handr
                      return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split)
              I Nothing -> do
                      w <- newDragWin handr
                      i <- io $ newUnique
                      return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split)
       else return (wrs, Nothing)
  
  
  newDragWin :: Rectangle -> X Window
  newDragWin r = do
    let mask = Just $ exposureMask .|. buttonPressMask
    w <- createNewWindow r mask handleColor False
    showWindow  w
    d <- asks display
    liftIO $ lowerWindow d w
    return      w
  