content: {-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  XMonad.Actions.MouseResize
  -- Copyright   :  (c) 2007 Andrea Rossato
  -- License     :  BSD-style (see xmonad/LICENSE)
  --
  -- Maintainer  :  andrea.rossato@unibz.it
  -- Stability   :  unstable
  -- Portability :  unportable
  --
  -- A layout modifier to resize windows with the mouse by grabbing the
  -- window's lower right corner.
  --
  -- This module must be used together with "XMonad.Layout.WindowArranger".
  -----------------------------------------------------------------------------
  
  module XMonad.Actions.MouseResize
      ( -- * Usage:
        -- $usage
        mouseResize
      , MouseResize (..)
      ) where
  
  import XMonad
  import XMonad.Layout.Decoration
  
  import XMonad.Layout.WindowArranger
  import XMonad.Util.XUtils
  
  -- $usage
  -- Usually this module is used to create layouts, but you can also use
  -- it to resize windows in any layout, together with the
  -- "XMonad.Layout.WindowArranger". For usage example see
  -- "XMonad.Layout.SimpleFloat" or "XMonad.Layout.DecorationMadness".
  --
  -- You can use this module with the following in your
  -- @~\/.xmonad\/xmonad.hs@:
  --
  -- > import XMonad.Actions.MouseResize
  -- > import XMonad.Layout.WindowArranger
  --
  -- Then edit your @layoutHook@ by modifying a given layout:
  --
  -- > myLayout = mouseResize $ windowArrange $ layoutHook def
  --
  -- and then:
  --
  -- > main = xmonad def { layoutHook = myLayout }
  --
  -- For more detailed instructions on editing the layoutHook see:
  --
  -- "XMonad.Doc.Extending#Editing_the_layout_hook"
  
  mouseResize :: l a -> ModifiedLayout MouseResize l a
  mouseResize = ModifiedLayout (MR [])
  
  data MouseResize a = MR [((a,Rectangle),Maybe a)]
  instance Show (MouseResize a) where show        _ = ""
  instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]
  
  instance LayoutModifier MouseResize Window where
      redoLayout _       _ Nothing  wrs = return (wrs, Nothing)
      redoLayout (MR st) _ (Just s) wrs
          | [] <- st  = initState    >>= \nst -> return (wrs, Just $ MR nst)
          | otherwise = processState >>= \nst -> return (wrs, Just $ MR nst)
          where
            wrs'         = wrs_to_state [] . filter (isInStack s . fst) $ wrs
            initState    = mapM createInputWindow wrs'
            processState = mapM (deleteInputWin . snd) st >> mapM createInputWindow wrs'
  
            inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10
  
            wrs_to_state rs ((w,r):xs)
                | ir `isVisible` rs = ((w,r),Just ir) : wrs_to_state (r:ir:rs) xs
                | otherwise         = ((w,r),Nothing) : wrs_to_state (r:   rs) xs
                where ir = inputRectangle r
            wrs_to_state _ [] = []
  
      handleMess (MR s) m
          | Just e <- fromMessage m :: Maybe Event = handleResize s e >> return Nothing
          | Just Hide             <- fromMessage m = releaseResources >> return (Just $ MR [])
          | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ MR [])
          where releaseResources = mapM_ (deleteInputWin . snd) s
      handleMess _ _ = return Nothing
  
  handleResize :: [((Window,Rectangle),Maybe Window)] -> Event -> X ()
  handleResize st ButtonEvent { ev_window = ew, ev_event_type = et }
      | et == buttonPress
      , Just (w,Rectangle wx wy _ _) <- getWin ew st = do
                                          focus w
                                          mouseDrag (\x y -> do
                                                       let rect = Rectangle wx wy
                                                                  (max 1 . fi $ x - wx)
                                                                  (max 1 . fi $ y - wy)
                                                       sendMessage (SetGeometry rect)) (return ())
  
        where
          getWin w (((win,r),tw):xs)
              | Just w' <- tw
              , w == w'   = Just (win,r)
              | otherwise = getWin w xs
          getWin _ []     = Nothing
  handleResize _ _ = return ()
  
  createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)
  createInputWindow ((w,r),mr) = do
    case mr of
      Just tr  -> withDisplay $ \d -> do
                    tw <- mkInputWindow d tr
                    io $ selectInput d tw (exposureMask .|. buttonPressMask)
  
                    cursor <- io $ createFontCursor d xC_bottom_right_corner
                    io $ defineCursor d tw cursor
                    io $ freeCursor d cursor
  
                    showWindow tw
                    return ((w,r), Just tw)
      Nothing ->    return ((w,r), Nothing)
  
  deleteInputWin :: Maybe Window -> X ()
  deleteInputWin = maybe (return ()) deleteWindow
  
  mkInputWindow :: Display -> Rectangle -> X Window
  mkInputWindow d (Rectangle x y w h) = do
    rw <- asks theRoot
    let screen   = defaultScreenOfDisplay d
        visual   = defaultVisualOfScreen screen
        attrmask = cWOverrideRedirect
    io $ allocaSetWindowAttributes $
           \attributes -> do
             set_override_redirect attributes True
             createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes
  