aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Rahm/Desktop/MouseMotion.hs96
1 files changed, 0 insertions, 96 deletions
diff --git a/src/Rahm/Desktop/MouseMotion.hs b/src/Rahm/Desktop/MouseMotion.hs
deleted file mode 100644
index 7c71644..0000000
--- a/src/Rahm/Desktop/MouseMotion.hs
+++ /dev/null
@@ -1,96 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-
-module Rahm.Desktop.MouseMotion where
-
-import Control.Monad (forever, void)
-import Control.Monad.Fix (fix)
-import Control.Monad.Loops (iterateWhile)
-import Linear.Metric
-import Linear.V2
-import Rahm.Desktop.Logger
-import Rahm.Desktop.Submap
-import Text.Printf
-import XMonad
-
-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 Info "Button %s" (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 Info "Motion: %s" (show v)