From 677276ea948a5a00ae03ed0d8706a68eafc8944d Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Wed, 23 Nov 2022 00:31:40 -0700 Subject: Remove MouseMotion.hs. It's old bloat. --- src/Rahm/Desktop/MouseMotion.hs | 96 ----------------------------------------- 1 file changed, 96 deletions(-) delete mode 100644 src/Rahm/Desktop/MouseMotion.hs (limited to 'src') 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) -- cgit