BinarySpacePartition downstream changes

Pulled in changes from my repo for this layout on github (https://github.com/benweitzman/BinarySpacePartition) Includes a new mode for resizing windows in a more intuitive way, also contains a bug fix that was preventing users from resiving a window up. Includes changes from github users egasimus (Adam Avramov) and SolitaryCipher (Nick)
2025-07-31 04:01:51 -07:00 · 2014-11-10 20:22:59 +00:00
parent c115650d0d
commit 19860e2fa0
1 changed files with 116 additions and 18 deletions
--- a/XMonad/Layout/BinarySpacePartition.hs
+++ b/XMonad/Layout/BinarySpacePartition.hs
@@ -53,6 +53,20 @@ import Control.Monad
 -- > , ((modm,                           xK_r     ), sendMessage Rotate)
 -- > , ((modm,                           xK_s     ), sendMessage Swap)
 --
+-- Here's an alternative key mapping, this time using additionalKeysP,
+-- arrow keys, and slightly different behavior when resizing windows
+--
+-- > , ("M-M1-<Left>",    sendMessage $ ExpandTowards L)
+-- > , ("M-M1-<Right>",   sendMessage $ ShrinkFrom L)
+-- > , ("M-M1-<Up>",      sendMessage $ ExpandTowards U)
+-- > , ("M-M1-<Down>",    sendMessage $ ShrinkFrom U)
+-- > , ("M-M1-C-<Left>",  sendMessage $ ShrinkFrom R)
+-- > , ("M-M1-C-<Right>", sendMessage $ ExpandTowards R)
+-- > , ("M-M1-C-<Up>",    sendMessage $ ShrinkFrom D)
+-- > , ("M-M1-C-<Down>",  sendMessage $ ExpandTowards D)
+-- > , ("M-s",            sendMessage $ BSP.Swap)
+-- > , ("M-M1-s",         sendMessage $ Rotate) ]
+--

 -- |Message for rotating a split in the BSP. Keep in mind that this does not change the order
 -- of the windows, it will just turn a horizontal split into a verticial one and vice versa
@@ -60,7 +74,7 @@ data Rotate = Rotate deriving Typeable
 instance Message Rotate

 -- |Message for resizing one of the cells in the BSP
-data ResizeDirectional = ExpandTowards Direction2D | ShrinkFrom Direction2D deriving Typeable
+data ResizeDirectional = ExpandTowards Direction2D | ShrinkFrom Direction2D | MoveSplit Direction2D deriving Typeable
 instance Message ResizeDirectional

 -- |Message for swapping the left child of a split with the right child of split.
@@ -69,13 +83,25 @@ instance Message ResizeDirectional
 data Swap = Swap deriving Typeable
 instance Message Swap

-data Direction = Horizontal | Vertical deriving (Show, Read, Eq)
+data Axis = Horizontal | Vertical deriving (Show, Read, Eq)

-oppositeDirection :: Direction -> Direction
-oppositeDirection Vertical = Horizontal
-oppositeDirection Horizontal = Vertical
+oppositeDirection :: Direction2D -> Direction2D
+oppositeDirection U = D
+oppositeDirection D = U
+oppositeDirection L = R
+oppositeDirection R = L

-split :: Direction -> Rational -> Rectangle -> (Rectangle, Rectangle)
+oppositeAxis :: Axis -> Axis
+oppositeAxis Vertical = Horizontal
+oppositeAxis Horizontal = Vertical
+
+toAxis :: Direction2D -> Axis
+toAxis U = Horizontal
+toAxis D = Horizontal
+toAxis L = Vertical
+toAxis R = Vertical
+
+split :: Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
 split Horizontal r (Rectangle sx sy sw sh) = (r1, r2) where
    r1 = Rectangle sx sy sw sh'
    r2 = Rectangle sx (sy + fromIntegral sh') sw (sh - sh')
@@ -85,16 +111,19 @@ split Vertical r (Rectangle sx sy sw sh) = (r1, r2) where
    r2 = Rectangle (sx + fromIntegral sw') sy (sw - sw') sh
    sw' = floor $ fromIntegral sw * r

