diff options
| -rw-r--r-- | XMonad/Layout/BinarySpacePartition.hs | 134 |
1 files changed, 116 insertions, 18 deletions
diff --git a/XMonad/Layout/BinarySpacePartition.hs b/XMonad/Layout/BinarySpacePartition.hs index e51f174..2fbf13d 100644 --- 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 :: Direction2D -> Direction2D +oppositeDirection U = D +oppositeDirection D = U +oppositeDirection L = R +oppositeDirection R = L -oppositeDirection :: Direction -> Direction -oppositeDirection Vertical = Horizontal -oppositeDirection Horizontal = Vertical +oppositeAxis :: Axis -> Axis +oppositeAxis Vertical = Horizontal +oppositeAxis Horizontal = Vertical -split :: Direction -> Rational -> Rectangle -> (Rectangle, Rectangle) +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" |