aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--XMonad/Layout/BinarySpacePartition.hs134
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"