From c1a6ed7be8b090cea63a70fa86ee614d011d0f63 Mon Sep 17 00:00:00 2001 From: Daniel Schoepe Date: Sat, 19 Sep 2009 21:17:17 +0200 Subject: Factor out direction types and put them in X.U.Types Ignore-this: b2255ec2754fcdf797b1ce2c082642ba This patch factors out commonly used direction types like data Direction darcs-hash:20090919191717-7f603-09c283e51a0b886d260008676d71e3daf31f4394.gz --- XMonad/Actions/CycleWS.hs | 12 +++++------- XMonad/Actions/FloatSnap.hs | 15 ++++++++------- XMonad/Actions/MouseGestures.hs | 16 ++++++++-------- XMonad/Actions/SwapWorkspaces.hs | 5 +++-- XMonad/Actions/WindowNavigation.hs | 22 +++++++++++----------- 5 files changed, 35 insertions(+), 35 deletions(-) (limited to 'XMonad/Actions') diff --git a/XMonad/Actions/CycleWS.hs b/XMonad/Actions/CycleWS.hs index 6cce784..f7c9fe4 100644 --- a/XMonad/Actions/CycleWS.hs +++ b/XMonad/Actions/CycleWS.hs @@ -60,7 +60,7 @@ module XMonad.Actions.CycleWS ( -- * Moving between workspaces, take two! -- $taketwo - , WSDirection(..) + , Direction1D(..) , WSType(..) , shiftTo @@ -80,6 +80,7 @@ import Data.Maybe ( isNothing, isJust ) import XMonad hiding (workspaces) import XMonad.StackSet hiding (filter) +import XMonad.Util.Types import XMonad.Util.WorkspaceCompare -- $usage @@ -211,9 +212,6 @@ the letter 'p' in its name. =) -} --- | Direction to cycle through the sort order. -data WSDirection = Next | Prev - -- | What type of workspaces should be included in the cycle? data WSType = EmptyWS -- ^ cycle through empty workspaces | NonEmptyWS -- ^ cycle through non-empty workspaces @@ -238,12 +236,12 @@ wsTypeToPred (WSIs p) = p -- | View the next workspace in the given direction that satisfies -- the given condition. -moveTo :: WSDirection -> WSType -> X () +moveTo :: Direction1D -> WSType -> X () moveTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . greedyView -- | Move the currently focused window to the next workspace in the -- given direction that satisfies the given condition. -shiftTo :: WSDirection -> WSType -> X () +shiftTo :: Direction1D -> WSType -> X () shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift -- | Given a function @s@ to sort workspaces, a direction @dir@, a @@ -259,7 +257,7 @@ shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift -- that 'moveTo' and 'shiftTo' are implemented by applying @(>>= -- (windows . greedyView))@ and @(>>= (windows . shift))@, respectively, -- to the output of 'findWorkspace'. -findWorkspace :: X WorkspaceSort -> WSDirection -> WSType -> Int -> X WorkspaceId +findWorkspace :: X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceId findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n) where maybeNegate Next d = d diff --git a/XMonad/Actions/FloatSnap.hs b/XMonad/Actions/FloatSnap.hs index cc618cd..51281a4 100644 --- a/XMonad/Actions/FloatSnap.hs +++ b/XMonad/Actions/FloatSnap.hs @@ -15,7 +15,7 @@ module XMonad.Actions.FloatSnap ( -- * Usage -- $usage - Direction(..), + Direction2D(..), snapMove, snapGrow, snapShrink, @@ -29,7 +29,8 @@ import Data.List (sort) import Data.Maybe (listToMaybe,fromJust,isNothing) import qualified XMonad.StackSet as W -import XMonad.Hooks.ManageDocks (Direction(..),calcGap) +import XMonad.Hooks.ManageDocks (calcGap) +import XMonad.Util.Types (Direction2D(..)) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: @@ -102,7 +103,7 @@ snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDi -- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. snapMagicResize - :: [Direction] -- ^ The edges to snap. + :: [Direction2D] -- ^ The edges to snap. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. -> Window -- ^ The window to move and resize. @@ -188,7 +189,7 @@ snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> -- | Move a window in the specified direction until it snaps against another window or the edge of the screen. snapMove - :: Direction -- ^ What direction to move the window in. + :: Direction2D -- ^ What direction to move the window in. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Window -- ^ The window to move. -> X () @@ -223,7 +224,7 @@ doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do -- | Grow the specified edge of a window until it snaps against another window or the edge of the screen. snapGrow - :: Direction -- ^ What edge of the window to grow. + :: Direction2D -- ^ What edge of the window to grow. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Window -- ^ The window to grow. -> X () @@ -231,13 +232,13 @@ snapGrow = snapResize True -- | Shrink the specified edge of a window until it snaps against another window or the edge of the screen. snapShrink - :: Direction -- ^ What edge of the window to shrink. + :: Direction2D -- ^ What edge of the window to shrink. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Window -- ^ The window to shrink. -> X () snapShrink = snapResize False -snapResize :: Bool -> Direction -> Maybe Int -> Window -> X () +snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X () snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w wa <- io $ getWindowAttributes d w diff --git a/XMonad/Actions/MouseGestures.hs b/XMonad/Actions/MouseGestures.hs index 647803a..49a7582 100644 --- a/XMonad/Actions/MouseGestures.hs +++ b/XMonad/Actions/MouseGestures.hs @@ -15,14 +15,14 @@ module XMonad.Actions.MouseGestures ( -- * Usage -- $usage - Direction(..), + Direction2D(..), mouseGestureH, mouseGesture, mkCollect ) where import XMonad -import XMonad.Hooks.ManageDocks (Direction(..)) +import XMonad.Util.Types (Direction2D(..)) import Data.IORef import qualified Data.Map as M @@ -64,10 +64,10 @@ delta (ax, ay) (bx, by) = max (d ax bx) (d ay by) where d a b = abs (a - b) -dir :: Pos -> Pos -> Direction +dir :: Pos -> Pos -> Direction2D dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax) where - trans :: Double -> Direction + trans :: Double -> Direction2D trans x | rg (-3/4) (-1/4) x = D | rg (-1/4) (1/4) x = R @@ -75,7 +75,7 @@ dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromInt | otherwise = L rg a z x = a <= x && x < z -gauge :: (Direction -> X ()) -> Pos -> IORef (Maybe (Direction, Pos)) -> Position -> Position -> X () +gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Position -> Position -> X () gauge hook op st nx ny = do let np = (nx, ny) stx <- io $ readIORef st @@ -96,7 +96,7 @@ gauge hook op st nx ny = do -- | @'mouseGestureH' moveHook endHook@ is a mouse button -- event handler. It collects mouse movements, calling @moveHook@ for each -- update; when the button is released, it calls @endHook@. -mouseGestureH :: (Direction -> X ()) -> X () -> X () +mouseGestureH :: (Direction2D -> X ()) -> X () -> X () mouseGestureH moveHook endHook = do dpy <- asks display root <- asks theRoot @@ -108,7 +108,7 @@ mouseGestureH moveHook endHook = do -- | A utility function on top of 'mouseGestureH'. It uses a 'Data.Map.Map' to -- look up the mouse gesture, then executes the corresponding action (if any). -mouseGesture :: Map [Direction] (Window -> X ()) -> Window -> X () +mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X () mouseGesture tbl win = do (mov, end) <- mkCollect mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest -> @@ -121,7 +121,7 @@ mouseGesture tbl win = do -- collect mouse movements (and return the current gesture as a list); the end -- hook will return a list of the completed gesture, which you can access with -- 'Control.Monad.>>='. -mkCollect :: (MonadIO m, MonadIO m') => m (Direction -> m' [Direction], m' [Direction]) +mkCollect :: (MonadIO m, MonadIO m') => m (Direction2D -> m' [Direction2D], m' [Direction2D]) mkCollect = liftIO $ do acc <- newIORef [] let diff --git a/XMonad/Actions/SwapWorkspaces.hs b/XMonad/Actions/SwapWorkspaces.hs index 9890ef2..895e7f8 100644 --- a/XMonad/Actions/SwapWorkspaces.hs +++ b/XMonad/Actions/SwapWorkspaces.hs @@ -19,12 +19,13 @@ module XMonad.Actions.SwapWorkspaces ( swapWithCurrent, swapTo, swapWorkspaces, - WSDirection(..) + Direction1D(..) ) where import XMonad (windows, X()) import XMonad.StackSet import XMonad.Actions.CycleWS +import XMonad.Util.Types import XMonad.Util.WorkspaceCompare @@ -52,7 +53,7 @@ swapWithCurrent t s = swapWorkspaces t (currentTag s) s -- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace. -- This is an @X ()@ so can be hooked up to your keybindings directly. -swapTo :: WSDirection -> X () +swapTo :: Direction1D -> X () swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurrent -- | Takes two workspace tags and an existing XMonad.StackSet and returns a new diff --git a/XMonad/Actions/WindowNavigation.hs b/XMonad/Actions/WindowNavigation.hs index 99b61b6..8289c27 100644 --- a/XMonad/Actions/WindowNavigation.hs +++ b/XMonad/Actions/WindowNavigation.hs @@ -34,11 +34,11 @@ module XMonad.Actions.WindowNavigation ( withWindowNavigationKeys, WNAction(..), go, swap, - Direction(..) + Direction2D(..) ) where import XMonad -import XMonad.Hooks.ManageDocks (Direction(..)) +import XMonad.Util.Types (Direction2D(..)) import qualified XMonad.StackSet as W import Control.Applicative ((<$>)) @@ -104,7 +104,7 @@ withWindowNavigationKeys wnKeys conf = do where fromWNAction posRef (WNGo dir) = go posRef dir fromWNAction posRef (WNSwap dir) = swap posRef dir -data WNAction = WNGo Direction | WNSwap Direction +data WNAction = WNGo Direction2D | WNSwap Direction2D type WNState = Map WorkspaceId Point @@ -113,10 +113,10 @@ type WNState = Map WorkspaceId Point -- 2. get target windowrect -- 3. focus window -- 4. set new position -go :: IORef WNState -> Direction -> X () +go :: IORef WNState -> Direction2D -> X () go = withTargetWindow W.focusWindow -swap :: IORef WNState -> Direction -> X () +swap :: IORef WNState -> Direction2D -> X () swap = withTargetWindow swapWithFocused where swapWithFocused targetWin winSet = case W.peek winSet of @@ -128,7 +128,7 @@ swap = withTargetWindow swapWithFocused mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down) swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win -withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction -> X () +withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X () withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do targets <- filter ((/= win) . fst) <$> navigableTargets pos dir whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do @@ -175,12 +175,12 @@ Point x y `inside` Rectangle rx ry rw rh = midPoint :: Position -> Dimension -> Position midPoint pos dim = pos + fromIntegral dim `div` 2 -navigableTargets :: Point -> Direction -> X [(Window, Rectangle)] +navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)] navigableTargets point dir = navigable dir point <$> windowRects -- Filters and sorts the windows in terms of what is closest from the Point in --- the Direction. -navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] +-- the Direction2D. +navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] navigable d pt = sortby d . filter (inr d pt . snd) -- Produces a list of normal-state windows, on any screen. Rectangles are @@ -197,7 +197,7 @@ windowRect win = withDisplay $ \dpy -> do -- Modified from droundy's implementation of WindowNavigation: -inr :: Direction -> Point -> Rectangle -> Bool +inr :: Direction2D -> Point -> Rectangle -> Bool inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w && py < ry + fromIntegral h inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w && @@ -207,7 +207,7 @@ inr R (Point px py) (Rectangle rx ry _ h) = px < rx && inr L (Point px py) (Rectangle rx ry w h) = px > rx + fromIntegral w && py >= ry && py < ry + fromIntegral h -sortby :: Direction -> [(a,Rectangle)] -> [(a,Rectangle)] +sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)] sortby D = sortBy $ comparing (rect_y . snd) sortby R = sortBy $ comparing (rect_x . snd) sortby U = reverse . sortby D -- cgit v1.2.3