[xmonad] darcs patch: BinarySpacePartition downstream changes
adam vogt
vogt.adam at gmail.com
Mon Dec 22 05:17:00 UTC 2014
Applied, thanks!
On Mon, Nov 10, 2014 at 3:28 PM, <benweitzman at gmail.com> wrote:
> 1 patch for repository http://code.haskell.org/XMonadContrib:
>
> Mon Nov 10 15:22:59 EST 2014 benweitzman at 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 at 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 at haskell.org
> http://www.haskell.org/mailman/listinfo/xmonad
>
More information about the xmonad
mailing list