diff options
| author | Josh Rahm <joshuarahm@gmail.com> | 2022-11-22 23:18:52 -0700 |
|---|---|---|
| committer | Josh Rahm <joshuarahm@gmail.com> | 2022-11-22 23:18:52 -0700 |
| commit | 4b8ead746825a1534b8506857d773ba822a9e3b9 (patch) | |
| tree | 71530394bfcc44b3f236cdc64d68e62e56a3a710 /src/Rahm/Desktop/Layout | |
| parent | bd8b79332fe19d88cfdfe1cff1255e4c9c8be65d (diff) | |
| download | rde-4b8ead746825a1534b8506857d773ba822a9e3b9.tar.gz rde-4b8ead746825a1534b8506857d773ba822a9e3b9.tar.bz2 rde-4b8ead746825a1534b8506857d773ba822a9e3b9.zip | |
Remove some layout bloat.
Remove a bunch of esentially-unused layouts. Now the layouts are:
- Spiral
- Mosaic
- Tall
Diffstat (limited to 'src/Rahm/Desktop/Layout')
| -rw-r--r-- | src/Rahm/Desktop/Layout/Bordering.hs | 208 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Layout/CornerLayout.hs | 59 |
2 files changed, 0 insertions, 267 deletions
diff --git a/src/Rahm/Desktop/Layout/Bordering.hs b/src/Rahm/Desktop/Layout/Bordering.hs deleted file mode 100644 index 5fb1259..0000000 --- a/src/Rahm/Desktop/Layout/Bordering.hs +++ /dev/null @@ -1,208 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} - -module Rahm.Desktop.Layout.Bordering - ( Bordering (..), - banishToBorder, - unbanish, - rotateBorderForward, - rotateBorderBackward, - bordering, - toggleBanish, - changeWidth, - changeHeight, - moveForward, - moveBackward, - ) -where - -import Control.Arrow -import Control.Monad -import Data.List (find, partition) -import Data.Map (Map) -import qualified Data.Map as Map -import Data.Maybe (fromMaybe) -import Data.Proxy (Proxy) -import qualified Data.Set as Set -import Data.Tuple (swap) -import Data.Typeable (cast) -import Rahm.Desktop.Logger -import qualified Rahm.Desktop.StackSet as W -import XMonad - -data BorderPosition - = North - | NorthEast - | East - | SouthEast - | South - | SouthWest - | West - | NorthWest - deriving (Eq, Show, Read, Ord, Enum, Bounded) - -data BorderingData a = BorderingData - { extraWindows :: Map BorderPosition a, - borderingWidth :: Rational, - borderingHeight :: Rational, - borderingPadding :: Int - } - deriving (Eq, Ord, Show, Read) - -data Bordering (l :: * -> *) (a :: *) = Bordering - { borderingData :: BorderingData a, - wrappedLayout :: l a - } - deriving (Eq, Ord, Show, Read) - -data ModifyBordering a - = ModifyBordering (BorderingData a -> BorderingData a) - deriving (Message) - -enumNext :: (Eq a, Enum a, Bounded a) => a -> a -enumNext a - | a == maxBound = minBound - | otherwise = succ a - -enumPrev :: (Eq a, Enum a, Bounded a) => a -> a -enumPrev a - | a == minBound = maxBound - | otherwise = pred a - -bordering :: l a -> Bordering l a -bordering = Bordering (BorderingData mempty (1 / 6) (1 / 6) 10) - -banishToBorder :: a -> ModifyBordering a -banishToBorder win = - let allPositions = - (\(a, b) -> b ++ a) $ break (== SouthEast) [minBound .. maxBound] - in ModifyBordering $ \dat -> - maybe - dat - ( \pos -> - dat {extraWindows = Map.insert pos win (extraWindows dat)} - ) - $ find (not . (`Map.member` extraWindows dat)) allPositions - -toggleBanish :: (Eq a) => a -> ModifyBordering a -toggleBanish win = ModifyBordering $ \dat -> - let (ModifyBordering fn) = - if elem win $ Map.elems $ extraWindows dat - then unbanish win - else banishToBorder win - in fn dat - -unbanish :: (Eq a) => a -> ModifyBordering a -unbanish win = - ModifyBordering $ \dat -> - maybe - dat - (\pos -> dat {extraWindows = Map.delete pos (extraWindows dat)}) - $ (fst <$> find ((== win) . snd) (Map.toList $ extraWindows dat)) - -rotateBorder :: (BorderPosition -> BorderPosition) -> ModifyBordering a -rotateBorder next = ModifyBordering $ \dat -> - dat {extraWindows = Map.mapKeys next (extraWindows dat)} - -rotateBorderForward :: Proxy a -> ModifyBordering a -rotateBorderForward _ = rotateBorder enumNext - -rotateBorderBackward :: Proxy a -> ModifyBordering a -rotateBorderBackward _ = rotateBorder enumPrev - -changeWidth :: Proxy a -> Rational -> ModifyBordering a -changeWidth _ amt = ModifyBordering $ \dat -> - dat {borderingWidth = guard $ borderingWidth dat + amt} - where - guard x - | x < 1 / 12 = 1 / 12 - | x > 4 / 12 = 4 / 12 - | otherwise = x - -changeHeight :: Proxy a -> Rational -> ModifyBordering a -changeHeight _ amt = ModifyBordering $ \dat -> - dat {borderingHeight = guard $ borderingHeight dat + amt} - where - guard x - | x < 1 / 12 = 1 / 12 - | x > 4 / 12 = 4 / 12 - | otherwise = x - -instance Semigroup (ModifyBordering a) where - (<>) = mappend - -instance Monoid (ModifyBordering a) where - mempty = ModifyBordering id - mappend (ModifyBordering f1) (ModifyBordering f2) = ModifyBordering (f2 . f1) - -move :: (Eq a) => (BorderPosition -> BorderPosition) -> a -> ModifyBordering a -move fn win = ModifyBordering $ \dat -> - let mKey = fst <$> find ((== win) . snd) (Map.toList $ extraWindows dat) - in case mKey of - Nothing -> dat - Just key -> - let newKey = - until - (\k -> not (Map.member k (extraWindows dat) && k /= key)) - fn - (fn key) - wins' = Map.insert newKey win $ Map.delete key $ extraWindows dat - in dat {extraWindows = wins'} - -moveForward :: (Eq a) => a -> ModifyBordering a -moveForward = move enumNext - -moveBackward :: (Eq a) => a -> ModifyBordering a -moveBackward = move enumPrev - -instance (Show a, Ord a, LayoutClass l a, Typeable a) => LayoutClass (Bordering l) a where - runLayout (W.Workspace t (Bordering dat l) as) rect = do - let (out, rest) = filterStack as - (rects, maybeNewLayout) <- runLayout (W.Workspace t l rest) rect - return (layoutRest out ++ rects, Bordering dat <$> maybeNewLayout) - where - filterStack Nothing = ([], Nothing) - filterStack (Just (W.Stack f h t)) = do - let elSet = Set.fromList (Map.elems $ extraWindows dat) - ((hp, h'), (tp, t')) = dbl (partition (`Set.member` elSet)) (h, t) - in case (Set.member f elSet, h', t', hp ++ tp) of - (False, _, _, r) -> (r, Just $ W.Stack f h' t') - (True, (a : h''), _, r) -> (f : r, Just $ W.Stack a h'' t') - (True, [], (a : t''), r) -> (f : r, Just $ W.Stack a [] t'') - (True, [], [], r) -> (f : r, Nothing) - - layoutRest windows = - map (second (scaleRationalRect (padRect rect) . loc2Rect) . swap) $ - filter ((`elem` windows) . snd) $ - Map.toList (extraWindows dat) - - padRect (Rectangle x y w h) = - let p :: (Integral a) => a - p = fromIntegral (borderingPadding dat) - in Rectangle (x + p) (y + p) (w - p * 2) (h - p * 2) - - loc2Rect loc = case loc of - North -> W.RationalRect (1 / 2 - (bw / 2)) 0 bw bh - NorthEast -> W.RationalRect (1 - bw) 0 bw bh - East -> W.RationalRect (1 - bw) (1 / 2 - (bh / 2)) bw bh - SouthEast -> W.RationalRect (1 - bw) (1 - bh) bw bh - South -> W.RationalRect (1 / 2 - (bw / 2)) (1 - bh) bw bh - SouthWest -> W.RationalRect 0 (1 - bh) bw bh - West -> W.RationalRect 0 (1 / 2 - (bh / 2)) bw bh - NorthWest -> W.RationalRect 0 0 bw bh - where - bw = borderingWidth dat - bh = borderingHeight dat - - dbl f = f *** f - - handleMessage (Bordering d l) m@(fromMessage -> Just e@DestroyWindowEvent {ev_window = w}) = do - maybeNewLayout <- handleMessage l m - return $ Just $ Bordering (f d) (fromMaybe l maybeNewLayout) - where - f e@BorderingData {extraWindows = ws} = - e {extraWindows = Map.filter (maybe True (/= w) . cast) ws} - handleMessage (Bordering d l) (fromMessage -> Just (ModifyBordering fn)) = - return (Just $ Bordering (fn d) l) - handleMessage (Bordering d l) a = do - maybeNewLayout <- handleMessage l a - return (Bordering d <$> maybeNewLayout) diff --git a/src/Rahm/Desktop/Layout/CornerLayout.hs b/src/Rahm/Desktop/Layout/CornerLayout.hs deleted file mode 100644 index f87d9fa..0000000 --- a/src/Rahm/Desktop/Layout/CornerLayout.hs +++ /dev/null @@ -1,59 +0,0 @@ --- Creates a layout, the "corner layout" that keeps the master window in the --- corner and the other windows go around it. -module Rahm.Desktop.Layout.CornerLayout where - -import Data.Typeable (Typeable) -import qualified Rahm.Desktop.StackSet as S -import XMonad (LayoutClass (..), Rectangle (..), Resize (..), fromMessage) - -data Corner a = Corner Rational Rational - deriving (Show, Typeable, Read) - -instance LayoutClass Corner a where - pureLayout (Corner frac _) screen@(Rectangle x y w h) ss = - let w' = floor $ fromIntegral w * frac - h' = floor $ fromIntegral h * frac - corner = Rectangle 0 0 w' h' - vertRect = Rectangle (fromIntegral w') 0 (w - w') h - horizRect = Rectangle 0 (fromIntegral h') w' (h - h') - ws = S.integrate ss - - vn = (length ws - 1) `div` 2 - hn = (length ws - 1) - vn - in case ws of - [a] -> [(a, screen)] - [a, b] -> - [ (a, Rectangle x y w' h), - (b, Rectangle (x + fromIntegral w') y (w - w') h) - ] - _ -> - zip ws $ - map - ( \(Rectangle x' y' w h) -> Rectangle (x + x') (y + y') w h - ) - $ corner : - splitVert vertRect vn - ++ splitHoriz horizRect hn - - pureMessage (Corner frac delta) m = fmap resize (fromMessage m) - where - resize Shrink = Corner (frac - delta) delta - resize Expand = Corner (frac + delta) delta - -splitVert :: Rectangle -> Int -> [Rectangle] -splitVert (Rectangle x y w h) i' = - map - (\i -> Rectangle x (y + fromIntegral (step * i)) w step) - [0 .. i - 1] - where - i = fromIntegral i' - step = h `div` i - -splitHoriz :: Rectangle -> Int -> [Rectangle] -splitHoriz (Rectangle x y w h) i' = - map - (\i -> Rectangle (x + fromIntegral (step * i)) y step h) - [0 .. i - 1] - where - step = w `div` i - i = fromIntegral i' |