darcs patch: BinarySpacePartition downstream changes

[Ben Weitzman]

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)
 

-------------- next part --------------
A non-text attachment was scrubbed...
Name: patch-preview.txt
Type: text/x-darcs-patch
Size: 10850 bytes
Desc: Patch preview
URL: <http://www.haskell.org/pipermail/xmonad/attachments/20141110/e849a07e/attachment-0002.bin>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: binaryspacepartition-downstream-changes-.dpatch
Type: application/x-darcs-patch
Size: 34411 bytes
Desc: A darcs patch for your repository!
URL: <http://www.haskell.org/pipermail/xmonad/attachments/20141110/e849a07e/attachment-0003.bin>

[Adam Vogt]

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
>