X.L.BinarySpacePartition: Customizable ratio in messages that resize windows

Co-authored-by: Yecine Megdiche <yecine.megdiche@gmail.com>
This commit is contained in:
Joan Milev 2021-05-11 01:13:26 +03:00 committed by Tomas Janousek
parent f6b1e5dd88
commit f4673d611b
2 changed files with 104 additions and 83 deletions

View File

@ -567,6 +567,11 @@
- Floating windows are no longer moved to the end of the window stack. - Floating windows are no longer moved to the end of the window stack.
* `XMonad.Layout.BinarySpacePartition`
- Add the ability to increase/decrease the window size by a custom
rational number. E.g: `sendMessage $ ExpandTowardsBy L 0.02`
## 0.16 ## 0.16
### Breaking Changes ### Breaking Changes

View File

@ -1,4 +1,5 @@
{-# LANGUAGE PatternGuards #-} {-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@ -24,7 +25,7 @@ module XMonad.Layout.BinarySpacePartition (
, BinarySpacePartition , BinarySpacePartition
, Rotate(..) , Rotate(..)
, Swap(..) , Swap(..)
, ResizeDirectional(..) , ResizeDirectional(.., ExpandTowards, ShrinkFrom, MoveSplit)
, TreeRotate(..) , TreeRotate(..)
, TreeBalance(..) , TreeBalance(..)
, FocusParent(..) , FocusParent(..)
@ -92,11 +93,15 @@ import Data.Ratio ((%))
-- > , ("M-M1-C-<Right>", sendMessage $ ExpandTowards R) -- > , ("M-M1-C-<Right>", sendMessage $ ExpandTowards R)
-- > , ("M-M1-C-<Up>", sendMessage $ ShrinkFrom D) -- > , ("M-M1-C-<Up>", sendMessage $ ShrinkFrom D)
-- > , ("M-M1-C-<Down>", sendMessage $ ExpandTowards D) -- > , ("M-M1-C-<Down>", sendMessage $ ExpandTowards D)
-- > , ("M-s", sendMessage $ BSP.Swap) -- > , ("M-s", sendMessage $ Swap)
-- > , ("M-M1-s", sendMessage $ Rotate) -- > , ("M-M1-s", sendMessage $ Rotate)
-- > , ("M-S-C-j", sendMessage $ SplitShift Prev) -- > , ("M-S-C-j", sendMessage $ SplitShift Prev)
-- > , ("M-S-C-k", sendMessage $ SplitShift Next) -- > , ("M-S-C-k", sendMessage $ SplitShift Next)
-- --
-- Note that @ExpandTowards x@, @ShrinkFrom x@, and @MoveSplit x@ are
-- the same as respectively @ExpandTowardsBy x 0.05@, @ShrinkFromBy x 0.05@
-- and @MoveSplitBy x 0.05@.
--
-- If you have many windows open and the layout begins to look too hard to manage, you can 'Balance' -- If you have many windows open and the layout begins to look too hard to manage, you can 'Balance'
-- the layout, so that the current splittings are discarded and windows are tiled freshly in a way that -- the layout, so that the current splittings are discarded and windows are tiled freshly in a way that
-- the split depth is minimized. You can combine this with 'Equalize', which does not change your tree, -- the split depth is minimized. You can combine this with 'Equalize', which does not change your tree,
@ -106,37 +111,52 @@ import Data.Ratio ((%))
-- > , ((myModMask .|. shiftMask, xK_a), sendMessage Equalize) -- > , ((myModMask .|. shiftMask, xK_a), sendMessage Equalize)
-- --
-- |Message for rotating the binary tree around the parent node of the window to the left or right -- | Message for rotating the binary tree around the parent node of the window to the left or right
data TreeRotate = RotateL | RotateR deriving Typeable data TreeRotate = RotateL | RotateR deriving Typeable
instance Message TreeRotate instance Message TreeRotate
-- |Message to balance the tree in some way (Balance retiles the windows, Equalize changes ratios) -- | Message to balance the tree in some way (Balance retiles the windows, Equalize changes ratios)
data TreeBalance = Balance | Equalize deriving Typeable data TreeBalance = Balance | Equalize deriving Typeable
instance Message TreeBalance instance Message TreeBalance
-- |Message for resizing one of the cells in the BSP -- | Message for resizing one of the cells in the BSP
data ResizeDirectional = ExpandTowards Direction2D | ShrinkFrom Direction2D | MoveSplit Direction2D deriving Typeable data ResizeDirectional =
ExpandTowardsBy Direction2D Rational
| ShrinkFromBy Direction2D Rational
| MoveSplitBy Direction2D Rational deriving Typeable
instance Message ResizeDirectional instance Message ResizeDirectional
-- |Message for rotating a split (horizontal/vertical) in the BSP -- | @ExpandTowards x@ is now the equivalent of @ExpandTowardsBy x 0.05@
pattern ExpandTowards :: Direction2D -> ResizeDirectional
pattern ExpandTowards d = ExpandTowardsBy d 0.05
-- | @ShrinkFrom x@ is now the equivalent of @ShrinkFromBy x 0.05@
pattern ShrinkFrom :: Direction2D -> ResizeDirectional
pattern ShrinkFrom d = ShrinkFromBy d 0.05
-- | @MoveSplit x@ is now the equivalent of @MoveSplitBy x 0.05@
pattern MoveSplit :: Direction2D -> ResizeDirectional
pattern MoveSplit d = MoveSplitBy d 0.05
-- | Message for rotating a split (horizontal/vertical) in the BSP
data Rotate = Rotate deriving Typeable data Rotate = Rotate deriving Typeable
instance Message Rotate instance Message Rotate
-- |Message for swapping the left child of a split with the right child of split -- | Message for swapping the left child of a split with the right child of split
data Swap = Swap deriving Typeable data Swap = Swap deriving Typeable
instance Message Swap instance Message Swap
-- |Message to cyclically select the parent node instead of the leaf -- | Message to cyclically select the parent node instead of the leaf
data FocusParent = FocusParent deriving Typeable data FocusParent = FocusParent deriving Typeable
instance Message FocusParent instance Message FocusParent
-- |Message to move nodes inside the tree -- | Message to move nodes inside the tree
data SelectMoveNode = SelectNode | MoveNode deriving Typeable data SelectMoveNode = SelectNode | MoveNode deriving Typeable
instance Message SelectMoveNode instance Message SelectMoveNode
data Axis = Horizontal | Vertical deriving (Show, Read, Eq) data Axis = Horizontal | Vertical deriving (Show, Read, Eq)
-- |Message for shifting window by splitting its neighbour -- | Message for shifting window by splitting its neighbour
data SplitShiftDirectional = SplitShift Direction1D deriving Typeable data SplitShiftDirectional = SplitShift Direction1D deriving Typeable
instance Message SplitShiftDirectional instance Message SplitShiftDirectional
@ -176,10 +196,6 @@ oppositeSplit (Split d r) = Split (oppositeAxis d) r
increaseRatio :: Split -> Rational -> Split increaseRatio :: Split -> Rational -> Split
increaseRatio (Split d r) delta = Split d (min 0.9 (max 0.1 (r + delta))) increaseRatio (Split d r) delta = Split d (min 0.9 (max 0.1 (r + delta)))
resizeDiff :: Rational
resizeDiff = 0.05
data Tree a = Leaf Int | Node { value :: a data Tree a = Leaf Int | Node { value :: a
, left :: Tree a , left :: Tree a
, right :: Tree a , right :: Tree a
@ -320,69 +336,69 @@ splitShiftRightCurrent l@(_, []) = Just l
splitShiftRightCurrent l@(_, (LeftCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead. splitShiftRightCurrent l@(_, (LeftCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead.
splitShiftRightCurrent l@(n, _) = removeCurrent l >>= findTheClosestRightmostLeaf >>= insertLeftLeaf n splitShiftRightCurrent l@(n, _) = removeCurrent l >>= findTheClosestRightmostLeaf >>= insertLeftLeaf n
isAllTheWay :: Direction2D -> Zipper Split -> Bool isAllTheWay :: Direction2D -> Rational -> Zipper Split -> Bool
isAllTheWay _ (_, []) = True isAllTheWay _ _ (_, []) = True
isAllTheWay R (_, LeftCrumb s _:_) isAllTheWay R _ (_, LeftCrumb s _:_)
| axis s == Vertical = False | axis s == Vertical = False
isAllTheWay L (_, RightCrumb s _:_) isAllTheWay L _ (_, RightCrumb s _:_)
| axis s == Vertical = False | axis s == Vertical = False
isAllTheWay D (_, LeftCrumb s _:_) isAllTheWay D _ (_, LeftCrumb s _:_)
| axis s == Horizontal = False | axis s == Horizontal = False
isAllTheWay U (_, RightCrumb s _:_) isAllTheWay U _ (_, RightCrumb s _:_)
| axis s == Horizontal = False | axis s == Horizontal = False
isAllTheWay dir z = fromMaybe False $ goUp z >>= Just . isAllTheWay dir isAllTheWay dir diff z = fromMaybe False $ goUp z >>= Just . isAllTheWay dir diff
expandTreeTowards :: Direction2D -> Zipper Split -> Maybe (Zipper Split) expandTreeTowards :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards _ z@(_, []) = Just z expandTreeTowards _ _ z@(_, []) = Just z
expandTreeTowards dir z expandTreeTowards dir diff z
| isAllTheWay dir z = shrinkTreeFrom (oppositeDirection dir) z | isAllTheWay dir diff z = shrinkTreeFrom (oppositeDirection dir) diff z
expandTreeTowards R (t, LeftCrumb s r:cs) expandTreeTowards R diff (t, LeftCrumb s r:cs)
| axis s == Vertical = Just (t, LeftCrumb (increaseRatio s resizeDiff) r:cs) | axis s == Vertical = Just (t, LeftCrumb (increaseRatio s diff) r:cs)
expandTreeTowards L (t, RightCrumb s l:cs) expandTreeTowards L diff (t, RightCrumb s l:cs)
| axis s == Vertical = Just (t, RightCrumb (increaseRatio s (-resizeDiff)) l:cs) | axis s == Vertical = Just (t, RightCrumb (increaseRatio s (-diff)) l:cs)
expandTreeTowards D (t, LeftCrumb s r:cs) expandTreeTowards D diff (t, LeftCrumb s r:cs)
| axis s == Horizontal = Just (t, LeftCrumb (increaseRatio s resizeDiff) r:cs) | axis s == Horizontal = Just (t, LeftCrumb (increaseRatio s diff) r:cs)
expandTreeTowards U (t, RightCrumb s l:cs) expandTreeTowards U diff (t, RightCrumb s l:cs)
| axis s == Horizontal = Just (t, RightCrumb (increaseRatio s (-resizeDiff)) l:cs) | axis s == Horizontal = Just (t, RightCrumb (increaseRatio s (-diff)) l:cs)
expandTreeTowards dir z = goUp z >>= expandTreeTowards dir expandTreeTowards dir diff z = goUp z >>= expandTreeTowards dir diff
shrinkTreeFrom :: Direction2D -> Zipper Split -> Maybe (Zipper Split) shrinkTreeFrom :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom _ z@(_, []) = Just z shrinkTreeFrom _ _ z@(_, []) = Just z
shrinkTreeFrom R z@(_, LeftCrumb s _:_) shrinkTreeFrom R diff z@(_, LeftCrumb s _:_)
| axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards L | axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards L diff
shrinkTreeFrom L z@(_, RightCrumb s _:_) shrinkTreeFrom L diff z@(_, RightCrumb s _:_)
| axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards R | axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards R diff
shrinkTreeFrom D z@(_, LeftCrumb s _:_) shrinkTreeFrom D diff z@(_, LeftCrumb s _:_)
| axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards U | axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards U diff
shrinkTreeFrom U z@(_, RightCrumb s _:_) shrinkTreeFrom U diff z@(_, RightCrumb s _:_)
| axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards D | axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards D diff
shrinkTreeFrom dir z = goUp z >>= shrinkTreeFrom dir shrinkTreeFrom dir diff z = goUp z >>= shrinkTreeFrom dir diff
-- Direction2D refers to which direction the divider should move. -- Direction2D refers to which direction the divider should move.
autoSizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split) autoSizeTree :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
autoSizeTree _ z@(_, []) = Just z autoSizeTree _ _ z@(_, []) = Just z
autoSizeTree d z = autoSizeTree d f z =
Just z >>= getSplit (toAxis d) >>= resizeTree d Just z >>= getSplit (toAxis d) >>= resizeTree d f
-- resizing once found the correct split. YOU MUST FIND THE RIGHT SPLIT FIRST. -- resizing once found the correct split. YOU MUST FIND THE RIGHT SPLIT FIRST.
resizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split) resizeTree :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
resizeTree _ z@(_, []) = Just z resizeTree _ _ z@(_, []) = Just z
resizeTree R z@(_, LeftCrumb _ _:_) = resizeTree R diff z@(_, LeftCrumb _ _:_) =
Just z >>= expandTreeTowards R Just z >>= expandTreeTowards R diff
resizeTree L z@(_, LeftCrumb _ _:_) = resizeTree L diff z@(_, LeftCrumb _ _:_) =
Just z >>= shrinkTreeFrom R Just z >>= shrinkTreeFrom R diff
resizeTree U z@(_, LeftCrumb _ _:_) = resizeTree U diff z@(_, LeftCrumb _ _:_) =
Just z >>= shrinkTreeFrom D Just z >>= shrinkTreeFrom D diff
resizeTree D z@(_, LeftCrumb _ _:_) = resizeTree D diff z@(_, LeftCrumb _ _:_) =
Just z >>= expandTreeTowards D Just z >>= expandTreeTowards D diff
resizeTree R z@(_, RightCrumb _ _:_) = resizeTree R diff z@(_, RightCrumb _ _:_) =
Just z >>= shrinkTreeFrom L Just z >>= shrinkTreeFrom L diff
resizeTree L z@(_, RightCrumb _ _:_) = resizeTree L diff z@(_, RightCrumb _ _:_) =
Just z >>= expandTreeTowards L Just z >>= expandTreeTowards L diff
resizeTree U z@(_, RightCrumb _ _:_) = resizeTree U diff z@(_, RightCrumb _ _:_) =
Just z >>= expandTreeTowards U Just z >>= expandTreeTowards U diff
resizeTree D z@(_, RightCrumb _ _:_) = resizeTree D diff z@(_, RightCrumb _ _:_) =
Just z >>= shrinkTreeFrom U Just z >>= shrinkTreeFrom U diff
getSplit :: Axis -> Zipper Split -> Maybe (Zipper Split) getSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
getSplit _ (_, []) = Nothing getSplit _ (_, []) = Nothing
@ -566,20 +582,20 @@ splitShiftNth _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
splitShiftNth Prev b = doToNth splitShiftLeftCurrent b splitShiftNth Prev b = doToNth splitShiftLeftCurrent b
splitShiftNth Next b = doToNth splitShiftRightCurrent b splitShiftNth Next b = doToNth splitShiftRightCurrent b
growNthTowards :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a growNthTowards :: Direction2D -> Rational -> BinarySpacePartition a -> BinarySpacePartition a
growNthTowards _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP growNthTowards _ _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP
growNthTowards _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b growNthTowards _ _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
growNthTowards dir b = doToNth (expandTreeTowards dir) b growNthTowards dir diff b = doToNth (expandTreeTowards dir diff) b
shrinkNthFrom :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a shrinkNthFrom :: Direction2D -> Rational -> BinarySpacePartition a -> BinarySpacePartition a
shrinkNthFrom _ (BinarySpacePartition _ _ _ Nothing)= emptyBSP shrinkNthFrom _ _ (BinarySpacePartition _ _ _ Nothing)= emptyBSP
shrinkNthFrom _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b shrinkNthFrom _ _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
shrinkNthFrom dir b = doToNth (shrinkTreeFrom dir) b shrinkNthFrom dir diff b = doToNth (shrinkTreeFrom dir diff) b
autoSizeNth :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a autoSizeNth :: Direction2D -> Rational -> BinarySpacePartition a -> BinarySpacePartition a
autoSizeNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP autoSizeNth _ _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP
autoSizeNth _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b autoSizeNth _ _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
autoSizeNth dir b = doToNth (autoSizeTree dir) b autoSizeNth dir diff b = doToNth (autoSizeTree dir diff) b
resizeSplitNth :: Direction2D -> (Rational,Rational) -> BinarySpacePartition a -> BinarySpacePartition a resizeSplitNth :: Direction2D -> (Rational,Rational) -> BinarySpacePartition a -> BinarySpacePartition a
resizeSplitNth _ _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP resizeSplitNth _ _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP
@ -742,9 +758,9 @@ instance LayoutClass BinarySpacePartition Window where
, fmap move (fromMessage m) , fmap move (fromMessage m)
, fmap splitShift (fromMessage m) , fmap splitShift (fromMessage m)
] ]
resize (ExpandTowards dir) = growNthTowards dir b resize (ExpandTowardsBy dir diff) = growNthTowards dir diff b
resize (ShrinkFrom dir) = shrinkNthFrom dir b resize (ShrinkFromBy dir diff) = shrinkNthFrom dir diff b
resize (MoveSplit dir) = autoSizeNth dir b resize (MoveSplitBy dir diff) = autoSizeNth dir diff b
rotate Rotate = resetFoc $ rotateNth b rotate Rotate = resetFoc $ rotateNth b
swap Swap = resetFoc $ swapNth b swap Swap = resetFoc $ swapNth b
rotateTr RotateL = resetFoc $ rotateTreeNth L b rotateTr RotateL = resetFoc $ rotateTreeNth L b