-data Split = Split { direction :: Direction
+data Split = Split { axis :: Axis
                   , ratio :: Rational
                   } deriving (Show, Read, Eq)

 oppositeSplit :: Split -> Split
-oppositeSplit (Split d r) = Split (oppositeDirection d) r
+oppositeSplit (Split d r) = Split (oppositeAxis d) r

 increaseRatio :: Split -> Rational -> Split
 increaseRatio (Split d r) delta = Split d (min 0.9 (max 0.1 (r + delta)))

+resizeDiff :: Rational
+resizeDiff = 0.05
+
 data Tree a = Leaf | Node { value :: a
                          , left :: Tree a
                          , right :: Tree a
@@ -152,7 +181,7 @@ goToNthLeaf n z@(t, _) =

 splitCurrentLeaf :: Zipper Split -> Maybe (Zipper Split)
 splitCurrentLeaf (Leaf, []) = Just (Node (Split Vertical 0.5) Leaf Leaf, [])
-splitCurrentLeaf (Leaf, crumb:cs) = Just (Node (Split (oppositeDirection . direction . parentVal $ crumb) 0.5) Leaf Leaf, crumb:cs)
+splitCurrentLeaf (Leaf, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) Leaf Leaf, crumb:cs)
 splitCurrentLeaf _ = Nothing

 removeCurrentLeaf :: Zipper a -> Maybe (Zipper a)
@@ -171,30 +200,92 @@ swapCurrentLeaf (Leaf, []) = Just (Leaf, [])
 swapCurrentLeaf (Leaf, c:cs) = Just (Leaf, swapCrumb c:cs)
 swapCurrentLeaf _ = Nothing

+isAllTheWay :: Direction2D -> Zipper Split -> Bool
+isAllTheWay _ (_, []) = True
+isAllTheWay R (_, LeftCrumb s _:_)
+  | axis s == Vertical = False
+isAllTheWay L (_, RightCrumb s _:_)
+  | axis s == Vertical = False
+isAllTheWay D (_, LeftCrumb s _:_)
+  | axis s == Horizontal = False
+isAllTheWay U (_, RightCrumb s _:_)
+  | axis s == Horizontal = False
+isAllTheWay dir z = maybe False id $ goUp z >>= Just . isAllTheWay dir
+
 expandTreeTowards :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
 expandTreeTowards _ z@(_, []) = Just z
+expandTreeTowards dir z 
+  | isAllTheWay dir z = shrinkTreeFrom (oppositeDirection dir) z
 expandTreeTowards R (t, LeftCrumb s r:cs)
-  | direction s == Vertical = Just (t, LeftCrumb (increaseRatio s 0.1) r:cs)
+  | axis s == Vertical = Just (t, LeftCrumb (increaseRatio s resizeDiff) r:cs)
 expandTreeTowards L (t, RightCrumb s l:cs)
-  | direction s == Vertical = Just (t, RightCrumb (increaseRatio s (-0.1)) l:cs)
+  | axis s == Vertical = Just (t, RightCrumb (increaseRatio s (-resizeDiff)) l:cs)
 expandTreeTowards D (t, LeftCrumb s r:cs)
-  | direction s == Horizontal = Just (t, LeftCrumb (increaseRatio s 0.1) r:cs)
+  | axis s == Horizontal = Just (t, LeftCrumb (increaseRatio s resizeDiff) r:cs)
 expandTreeTowards U (t, RightCrumb s l:cs)
-  | direction s == Horizontal = Just (t, RightCrumb (increaseRatio s (-0.1)) l:cs)
+  | axis s == Horizontal = Just (t, RightCrumb (increaseRatio s (-resizeDiff)) l:cs)
 expandTreeTowards dir z = goUp z >>= expandTreeTowards dir

 shrinkTreeFrom :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
 shrinkTreeFrom _ z@(_, []) = Just z
 shrinkTreeFrom R z@(_, LeftCrumb s _:_)
-  | direction s == Vertical = Just z >>= goSibling >>= expandTreeTowards L
+  | axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards L
 shrinkTreeFrom L z@(_, RightCrumb s _:_)
-  | direction s == Vertical = Just z >>= goSibling >>= expandTreeTowards R
+  | axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards R
 shrinkTreeFrom D z@(_, LeftCrumb s _:_)
-  | direction s == Horizontal = Just z >>= goSibling >>= expandTreeTowards U
+  | axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards U
 shrinkTreeFrom U z@(_, RightCrumb s _:_)
-  | direction s == Horizontal = Just z >>= goSibling >>= expandTreeTowards D
+  | axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards D
 shrinkTreeFrom dir z = goUp z >>= shrinkTreeFrom dir

+-- Direction2D refers to which direction the divider should move.
+autoSizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split)                          
+autoSizeTree _ z@(_, []) = Just z
+autoSizeTree d z =
+    Just z >>= getSplit (toAxis d) >>= resizeTree d
+
+-- resizing once found the correct split. YOU MUST FIND THE RIGHT SPLIT FIRST.
+resizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
+resizeTree _ z@(_, []) = Just z
+resizeTree R z@(_, LeftCrumb _ _:_) =  
+  Just z >>= expandTreeTowards R
+resizeTree L z@(_, LeftCrumb _ _:_) = 
+  Just z >>= shrinkTreeFrom    R
+resizeTree U z@(_, LeftCrumb _ _:_) = 
+  Just z >>= shrinkTreeFrom    D
+resizeTree D z@(_, LeftCrumb _ _:_) = 
+  Just z >>= expandTreeTowards D
+resizeTree R z@(_, RightCrumb _ _:_) = 
+  Just z >>= shrinkTreeFrom    L
+resizeTree L z@(_, RightCrumb _ _:_) = 
+  Just z >>= expandTreeTowards L
+resizeTree U z@(_, RightCrumb _ _:_) = 
+  Just z >>= expandTreeTowards U
+resizeTree D z@(_, RightCrumb _ _:_) = 
+  Just z >>= shrinkTreeFrom    U
+
+getSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
+getSplit _ (_, []) = Nothing
+getSplit d z =
+ do let fs = findSplit d z
+    if fs == Nothing 
+      then findClosest d z
+      else fs
+
+findClosest :: Axis -> Zipper Split -> Maybe (Zipper Split)
+findClosest _ z@(_, []) = Just z
+findClosest d z@(_, LeftCrumb s _:_)
+  | axis s == d = Just z
+findClosest d z@(_, RightCrumb s _:_)
+  | axis s == d = Just z
+findClosest d z = goUp z >>= findClosest d 
+
+findSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
+findSplit _ (_, []) = Nothing
+findSplit d z@(_, LeftCrumb s _:_)
+  | axis s == d = Just z
+findSplit d z = goUp z >>= findSplit d 
+
 top :: Zipper a -> Zipper a
 top z = case goUp z of
          Nothing -> z
