aboutsummaryrefslogtreecommitdiff
path: root/src/Internal/MouseMotion.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Internal/MouseMotion.hs')
-rw-r--r--src/Internal/MouseMotion.hs97
1 files changed, 0 insertions, 97 deletions
diff --git a/src/Internal/MouseMotion.hs b/src/Internal/MouseMotion.hs
deleted file mode 100644
index c72c824..0000000
--- a/src/Internal/MouseMotion.hs
+++ /dev/null
@@ -1,97 +0,0 @@
-{-# LANGUAGE ViewPatterns, BangPatterns #-}
-module Internal.MouseMotion where
-
-import XMonad
-
-import Control.Monad (void, forever)
-import Text.Printf
-import Internal.Submap
-import Control.Monad.Loops (iterateWhile)
-import Control.Monad.Fix (fix)
-import Internal.Logger
-
-import Linear.V2
-import Linear.Metric
-
-data Quadrant = NE | SE | SW | NW deriving (Enum, Show)
-data Direction = CW | CCW deriving (Enum, Show)
-
-getQuadrant :: (Num a, Ord a) => (a, a) -> Quadrant
-getQuadrant (x, y) | x >= 0 && y >= 0 = NE
-getQuadrant (x, y) | x < 0 && y >= 0 = SE
-getQuadrant (x, y) | x < 0 && y < 0 = SW
-getQuadrant (x, y) = NW
-
-
-getDirection :: Quadrant -> Quadrant -> Maybe Direction
-getDirectory a b | a == b = Nothing
-getDirection SW SE = Just CCW
-getDirection SE NE = Just CCW
-getDirection NE NW = Just CCW
-getDirection NW SW = Just CCW
-getDirection _ _ = Just CW
-
-
-liftMouseMotionM :: X a -> MouseMotionM a
-liftMouseMotionM = MouseMotionM . fmap Just
-
-motion :: MouseMotionM (V2 Int)
-motion = MouseMotionM $ do
- ev <- nextMotionOrButton
- case ev of
- Right button -> do
- logs ("Button " ++ show button)
- return Nothing
-
- Left motion -> return (Just $ uncurry V2 motion)
-
-motionSize :: Int -> MouseMotionM (V2 Int)
-motionSize size = do
- let fsize = fromIntegral size
-
- !firstmotion <- fmap fromIntegral <$> motion
-
- let get = do
- !next <- motion
- if distance (fmap fromIntegral next) firstmotion >= fsize
- then return next
- else get
-
- get
-
-runMouseMotionM :: MouseMotionM a -> X (Maybe a)
-runMouseMotionM (MouseMotionM a) = a
-
-execMouseMotionM :: MouseMotionM () -> X ()
-execMouseMotionM = void . runMouseMotionM
-
--- Monad for capturing mouse motion. Terminates and holds Nothing when a
--- button is pressed.
-newtype MouseMotionM a = MouseMotionM (X (Maybe a))
-
-instance Functor MouseMotionM where
- fmap fn (MouseMotionM xma) = MouseMotionM (fmap (fmap fn) xma)
-
-instance Applicative MouseMotionM where
- mf <*> ma = do
- !f <- mf
- !a <- ma
- return (f a)
-
- pure = return
-
-instance Monad MouseMotionM where
- return a = MouseMotionM (return (Just a))
- (MouseMotionM !xa) >>= fn = MouseMotionM $ do
- !ma <- xa
- case ma of
- Just !a ->
- let (MouseMotionM !xb) = fn a in xb
- Nothing -> return Nothing
-
-mouseRotateMotion :: X () -> X () -> X ()
-mouseRotateMotion clockWise counterClockwise = execMouseMotionM doMouse
- where
- doMouse = forever $ do
- v <- motion
- liftMouseMotionM $ logs $ "Motion: " ++ show v