Changed semantics of UpdatePointer to move to nearest point

darcs-hash:20080301143126-d4c7e-fde7062d5c8e2e3ece14711d178811f2cf5a753f.gz

1 files changed, 21 insertions, 13 deletions

diff --git a/XMonad/Actions/UpdatePointer.hs b/XMonad/Actions/UpdatePointer.hs
index 292bfdc..b90fe38 100644
--- a/XMonad/Actions/UpdatePointer.hs
+++ b/XMonad/Actions/UpdatePointer.hs
@@ -10,7 +10,7 @@
 --
 -- Causes the pointer to follow whichever window focus changes to. Compliments
 -- the idea of switching focus as the mouse crosses window boundaries to
--- keep the mouse near the currently focussed window
+-- keep the mouse near the currently focused window
 --
 -----------------------------------------------------------------------------
 
@@ -33,22 +33,30 @@ import Control.Monad
 --
 -- Enable it by including it in your logHook definition. Eg:
 -- 
--- > logHook = updatePointer (1%2) (1%2)
+-- > logHook = updatePointer
 -- 
--- which will move the pointer to the middle of a newly focused window if the
--- focus moves away from the pointer
+-- which will move the pointer to the nearest point of a newly focused window
 
 
--- | Update the pointer's location to the currently focused window unless it's 
--- already there
-updatePointer ::  Rational -> Rational -> X ()
-updatePointer h v = withFocused $ \w -> do
+-- | Update the pointer's location to the nearest point of the currently focused
+-- window unless it's already there
+updatePointer ::  X ()
+updatePointer = withFocused $ \w -> do
   dpy <- asks display
   root <- asks theRoot
   wa <- io $ getWindowAttributes dpy w
-  (sameRoot,_,w',_,_,_,_,_) <- io $ queryPointer dpy root
-  unless (sameRoot && w == w') $
-         io $ warpPointer dpy none w 0 0 0 0
-                (fraction h (wa_width wa)) (fraction v (wa_height wa))
-    where fraction x y = floor (x * fromIntegral y)
+  (_sameRoot,_,w',rootx,rooty,_,_,_) <- io $ queryPointer dpy root
+  -- Can sameRoot ever be false in this case? I'm going to assume not
+  unless (w == w') $ do
+    let x = moveWithin rootx (wa_x wa) ((wa_x wa) + (wa_width  wa))
+    let y = moveWithin rooty (wa_y wa) ((wa_y wa) + (wa_height wa))
+    io $ warpPointer dpy none root 0 0 0 0 (fromIntegral x) (fromIntegral y)
+
+moveWithin :: Integral a => a -> a -> a -> a
+moveWithin current lower upper =
+    if current < lower
+    then lower
+    else if current > upper
+         then upper
+         else current