diff options
Diffstat (limited to 'src/Rahm/Desktop/Workspaces.hs')
| -rw-r--r-- | src/Rahm/Desktop/Workspaces.hs | 100 |
1 files changed, 41 insertions, 59 deletions
diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs index 48ed523..1bd5c51 100644 --- a/src/Rahm/Desktop/Workspaces.hs +++ b/src/Rahm/Desktop/Workspaces.hs @@ -17,7 +17,6 @@ module Rahm.Desktop.Workspaces workspaceWithWindow, getScreensOnSamePlane, getScreensOnDifferentPlane, - getWorkspacesAlongLine, getWorkspaceToTheRight, getWorkspaceToTheLeft, getWorkspaceAbove, @@ -35,7 +34,7 @@ import Data.List (find, sort, sortBy, sortOn, (\\)) import Data.List.Safe ((!!)) import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import Debug.Trace -import qualified Geometry +import Rahm.Desktop.Geometry import Rahm.Desktop.Common (getCurrentWorkspace, gotoWorkspace, runMaybeT_) import Rahm.Desktop.Logger import qualified Rahm.Desktop.StackSet as W @@ -51,6 +50,7 @@ import XMonad windows, withWindowSet, ) +import XMonad.Util.Loggers (logFileCount) import Prelude hiding ((!!)) newtype Selector = Selector (forall a. (a -> Bool) -> [a] -> Maybe a) @@ -135,7 +135,7 @@ getScreensOnSamePlane ss = where yCenter | (SD (Rectangle _ y _ h)) <- W.screenDetail . W.current $ ss = - (y + fromIntegral h) `div` 2 + (y + fromIntegral h) `div` 2 matchesYCenter (_, W.screenDetail -> (SD (Rectangle _ y _ h))) = y < yCenter && y + fromIntegral h > yCenter @@ -151,7 +151,7 @@ getScreensOnDifferentPlane ss = y + (fromIntegral h `div` 2) matchesScreen yCenter | (SD (Rectangle _ y _ h)) <- W.screenDetail (W.current ss) = - yCenter < y + fromIntegral h && yCenter > y + yCenter < y + fromIntegral h && yCenter > y accompanyingWorkspace :: WorkspaceId -> WorkspaceId accompanyingWorkspace [s] @@ -224,65 +224,47 @@ workspaceWithWindow wid = withWindowSet $ \(W.StackSet c v h _) -> (\(W.Workspace _ _ stack) -> wid `elem` W.integrate' stack) (map W.workspace (c : v) ++ h) -getWorkspacesAlongLine :: Geometry.Line Int32 -> X [WorkspaceId] -getWorkspacesAlongLine line = withWindowSet $ \windowSet -> - let extractRect :: ScreenDetail -> Geometry.GeometryRectangle Int32 - extractRect (SD (Rectangle x y w h)) = Geometry.rectangleToGeometry (Rectangle x y w h) - convertRect :: Geometry.GeometryRectangle Int32 -> WorkspaceId -> (Geometry.GeometryRectangle Double, WorkspaceId) - convertRect (Geometry.GeometryRectangle x y w h) tag = - ( Geometry.GeometryRectangle - { Geometry.geoX = fromIntegral x, - Geometry.geoY = fromIntegral y, - Geometry.geoWidth = fromIntegral w, - Geometry.geoHeight = fromIntegral h - }, - tag - ) - currentRect = extractRect . W.screenDetail . W.current $ windowSet - currentTag = W.tag $ W.workspace $ W.current windowSet - currentWs = convertRect currentRect currentTag - visibleRects = - map - ( \screen -> - let rect = extractRect (W.screenDetail screen) - tag = W.tag $ W.workspace screen - in convertRect rect tag - ) - (W.visible windowSet) - rects = currentWs : visibleRects - intersecting = Geometry.getIntersectingRectangles line' rects - line' = - Geometry.Line - { Geometry.x = fromIntegral (Geometry.x line), - Geometry.y = fromIntegral (Geometry.y line), - Geometry.dx = fromIntegral (Geometry.dx line), - Geometry.dy = fromIntegral (Geometry.dy line) - } - in return $ map Geometry.tag intersecting +getScreenRectangles :: X [(GeomRectangle, WorkspaceId)] +getScreenRectangles = + withWindowSet $ \(W.StackSet cur vis _ _) -> do + return $ ofScreen cur : map ofScreen vis + where + ofScreen (W.Screen (W.tag -> t) _ (SD rect)) = (toGeom rect, t) + toGeom (Rectangle x y w h) = + GeomRectangle + (fromIntegral x) + (fromIntegral y) + (fromIntegral w) + (fromIntegral h) -getWorkspaceToTheRight :: WorkspaceId -> X WorkspaceId -getWorkspaceToTheRight w = getWorkspaceAlong w (1, 0) False +getScreenRect :: WorkspaceId -> X (Maybe GeomRectangle) +getScreenRect w = do + rects <- getScreenRectangles + return $ listToMaybe [r | (r, w') <- rects, w' == w] -getWorkspaceToTheLeft :: WorkspaceId -> X WorkspaceId -getWorkspaceToTheLeft w = getWorkspaceAlong w (1, 0) True +getWorkspaceToTheRight :: WorkspaceId -> MaybeT X WorkspaceId +getWorkspaceToTheRight w = do + refRect <- lift $ getScreenRect w + rects <- lift getScreenRectangles + MaybeT $ return (snd <$> closestInDirection rects w E) -getWorkspaceAbove :: WorkspaceId -> X WorkspaceId -getWorkspaceAbove w = getWorkspaceAlong w (0, 1) True +getWorkspaceToTheLeft :: WorkspaceId -> MaybeT X WorkspaceId +getWorkspaceToTheLeft w = do + refRect <- lift $ getScreenRect w + rects <- lift getScreenRectangles + MaybeT $ return (snd <$> closestInDirection rects w W) -getWorkspaceBelow :: WorkspaceId -> X WorkspaceId -getWorkspaceBelow w = getWorkspaceAlong w (0, 1) False +getWorkspaceAbove :: WorkspaceId -> MaybeT X WorkspaceId +getWorkspaceAbove w = do + refRect <- lift $ getScreenRect w + rects <- lift getScreenRectangles + MaybeT $ return (snd <$> closestInDirection rects w N) -getWorkspaceAlong :: WorkspaceId -> (Int32, Int32) -> Bool -> X WorkspaceId -getWorkspaceAlong w dir reverseResults = do - center <- getWorkspaceCenter w - case center of - Nothing -> return w - Just (cx, cy) -> do - let p1 = (cx, cy) - p2 = (cx + fst dir, cy + snd dir) - let line = Geometry.lineThrough2Points p1 p2 - wss <- getWorkspacesAlongLine line - return $ if null wss then w else lookupNext w (if reverseResults then reverse wss else wss) +getWorkspaceBelow :: WorkspaceId -> MaybeT X WorkspaceId +getWorkspaceBelow w = do + refRect <- lift $ getScreenRect w + rects <- lift getScreenRectangles + MaybeT $ return (snd <$> closestInDirection rects w S) getWorkspaceCenter :: WorkspaceId -> X (Maybe (Int32, Int32)) getWorkspaceCenter w = withWindowSet $ \(W.StackSet cur vis _ _) -> @@ -297,7 +279,7 @@ getWorkspaceCenter w = withWindowSet $ \(W.StackSet cur vis _ _) -> wsTag = W.tag (W.workspace screen) in ((x + fromIntegral w `div` 2, y + fromIntegral h `div` 2), wsTag) -lookupNext :: Eq a => a -> [a] -> a +lookupNext :: (Eq a) => a -> [a] -> a lookupNext x [] = x lookupNext target (x : xs) | x == target = if null xs then target else head xs |