From 5d9f59c7c082122d2708cb9590b4027eb6312bc2 Mon Sep 17 00:00:00 2001
From: robreim <robreim@bobturf.org>
Date: Sat, 1 Mar 2008 15:31:26 +0100
Subject: Changed semantics of UpdatePointer to move to nearest point

darcs-hash:20080301143126-d4c7e-fde7062d5c8e2e3ece14711d178811f2cf5a753f.gz
---
 XMonad/Actions/UpdatePointer.hs | 34 +++++++++++++++++++++-------------
 1 file changed, 21 insertions(+), 13 deletions(-)

(limited to 'XMonad/Actions/UpdatePointer.hs')

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
 
-- 
cgit v1.2.3