From a901a51afaa6455a2da04aae1db331bb085f9521 Mon Sep 17 00:00:00 2001
From: daniel <daniel@wagner-home.com>
Date: Sat, 2 Jun 2007 08:23:28 +0200
Subject: keybindings to warp pointer to window center

darcs-hash:20070602062328-c98ca-4fd1936d0fa8b87d88f71f7e334d482d7f3837ef.gz
---
 Warp.hs | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)
 create mode 100644 Warp.hs

(limited to 'Warp.hs')

diff --git a/Warp.hs b/Warp.hs
new file mode 100644
index 0000000..8f1cd54
--- /dev/null
+++ b/Warp.hs
@@ -0,0 +1,48 @@
+module XMonadContrib.Warp where
+
+{- Usage:
+ - This can be used to make a keybinding that warps the pointer to a given
+ - window or screen.  For example, I've added the following keybindings to
+ - my Config.hs:
+ - 
+ -   , ((modMask,   xK_z     ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window
+ - 
+ - -- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3
+ -    ++
+ -    [((modMask .|. controlMask, key), warpToScreen sc (1%2) (1%2))
+ -        | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]]
+ -
+ - Note that warping to a particular screen may change the focus.
+ -}
+
+import Data.Ratio
+import Data.Maybe
+import Control.Monad.RWS
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+import Operations
+import XMonad
+
+fraction :: (Integral a, Integral b) => Rational -> a -> b
+fraction f x = floor (f * fromIntegral x)
+
+ix :: Int -> [a] -> Maybe a
+ix n = listToMaybe . take 1 . drop n
+
+warp :: Window -> Position -> Position -> X ()
+warp w x y = withDisplay $ \d -> io $ warpPointer d none w 0 0 0 0 x y
+
+warpToWindow :: Rational -> Rational -> X ()
+warpToWindow h v =
+    withDisplay $ \d ->
+        withFocused $ \w -> do
+            wa <- io $ getWindowAttributes d w
+            warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))
+
+warpToScreen :: Int -> Rational -> Rational -> X ()
+warpToScreen n h v = do
+    xScreens <- gets xineScreens
+    root     <- asks theRoot
+    whenJust (ix n xScreens) $ \r ->
+        warp root (rect_x r + fraction h (rect_width  r))
+                  (rect_y r + fraction v (rect_height r))
-- 
cgit v1.2.3