content: -----------------------------------------------------------------------------
  -- |
  -- Module      :  XMonad.Actions.MouseGestures
  -- Copyright   :  (c) Lukas Mai
  -- License     :  BSD3-style (see LICENSE)
  --
  -- Maintainer  :  <l.mai@web.de>
  -- Stability   :  unstable
  -- Portability :  unportable
  --
  -- Support for simple mouse gestures.
  --
  -----------------------------------------------------------------------------
  
  module XMonad.Actions.MouseGestures (
      -- * Usage
      -- $usage
      Direction2D(..),
      mouseGestureH,
      mouseGesture,
      mkCollect
  ) where
  
  import XMonad
  import XMonad.Util.Types (Direction2D(..))
  
  import Data.IORef
  import qualified Data.Map as M
  import Data.Map (Map)
  import Data.Maybe
  import Control.Monad
  
  -- $usage
  --
  -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
  --
  -- > import XMonad.Actions.MouseGestures
  -- > import qualified XMonad.StackSet as W
  --
  -- then add an appropriate mouse binding:
  --
  -- >     , ((modm .|. shiftMask, button3), mouseGesture gestures)
  --
  -- where @gestures@ is a 'Data.Map.Map' from gestures to actions on
  -- windows, for example:
  --
  -- >     gestures = M.fromList
  -- >         [ ([], focus)
  -- >         , ([U], \w -> focus w >> windows W.swapUp)
  -- >         , ([D], \w -> focus w >> windows W.swapDown)
  -- >         , ([R, D], \_ -> sendMessage NextLayout)
  -- >         ]
  --
  -- This is just an example, of course; you can use any mouse button and
  -- gesture definitions you want.
  --
  -- For detailed instructions on editing your mouse bindings, see
  -- "XMonad.Doc.Extending#Editing_mouse_bindings".
  
  type Pos = (Position, Position)
  
  delta :: Pos -> Pos -> Position
  delta (ax, ay) (bx, by) = max (d ax bx) (d ay by)
      where
      d a b = abs (a - b)
  
  dir :: Pos -> Pos -> Direction2D
  dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax)
      where
      trans :: Double -> Direction2D
      trans x
          | rg (-3/4) (-1/4) x = D
          | rg (-1/4)  (1/4) x = R
          | rg  (1/4)  (3/4) x = U
          | otherwise          = L
      rg a z x = a <= x && x < z
  
  gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Position -> Position -> X ()
  gauge hook op st nx ny = do
      let np = (nx, ny)
      stx <- io $ readIORef st
      let
          (~(Just od), pivot) = case stx of
              Nothing -> (Nothing, op)
              Just (d, zp) -> (Just d, zp)
          cont = do
              guard $ significant np pivot
              return $ do
                  let d' = dir pivot np
                  when (isNothing stx || od /= d') $ hook d'
                  io $ writeIORef st (Just (d', np))
      fromMaybe (return ()) cont
      where
      significant a b = delta a b >= 10
  
  -- | @'mouseGestureH' moveHook endHook@ is a mouse button
  -- event handler. It collects mouse movements, calling @moveHook@ for each
  -- update; when the button is released, it calls @endHook@.
  mouseGestureH :: (Direction2D -> X ()) -> X () -> X ()
  mouseGestureH moveHook endHook = do
      dpy <- asks display
      root <- asks theRoot
      (pos, acc) <- io $ do
          (_, _, _, ix, iy, _, _, _) <- queryPointer dpy root
          r <- newIORef Nothing
          return ((fromIntegral ix, fromIntegral iy), r)
      mouseDrag (gauge moveHook pos acc) endHook
  
  -- | A utility function on top of 'mouseGestureH'. It uses a 'Data.Map.Map' to
  -- look up the mouse gesture, then executes the corresponding action (if any).
  mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
  mouseGesture tbl win = do
      (mov, end) <- mkCollect
      mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest ->
          case M.lookup gest tbl of
              Nothing -> return ()
              Just f -> f win
  
  -- | A callback generator for 'mouseGestureH'. 'mkCollect' returns two
  -- callback functions for passing to 'mouseGestureH'. The move hook will
  -- collect mouse movements (and return the current gesture as a list); the end
  -- hook will return a list of the completed gesture, which you can access with
  -- 'Control.Monad.>>='.
  mkCollect :: (MonadIO m, MonadIO m') => m (Direction2D -> m' [Direction2D], m' [Direction2D])
  mkCollect = liftIO $ do
      acc <- newIORef []
      let
          mov d = liftIO $ do
              ds <- readIORef acc
              let ds' = d : ds
              writeIORef acc ds'
              return $ reverse ds'
          end = liftIO $ do
              ds <- readIORef acc
              writeIORef acc []
              return $ reverse ds
      return (mov, end)
  