@@ -234,7 +325,7 @@ rectangles (BinarySpacePartition (Just Leaf)) rootRect = [rootRect]
 rectangles (BinarySpacePartition (Just node)) rootRect =
    rectangles (makeBSP . left $ node) leftBox ++
    rectangles (makeBSP . right $ node) rightBox
-    where (leftBox, rightBox) = split (direction info) (ratio info) rootRect
+    where (leftBox, rightBox) = split (axis info) (ratio info) rootRect
          info = value node

 doToNth :: (Zipper Split -> Maybe (Zipper Split)) -> BinarySpacePartition a -> Int -> BinarySpacePartition a
@@ -269,6 +360,11 @@ shrinkNthFrom _ (BinarySpacePartition Nothing) _ = emptyBSP
 shrinkNthFrom _ b@(BinarySpacePartition (Just Leaf)) _ = b
 shrinkNthFrom dir b n = doToNth (shrinkTreeFrom dir) b n

+autoSizeNth :: Direction2D -> BinarySpacePartition a -> Int -> BinarySpacePartition a                    
+autoSizeNth _ (BinarySpacePartition Nothing) _ = emptyBSP
+autoSizeNth _ b@(BinarySpacePartition (Just Leaf)) _ = b
+autoSizeNth dir b n = doToNth (autoSizeTree dir) b n 
+
 instance LayoutClass BinarySpacePartition a where
  doLayout b r s = return (zip ws rs, layout b) where
    ws = W.integrate s
@@ -299,5 +395,7 @@ instance LayoutClass BinarySpacePartition a where
          swap Swap s = swapNth b $ index s
          resize (ExpandTowards dir) s = growNthTowards dir b $ index s
          resize (ShrinkFrom dir) s = shrinkNthFrom dir b $ index s
+          resize (MoveSplit dir) s = autoSizeNth dir b $ index s
+
  description _  = "BSP"