Hierarchify

darcs-hash:20071101201059-a5988-fc1f1262bec1b69e13ba18ae7cefeafc8c4471d4.gz

1 files changed, 0 insertions, 116 deletions

diff --git a/MouseGestures.hs b/MouseGestures.hs
deleted file mode 100644
index 93eea03..0000000
--- a/MouseGestures.hs
+++ /dev/null
@@ -1,116 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.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 XMonadContrib.MouseGestures (
-    -- * Usage
-    -- $usage
-	Direction(..),
-    mouseGesture
-) where
-
-import XMonad
-import XMonad.Operations
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-
-import Control.Monad.Reader
-import Data.IORef
-import qualified Data.Map as M
-import Data.Map (Map)
-
-import System.IO
-
--- $usage
--- In your Config.hs:
---
--- > import XMonadContrib.MouseGestures
--- > ...
--- > mouseBindings = M.fromList $
--- >     [ ...
--- >     , ((modMask .|. shiftMask, button3), mouseGesture gestures)
--- >     ]
--- >     where
--- >     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.
-
-data Direction = L | U | R | D
-    deriving (Eq, Ord, Show, Read, Enum, Bounded)
-
-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 -> Direction
-dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax)
-    where
-    trans :: Double -> Direction
-    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
-
-debugging :: Int
-debugging = 0
-
-collect :: IORef (Pos, [(Direction, Pos, Pos)]) -> Position -> Position -> X ()
-collect st nx ny = do
-    let np = (nx, ny)
-    stx@(op, ds) <- io $ readIORef st
-    when (debugging > 0) $ io $ putStrLn $ show "Mouse Gesture" ++ unwords (map show (extract stx)) ++ (if debugging > 1 then "; " ++ show op ++ "-" ++ show np else "")
-    case ds of
-        []
-            | insignificant np op -> return ()
-            | otherwise -> io $ writeIORef st (op, [(dir op np, np, op)])
-        (d, zp, ap_) : ds'
-            | insignificant np zp -> return ()
-            | otherwise -> do
-                let
-                    d' = dir zp np
-                    ds''
-                        | d == d'   = (d, np, ap_) : ds'
-                        | otherwise = (d', np, zp) : ds
-                io $ writeIORef st (op, ds'')
-    where
-    insignificant a b = delta a b < 10
-
-extract :: (Pos, [(Direction, Pos, Pos)]) -> [Direction]
-extract (_, xs) = reverse . map (\(x, _, _) -> x) $ xs
-
-mouseGesture :: Map [Direction] (Window -> X ()) -> Window -> X ()
-mouseGesture tbl win = withDisplay $ \dpy -> do
-    root <- asks theRoot
-    let win' = if win == none then root else win
-    acc <- io $ do
-        qp@(_, _, _, ix, iy, _, _, _) <- queryPointer dpy win'
-        when (debugging > 1) $ putStrLn $ show "queryPointer" ++ show qp
-        when (debugging > 1 && win' == none) $ putStrLn $ show "mouseGesture" ++ "zomg none"
-        newIORef ((fromIntegral ix, fromIntegral iy), [])
-    mouseDrag (collect acc) $ do
-        when (debugging > 0) $ io $ putStrLn $ show ""
-        gest <- io $ liftM extract $ readIORef acc
-        case M.lookup gest tbl of
-            Nothing -> return ()
-            Just f -> f win'