module XMonad.Actions.MouseGestures (
Direction2D(..),
mouseGestureH,
mouseGesture,
mkCollect
) where
import XMonad.Prelude
import XMonad
import XMonad.Util.Types (Direction2D(..))
import Data.IORef
import qualified Data.Map as M
import Data.Map (Map)
type Pos = (Position, Position)
delta :: Pos -> Pos -> Position
delta :: Pos -> Pos -> Position
delta (Position
ax, Position
ay) (Position
bx, Position
by) = forall a. Ord a => a -> a -> a
max (forall {a}. Num a => a -> a -> a
d Position
ax Position
bx) (forall {a}. Num a => a -> a -> a
d Position
ay Position
by)
where
d :: a -> a -> a
d a
a a
b = forall a. Num a => a -> a
abs (a
a forall {a}. Num a => a -> a -> a
- a
b)
dir :: Pos -> Pos -> Direction2D
dir :: Pos -> Pos -> Direction2D
dir (Position
ax, Position
ay) (Position
bx, Position
by) = Double -> Direction2D
trans forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a
pi) forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> a -> a
atan2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Position
ay forall {a}. Num a => a -> a -> a
- Position
by) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Position
bx forall {a}. Num a => a -> a -> a
- Position
ax)
where
trans :: Double -> Direction2D
trans :: Double -> Direction2D
trans Double
x
| forall {a}. Ord a => a -> a -> a -> Bool
rg (-Double
3forall a. Fractional a => a -> a -> a
/Double
4) (-Double
1forall a. Fractional a => a -> a -> a
/Double
4) Double
x = Direction2D
D
| forall {a}. Ord a => a -> a -> a -> Bool
rg (-Double
1forall a. Fractional a => a -> a -> a
/Double
4) (Double
1forall a. Fractional a => a -> a -> a
/Double
4) Double
x = Direction2D
R
| forall {a}. Ord a => a -> a -> a -> Bool
rg (Double
1forall a. Fractional a => a -> a -> a
/Double
4) (Double
3forall a. Fractional a => a -> a -> a
/Double
4) Double
x = Direction2D
U
| Bool
otherwise = Direction2D
L
rg :: a -> a -> a -> Bool
rg a
a a
z a
x = a
a forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x forall a. Ord a => a -> a -> Bool
< a
z
gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Position -> Position -> X ()
gauge :: (Direction2D -> X ())
-> Pos
-> IORef (Maybe (Direction2D, Pos))
-> Position
-> Position
-> X ()
gauge Direction2D -> X ()
hook Pos
op IORef (Maybe (Direction2D, Pos))
st Position
nx Position
ny = do
let np :: Pos
np = (Position
nx, Position
ny)
Maybe (Direction2D, Pos)
stx <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (Maybe (Direction2D, Pos))
st
let pivot :: Pos
pivot = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pos
op forall a b. (a, b) -> b
snd Maybe (Direction2D, Pos)
stx
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Pos -> Pos -> Bool
significant Pos
np Pos
pivot) forall a b. (a -> b) -> a -> b
$ do
let d' :: Direction2D
d' = Pos -> Pos -> Direction2D
dir Pos
pivot Pos
np
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Direction2D, Pos)
stx) forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Direction2D
d') forall a b. (a -> b) -> a -> b
$ Direction2D -> X ()
hook Direction2D
d'
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Direction2D, Pos))
st (forall a. a -> Maybe a
Just (Direction2D
d', Pos
np))
where
significant :: Pos -> Pos -> Bool
significant Pos
a Pos
b = Pos -> Pos -> Position
delta Pos
a Pos
b forall a. Ord a => a -> a -> Bool
>= Position
10
mouseGestureH :: (Direction2D -> X ()) -> X () -> X ()
mouseGestureH :: (Direction2D -> X ()) -> X () -> X ()
mouseGestureH Direction2D -> X ()
moveHook X ()
endHook = do
Display
dpy <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
Window
root <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
(Pos
pos, IORef (Maybe (Direction2D, Pos))
acc) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
(Bool
_, Window
_, Window
_, CInt
ix, CInt
iy, CInt
_, CInt
_, Modifier
_) <- Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
dpy Window
root
IORef (Maybe (Direction2D, Pos))
r <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return ((forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
ix, forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
iy), IORef (Maybe (Direction2D, Pos))
r)
(Position -> Position -> X ()) -> X () -> X ()
mouseDrag ((Direction2D -> X ())
-> Pos
-> IORef (Maybe (Direction2D, Pos))
-> Position
-> Position
-> X ()
gauge Direction2D -> X ()
moveHook Pos
pos IORef (Maybe (Direction2D, Pos))
acc) X ()
endHook
mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
mouseGesture Map [Direction2D] (Window -> X ())
tbl Window
win = do
(Direction2D -> X [Direction2D]
mov, X [Direction2D]
end) <- forall (m :: * -> *) (m' :: * -> *).
(MonadIO m, MonadIO m') =>
m (Direction2D -> m' [Direction2D], m' [Direction2D])
mkCollect
(Direction2D -> X ()) -> X () -> X ()
mouseGestureH (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction2D -> X [Direction2D]
mov) forall a b. (a -> b) -> a -> b
$ X [Direction2D]
end forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Direction2D]
gest ->
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Direction2D]
gest Map [Direction2D] (Window -> X ())
tbl of
Maybe (Window -> X ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Window -> X ()
f -> Window -> X ()
f Window
win
mkCollect :: (MonadIO m, MonadIO m') => m (Direction2D -> m' [Direction2D], m' [Direction2D])
mkCollect :: forall (m :: * -> *) (m' :: * -> *).
(MonadIO m, MonadIO m') =>
m (Direction2D -> m' [Direction2D], m' [Direction2D])
mkCollect = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
IORef [Direction2D]
acc <- forall a. a -> IO (IORef a)
newIORef []
let
mov :: Direction2D -> m [Direction2D]
mov Direction2D
d = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
[Direction2D]
ds <- forall a. IORef a -> IO a
readIORef IORef [Direction2D]
acc
let ds' :: [Direction2D]
ds' = Direction2D
d forall a. a -> [a] -> [a]
: [Direction2D]
ds
forall a. IORef a -> a -> IO ()
writeIORef IORef [Direction2D]
acc [Direction2D]
ds'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Direction2D]
ds'
end :: m' [Direction2D]
end = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
[Direction2D]
ds <- forall a. IORef a -> IO a
readIORef IORef [Direction2D]
acc
forall a. IORef a -> a -> IO ()
writeIORef IORef [Direction2D]
acc []
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Direction2D]
ds
forall (m :: * -> *) a. Monad m => a -> m a
return (forall {m :: * -> *}. MonadIO m => Direction2D -> m [Direction2D]
mov, m' [Direction2D]
end)