Re: [xmonad] darcs patch: BinarySpacePartition downstream changes

22 Dec 2014


      Applied, thanks!

On Mon, Nov 10, 2014 at 3:28 PM,   wrote:
...
1 patch for repository http://code.haskell.org/XMonadContrib:
Mon Nov 10 15:22:59 EST 2014  benweitzman@gmail.com
  * 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)
[BinarySpacePartition downstream changes
benweitzman@gmail.com**20141110202259
 Ignore-this: 42ecc2b07388ba0c7b3eac980256c17b
 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)
] {
hunk ./XMonad/Layout/BinarySpacePartition.hs 56
 -- > , ((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
hunk ./XMonad/Layout/BinarySpacePartition.hs 77
 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.
hunk ./XMonad/Layout/BinarySpacePartition.hs 86
 data Swap = Swap deriving Typeable
 instance Message Swap
-data Direction = Horizontal | Vertical deriving (Show, Read, Eq)
+data Axis = Horizontal | Vertical deriving (Show, Read, Eq)
hunk ./XMonad/Layout/BinarySpacePartition.hs 88
-oppositeDirection :: Direction -> Direction
-oppositeDirection Vertical = Horizontal
-oppositeDirection Horizontal = Vertical
+oppositeDirection :: Direction2D -> Direction2D
+oppositeDirection U = D
+oppositeDirection D = U
+oppositeDirection L = R
+oppositeDirection R = L
hunk ./XMonad/Layout/BinarySpacePartition.hs 94
-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')
hunk ./XMonad/Layout/BinarySpacePartition.hs 114
     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)
hunk ./XMonad/Layout/BinarySpacePartition.hs 119
 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)))
hunk ./XMonad/Layout/BinarySpacePartition.hs 124
+resizeDiff :: Rational
+resizeDiff = 0.05
+
 data Tree a = Leaf | Node { value :: a
                           , left :: Tree a
                           , right :: Tree a
hunk ./XMonad/Layout/BinarySpacePartition.hs 184
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)
hunk ./XMonad/Layout/BinarySpacePartition.hs 203
 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
hunk ./XMonad/Layout/BinarySpacePartition.hs 217
+expandTreeTowards dir z
+  | isAllTheWay dir z = shrinkTreeFrom (oppositeDirection dir) z
 expandTreeTowards R (t, LeftCrumb s r:cs)
hunk ./XMonad/Layout/BinarySpacePartition.hs 220
-  | 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)
hunk ./XMonad/Layout/BinarySpacePartition.hs 222
-  | 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)
hunk ./XMonad/Layout/BinarySpacePartition.hs 224
-  | 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)
hunk ./XMonad/Layout/BinarySpacePartition.hs 226
-  | 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)
hunk ./XMonad/Layout/BinarySpacePartition.hs 232
 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 _:_)
hunk ./XMonad/Layout/BinarySpacePartition.hs 234
-  | direction s == Vertical = Just z >>= goSibling >>= expandTreeTowards R
+  | axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards R
 shrinkTreeFrom D z@(_, LeftCrumb s _:_)
hunk ./XMonad/Layout/BinarySpacePartition.hs 236
-  | direction s == Horizontal = Just z >>= goSibling >>= expandTreeTowards U
+  | axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards U
 shrinkTreeFrom U z@(_, RightCrumb s _:_)
hunk ./XMonad/Layout/BinarySpacePartition.hs 238
-  | direction s == Horizontal = Just z >>= goSibling >>= expandTreeTowards D
+  | axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards D
 shrinkTreeFrom dir z = goUp z >>= shrinkTreeFrom dir
hunk ./XMonad/Layout/BinarySpacePartition.hs 241
+-- 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
hunk ./XMonad/Layout/BinarySpacePartition.hs 328
 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
hunk ./XMonad/Layout/BinarySpacePartition.hs 363
 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
hunk ./XMonad/Layout/BinarySpacePartition.hs 398
           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"
}
_______________________________________________
xmonad mailing list
xmonad@haskell.org
http://www.haskell.org/mailman/listinfo/xmonad

Re: [xmonad] darcs patch: BinarySpacePartition downstream changes

adam vogt