From 8691c81c05b16e31644c0c373652f7056f0c2d17 Mon Sep 17 00:00:00 2001
From: Lukas Mai <l.mai@web.de>
Date: Fri, 29 Feb 2008 01:21:36 +0100
Subject: XMonad.Actions.MouseGestures: refactoring, code simplification
It is now possible to get "live" status updates while the gesture handler
is running. I use this in my xmonad.hs to print the current gesture to my
status bar. Because collecting movements is now the callback's job, the
implementation of mouseGestureH got quite a bit simpler. The interface is
incompatible with the previous mouseGestureH but the old mouseGesture
function works as before.
darcs-hash:20080229002136-462cf-0afb81828e5cc56330652d834d5e011057b7405f.gz
---
XMonad/Actions/MouseGestures.hs | 104 ++++++++++++++++++++--------------------
1 file changed, 51 insertions(+), 53 deletions(-)
diff --git a/XMonad/Actions/MouseGestures.hs b/XMonad/Actions/MouseGestures.hs
index 4708314..1fc47e5 100644
--- a/XMonad/Actions/MouseGestures.hs
+++ b/XMonad/Actions/MouseGestures.hs
@@ -16,8 +16,9 @@ module XMonad.Actions.MouseGestures (
-- * Usage
-- $usage
Direction(..),
+ mouseGestureH,
mouseGesture,
- mouseGestureH
+ mkCollect
) where
import XMonad
@@ -25,10 +26,9 @@ import XMonad
import Data.IORef
import qualified Data.Map as M
import Data.Map (Map)
+import Data.Maybe
import Control.Monad
-import System.IO
-
-- $usage
--
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -79,65 +79,63 @@ dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromInt
| otherwise = L
rg a z x = a <= x && x < z
-debugging :: Int
-debugging = 0
-
-collect :: ([Direction] -> X ()) -> IORef (Pos, [(Direction, Pos, Pos)]) -> Position -> Position -> X ()
-collect hook st nx ny = do
+gauge :: (Direction -> X ()) -> Pos -> IORef (Maybe (Direction, Pos)) -> Position -> Position -> X ()
+gauge hook op st nx ny = do
let np = (nx, ny)
- stx@(op, ds) <- io $ readIORef st
+ stx <- io $ readIORef st
let
- stx' =
- case ds of
- []
- | insignificant np op -> stx
- | otherwise -> (op, [(dir op np, np, op)])
- (d, zp, ap_) : ds'
- | insignificant np zp -> stx
- | otherwise ->
- let
- d' = dir zp np
- ds''
- | d == d' = (d, np, ap_) : ds'
- | otherwise = (d', np, zp) : ds
- in (op, ds'')
- when (debugging > 0)
- . io . hPutStrLn stderr $ show "Mouse Gesture" ++ unwords (map show (extract stx')) ++ (if debugging > 1 then "; " ++ show op ++ "-" ++ show np else "")
- hook (extract stx')
- io $ writeIORef st stx'
+ (~(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
- insignificant a b = delta a b < 10
+ significant a b = delta a b >= 10
-extract :: (Pos, [(Direction, Pos, Pos)]) -> [Direction]
-extract (_, xs) = reverse . map (\(x, _, _) -> x) $ xs
+-- | @'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 :: (Direction -> 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 [Direction] (Window -> X ()) -> Window -> X ()
-mouseGesture tbl =
- mouseGestureH (const . const $ return ()) $ \win gest ->
+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
--- | @'mouseGestureH' moveHook endHook gestures window@ is a mouse button
--- event handler. It collects mouse movements, calling @moveHook@ for each
--- update; when the button is released, it calls @endHook@ with the resulting
--- gesture.
-mouseGestureH :: (Window -> [Direction] -> X ()) -> (Window -> [Direction] -> X ()) -> Window -> X ()
-mouseGestureH moveHook endHook win = withDisplay $ \dpy -> do
- when (debugging > 1)
- . io . hPutStrLn stderr $ "mouseGesture " ++ show (win, dpy)
- root <- asks theRoot
- let win' = if win == none then root else win
- acc <- io $ do
- qp@(_, _, _, ix, iy, _, _, _) <- queryPointer dpy win'
- when (debugging > 1)
- . hPutStrLn stderr $ show "queryPointer" ++ show qp
- when (debugging > 1 && win' == none)
- . hPutStrLn stderr $ show "mouseGesture" ++ "zomg none"
- newIORef ((fromIntegral ix, fromIntegral iy), [])
- mouseDrag (collect (moveHook win') acc) $ do
- when (debugging > 0) . io . hPutStrLn stderr $ show ""
- gest <- io $ liftM extract $ readIORef acc
- endHook win' gest
+-- | 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) => m (Direction -> X [Direction], X [Direction])
+mkCollect = liftIO $ do
+ acc <- newIORef []
+ let
+ mov d = io $ do
+ ds <- readIORef acc
+ let ds' = d : ds
+ writeIORef acc ds'
+ return $ reverse ds'
+ end = io $ do
+ ds <- readIORef acc
+ writeIORef acc []
+ return $ reverse ds
+ return (mov, end)
--
cgit v1.2.3