{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.BinarySpacePartition
-- Description :  New windows split the focused window in half; based off of BSPWM.
-- Copyright   :  (c) 2013 Ben Weitzman    <benweitzman@gmail.com>
--                    2015 Anton Pirogov   <anton.pirogov@gmail.com>
--                    2019 Mateusz Karbowy <obszczymucha@gmail.com
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Ben Weitzman <benweitzman@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Layout where new windows will split the focused window in half, based off of BSPWM
--
-----------------------------------------------------------------------------

module XMonad.Layout.BinarySpacePartition (
  -- * Usage
  -- $usage
    emptyBSP
  , BinarySpacePartition
  , Rotate(..)
  , Swap(..)
  , ResizeDirectional(.., ExpandTowards, ShrinkFrom, MoveSplit)
  , TreeRotate(..)
  , TreeBalance(..)
  , FocusParent(..)
  , SelectMoveNode(..)
  , Direction2D(..)
  , SplitShiftDirectional(..)
  ) where

import XMonad
import XMonad.Prelude hiding (insert)
import qualified XMonad.StackSet as W
import XMonad.Hooks.ManageHelpers (isMinimized)
import XMonad.Util.Stack hiding (Zipper)
import XMonad.Util.Types

-- for mouse resizing
import XMonad.Layout.WindowArranger (WindowArrangerMsg(SetGeometry))
-- for "focus parent" node border
import XMonad.Util.XUtils

import qualified Data.Map as M
import qualified Data.Set as S
import Data.Ratio ((%))

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.BinarySpacePartition
--
-- Then add the layout, using the default BSP (BinarySpacePartition)
--
-- > myLayout = emptyBSP ||| etc ..
--
-- It may be a good idea to use "XMonad.Actions.Navigation2D" to move between the windows.
--
-- This layout responds to SetGeometry and is compatible with e.g. "XMonad.Actions.MouseResize"
-- or "XMonad.Layout.BorderResize". You should probably try both to decide which is better for you,
-- if you want to be able to resize the splits with the mouse.
--
-- If you don't want to use the mouse, add the following key bindings to resize the splits with the keyboard:
--
-- > , ((modm .|. altMask,                 xK_l     ), sendMessage $ ExpandTowards R)
-- > , ((modm .|. altMask,                 xK_h     ), sendMessage $ ExpandTowards L)
-- > , ((modm .|. altMask,                 xK_j     ), sendMessage $ ExpandTowards D)
-- > , ((modm .|. altMask,                 xK_k     ), sendMessage $ ExpandTowards U)
-- > , ((modm .|. altMask .|. ctrlMask ,   xK_l     ), sendMessage $ ShrinkFrom R)
-- > , ((modm .|. altMask .|. ctrlMask ,   xK_h     ), sendMessage $ ShrinkFrom L)
-- > , ((modm .|. altMask .|. ctrlMask ,   xK_j     ), sendMessage $ ShrinkFrom D)
-- > , ((modm .|. altMask .|. ctrlMask ,   xK_k     ), sendMessage $ ShrinkFrom U)
-- > , ((modm,                             xK_r     ), sendMessage Rotate)
-- > , ((modm,                             xK_s     ), sendMessage Swap)
-- > , ((modm,                             xK_n     ), sendMessage FocusParent)
-- > , ((modm .|. ctrlMask,                xK_n     ), sendMessage SelectNode)
-- > , ((modm .|. shiftMask,               xK_n     ), sendMessage MoveNode)
-- > , ((modm .|. shiftMask .|. ctrlMask , xK_j     ), sendMessage $ SplitShift Prev)
-- > , ((modm .|. shiftMask .|. ctrlMask , xK_k     ), sendMessage $ SplitShift Next)
--
-- 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 $ Swap)
-- > , ("M-M1-s",         sendMessage $ Rotate)
-- > , ("M-S-C-j",        sendMessage $ SplitShift Prev)
-- > , ("M-S-C-k",        sendMessage $ SplitShift Next)
--
-- Note that @ExpandTowards x@, @ShrinkFrom x@, and @MoveSplit x@ are
-- the same as respectively @ExpandTowardsBy x 0.05@, @ShrinkFromBy x 0.05@
-- and @MoveSplitBy x 0.05@.
--
-- If you have many windows open and the layout begins to look too hard to manage, you can 'Balance'
-- the layout, so that the current splittings are discarded and windows are tiled freshly in a way that
-- the split depth is minimized. You can combine this with 'Equalize', which does not change your tree,
-- but tunes the split ratios in a way that each window gets the same amount of space:
--
-- > , ((myModMask,               xK_a),     sendMessage Balance)
-- > , ((myModMask .|. shiftMask, xK_a),     sendMessage Equalize)
--

-- | Message for rotating the binary tree around the parent node of the window to the left or right
data TreeRotate = RotateL | RotateR
instance Message TreeRotate

-- | Message to balance the tree in some way (Balance retiles the windows, Equalize changes ratios)
data TreeBalance = Balance | Equalize
instance Message TreeBalance

-- | Message for resizing one of the cells in the BSP
data ResizeDirectional =
        ExpandTowardsBy Direction2D Rational
      | ShrinkFromBy Direction2D Rational
      | MoveSplitBy Direction2D Rational
instance Message ResizeDirectional

-- | @ExpandTowards x@ is now the equivalent of @ExpandTowardsBy x 0.05@
pattern ExpandTowards :: Direction2D -> ResizeDirectional
pattern $bExpandTowards :: Direction2D -> ResizeDirectional
$mExpandTowards :: forall {r}.
ResizeDirectional -> (Direction2D -> r) -> ((# #) -> r) -> r
ExpandTowards d = ExpandTowardsBy d 0.05

-- | @ShrinkFrom x@ is now the equivalent of @ShrinkFromBy x 0.05@
pattern ShrinkFrom :: Direction2D -> ResizeDirectional
pattern $bShrinkFrom :: Direction2D -> ResizeDirectional
$mShrinkFrom :: forall {r}.
ResizeDirectional -> (Direction2D -> r) -> ((# #) -> r) -> r
ShrinkFrom d = ShrinkFromBy d 0.05

-- | @MoveSplit x@ is now the equivalent of @MoveSplitBy x 0.05@
pattern MoveSplit :: Direction2D -> ResizeDirectional
pattern $bMoveSplit :: Direction2D -> ResizeDirectional
$mMoveSplit :: forall {r}.
ResizeDirectional -> (Direction2D -> r) -> ((# #) -> r) -> r
MoveSplit d = MoveSplitBy d 0.05

-- | Message for rotating a split (horizontal/vertical) in the BSP
data Rotate = Rotate
instance Message Rotate

-- | Message for swapping the left child of a split with the right child of split
data Swap = Swap
instance Message Swap

-- | Message to cyclically select the parent node instead of the leaf
data FocusParent = FocusParent
instance Message FocusParent

-- | Message to move nodes inside the tree
data SelectMoveNode = SelectNode | MoveNode
instance Message SelectMoveNode

data Axis = Horizontal | Vertical deriving (Int -> Axis -> ShowS
[Axis] -> ShowS
Axis -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Axis] -> ShowS
$cshowList :: [Axis] -> ShowS
show :: Axis -> String
$cshow :: Axis -> String
showsPrec :: Int -> Axis -> ShowS
$cshowsPrec :: Int -> Axis -> ShowS
Show, ReadPrec [Axis]
ReadPrec Axis
Int -> ReadS Axis
ReadS [Axis]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Axis]
$creadListPrec :: ReadPrec [Axis]
readPrec :: ReadPrec Axis
$creadPrec :: ReadPrec Axis
readList :: ReadS [Axis]
$creadList :: ReadS [Axis]
readsPrec :: Int -> ReadS Axis
$creadsPrec :: Int -> ReadS Axis
Read, Axis -> Axis -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Axis -> Axis -> Bool
$c/= :: Axis -> Axis -> Bool
== :: Axis -> Axis -> Bool
$c== :: Axis -> Axis -> Bool
Eq)

-- | Message for shifting window by splitting its neighbour
newtype SplitShiftDirectional = SplitShift Direction1D
instance Message SplitShiftDirectional

oppositeDirection :: Direction2D -> Direction2D
oppositeDirection :: Direction2D -> Direction2D
oppositeDirection Direction2D
U = Direction2D
D
oppositeDirection Direction2D
D = Direction2D
U
oppositeDirection Direction2D
L = Direction2D
R
oppositeDirection Direction2D
R = Direction2D
L

oppositeAxis :: Axis -> Axis
oppositeAxis :: Axis -> Axis
oppositeAxis Axis
Vertical = Axis
Horizontal
oppositeAxis Axis
Horizontal = Axis
Vertical

toAxis :: Direction2D -> Axis
toAxis :: Direction2D -> Axis
toAxis Direction2D
U = Axis
Horizontal
toAxis Direction2D
D = Axis
Horizontal
toAxis Direction2D
L = Axis
Vertical
toAxis Direction2D
R = Axis
Vertical

split :: Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split :: Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split Axis
Horizontal Rational
r (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = (Rectangle
r1, Rectangle
r2) where
    r1 :: Rectangle
r1 = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
sw Dimension
sh'
    r2 :: Rectangle
r2 = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx (Position
sy forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh') Dimension
sw (Dimension
sh forall a. Num a => a -> a -> a
- Dimension
sh')
    sh' :: Dimension
sh' = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh forall a. Num a => a -> a -> a
* Rational
r
split Axis
Vertical Rational
r (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = (Rectangle
r1, Rectangle
r2) where
    r1 :: Rectangle
r1 = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
sw' Dimension
sh
    r2 :: Rectangle
r2 = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw') Position
sy (Dimension
sw forall a. Num a => a -> a -> a
- Dimension
sw') Dimension
sh
    sw' :: Dimension
sw' = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw forall a. Num a => a -> a -> a
* Rational
r

data Split = Split { Split -> Axis
axis :: Axis
                   , Split -> Rational
ratio :: Rational
                   } deriving (Int -> Split -> ShowS
[Split] -> ShowS
Split -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Split] -> ShowS
$cshowList :: [Split] -> ShowS
show :: Split -> String
$cshow :: Split -> String
showsPrec :: Int -> Split -> ShowS
$cshowsPrec :: Int -> Split -> ShowS
Show, ReadPrec [Split]
ReadPrec Split
Int -> ReadS Split
ReadS [Split]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Split]
$creadListPrec :: ReadPrec [Split]
readPrec :: ReadPrec Split
$creadPrec :: ReadPrec Split
readList :: ReadS [Split]
$creadList :: ReadS [Split]
readsPrec :: Int -> ReadS Split
$creadsPrec :: Int -> ReadS Split
Read, Split -> Split -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Split -> Split -> Bool
$c/= :: Split -> Split -> Bool
== :: Split -> Split -> Bool
$c== :: Split -> Split -> Bool
Eq)

oppositeSplit :: Split -> Split
oppositeSplit :: Split -> Split
oppositeSplit (Split Axis
d Rational
r) = Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis Axis
d) Rational
r

increaseRatio :: Split -> Rational -> Split
increaseRatio :: Split -> Rational -> Split
increaseRatio (Split Axis
d Rational
r) Rational
delta = Axis -> Rational -> Split
Split Axis
d (forall a. Ord a => a -> a -> a
min Rational
0.9 (forall a. Ord a => a -> a -> a
max Rational
0.1 (Rational
r forall a. Num a => a -> a -> a
+ Rational
delta)))

data Tree a = Leaf Int | Node { forall a. Tree a -> a
value :: a
                          , forall a. Tree a -> Tree a
left :: Tree a
                          , forall a. Tree a -> Tree a
right :: Tree a
                          } deriving (Int -> Tree a -> ShowS
forall a. Show a => Int -> Tree a -> ShowS
forall a. Show a => [Tree a] -> ShowS
forall a. Show a => Tree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree a] -> ShowS
$cshowList :: forall a. Show a => [Tree a] -> ShowS
show :: Tree a -> String
$cshow :: forall a. Show a => Tree a -> String
showsPrec :: Int -> Tree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Tree a -> ShowS
Show, ReadPrec [Tree a]
ReadPrec (Tree a)
ReadS [Tree a]
forall a. Read a => ReadPrec [Tree a]
forall a. Read a => ReadPrec (Tree a)
forall a. Read a => Int -> ReadS (Tree a)
forall a. Read a => ReadS [Tree a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tree a]
$creadListPrec :: forall a. Read a => ReadPrec [Tree a]
readPrec :: ReadPrec (Tree a)
$creadPrec :: forall a. Read a => ReadPrec (Tree a)
readList :: ReadS [Tree a]
$creadList :: forall a. Read a => ReadS [Tree a]
readsPrec :: Int -> ReadS (Tree a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Tree a)
Read, Tree a -> Tree a -> Bool
forall a. Eq a => Tree a -> Tree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tree a -> Tree a -> Bool
$c/= :: forall a. Eq a => Tree a -> Tree a -> Bool
== :: Tree a -> Tree a -> Bool
$c== :: forall a. Eq a => Tree a -> Tree a -> Bool
Eq)

numLeaves :: Tree a -> Int
numLeaves :: forall a. Tree a -> Int
numLeaves (Leaf Int
_) = Int
1
numLeaves (Node a
_ Tree a
l Tree a
r) = forall a. Tree a -> Int
numLeaves Tree a
l forall a. Num a => a -> a -> a
+ forall a. Tree a -> Int
numLeaves Tree a
r

-- right or left rotation of a (sub)tree, no effect if rotation not possible
rotTree :: Direction2D -> Tree a -> Tree a
rotTree :: forall a. Direction2D -> Tree a -> Tree a
rotTree Direction2D
_ (Leaf Int
n) = forall a. Int -> Tree a
Leaf Int
n
rotTree Direction2D
R n :: Tree a
n@(Node a
_ (Leaf Int
_) Tree a
_) = Tree a
n
rotTree Direction2D
L n :: Tree a
n@(Node a
_ Tree a
_ (Leaf Int
_)) = Tree a
n
rotTree Direction2D
R (Node a
sp (Node a
sp2 Tree a
l2 Tree a
r2) Tree a
r) = forall a. a -> Tree a -> Tree a -> Tree a
Node a
sp2 Tree a
l2 (forall a. a -> Tree a -> Tree a -> Tree a
Node a
sp Tree a
r2 Tree a
r)
rotTree Direction2D
L (Node a
sp Tree a
l (Node a
sp2 Tree a
l2 Tree a
r2)) = forall a. a -> Tree a -> Tree a -> Tree a
Node a
sp2 (forall a. a -> Tree a -> Tree a -> Tree a
Node a
sp Tree a
l Tree a
l2) Tree a
r2
rotTree Direction2D
_ Tree a
t = Tree a
t


data Crumb a = LeftCrumb a (Tree a) | RightCrumb a (Tree a) deriving (Int -> Crumb a -> ShowS
forall a. Show a => Int -> Crumb a -> ShowS
forall a. Show a => [Crumb a] -> ShowS
forall a. Show a => Crumb a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Crumb a] -> ShowS
$cshowList :: forall a. Show a => [Crumb a] -> ShowS
show :: Crumb a -> String
$cshow :: forall a. Show a => Crumb a -> String
showsPrec :: Int -> Crumb a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Crumb a -> ShowS
Show, ReadPrec [Crumb a]
ReadPrec (Crumb a)
ReadS [Crumb a]
forall a. Read a => ReadPrec [Crumb a]
forall a. Read a => ReadPrec (Crumb a)
forall a. Read a => Int -> ReadS (Crumb a)
forall a. Read a => ReadS [Crumb a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Crumb a]
$creadListPrec :: forall a. Read a => ReadPrec [Crumb a]
readPrec :: ReadPrec (Crumb a)
$creadPrec :: forall a. Read a => ReadPrec (Crumb a)
readList :: ReadS [Crumb a]
$creadList :: forall a. Read a => ReadS [Crumb a]
readsPrec :: Int -> ReadS (Crumb a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Crumb a)
Read, Crumb a -> Crumb a -> Bool
forall a. Eq a => Crumb a -> Crumb a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Crumb a -> Crumb a -> Bool
$c/= :: forall a. Eq a => Crumb a -> Crumb a -> Bool
== :: Crumb a -> Crumb a -> Bool
$c== :: forall a. Eq a => Crumb a -> Crumb a -> Bool
Eq)

swapCrumb :: Crumb a -> Crumb a
swapCrumb :: forall a. Crumb a -> Crumb a
swapCrumb (LeftCrumb a
s Tree a
t) = forall a. a -> Tree a -> Crumb a
RightCrumb a
s Tree a
t
swapCrumb (RightCrumb a
s Tree a
t) = forall a. a -> Tree a -> Crumb a
LeftCrumb a
s Tree a
t

parentVal :: Crumb a -> a
parentVal :: forall a. Crumb a -> a
parentVal (LeftCrumb a
s Tree a
_) = a
s
parentVal (RightCrumb a
s Tree a
_) = a
s

modifyParentVal :: (a -> a) -> Crumb a -> Crumb a
modifyParentVal :: forall a. (a -> a) -> Crumb a -> Crumb a
modifyParentVal a -> a
f (LeftCrumb a
s Tree a
t) = forall a. a -> Tree a -> Crumb a
LeftCrumb (a -> a
f a
s) Tree a
t
modifyParentVal a -> a
f (RightCrumb a
s Tree a
t) = forall a. a -> Tree a -> Crumb a
RightCrumb (a -> a
f a
s) Tree a
t

type Zipper a = (Tree a, [Crumb a])

toZipper :: Tree a -> Zipper a
toZipper :: forall a. Tree a -> Zipper a
toZipper Tree a
t = (Tree a
t, [])

goLeft :: Zipper a -> Maybe (Zipper a)
goLeft :: forall a. Zipper a -> Maybe (Zipper a)
goLeft (Leaf Int
_, [Crumb a]
_) = forall a. Maybe a
Nothing
goLeft (Node a
x Tree a
l Tree a
r, [Crumb a]
bs) = forall a. a -> Maybe a
Just (Tree a
l, forall a. a -> Tree a -> Crumb a
LeftCrumb a
x Tree a
rforall a. a -> [a] -> [a]
:[Crumb a]
bs)

goRight :: Zipper a -> Maybe (Zipper a)
goRight :: forall a. Zipper a -> Maybe (Zipper a)
goRight (Leaf Int
_, [Crumb a]
_) = forall a. Maybe a
Nothing
goRight (Node a
x Tree a
l Tree a
r, [Crumb a]
bs) = forall a. a -> Maybe a
Just (Tree a
r, forall a. a -> Tree a -> Crumb a
RightCrumb a
x Tree a
lforall a. a -> [a] -> [a]
:[Crumb a]
bs)

goUp :: Zipper a -> Maybe (Zipper a)
goUp :: forall a. Zipper a -> Maybe (Zipper a)
goUp (Tree a
_, []) = forall a. Maybe a
Nothing
goUp (Tree a
t, LeftCrumb a
x Tree a
r:[Crumb a]
cs) = forall a. a -> Maybe a
Just (forall a. a -> Tree a -> Tree a -> Tree a
Node a
x Tree a
t Tree a
r, [Crumb a]
cs)
goUp (Tree a
t, RightCrumb a
x Tree a
l:[Crumb a]
cs) = forall a. a -> Maybe a
Just (forall a. a -> Tree a -> Tree a -> Tree a
Node a
x Tree a
l Tree a
t, [Crumb a]
cs)

goSibling :: Zipper a -> Maybe (Zipper a)
goSibling :: forall a. Zipper a -> Maybe (Zipper a)
goSibling (Tree a
_, []) = forall a. Maybe a
Nothing
goSibling z :: (Tree a, [Crumb a])
z@(Tree a
_, LeftCrumb a
_ Tree a
_:[Crumb a]
_) = forall a. a -> Maybe a
Just (Tree a, [Crumb a])
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Zipper a -> Maybe (Zipper a)
goUp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Zipper a -> Maybe (Zipper a)
goRight
goSibling z :: (Tree a, [Crumb a])
z@(Tree a
_, RightCrumb a
_ Tree a
_:[Crumb a]
_) = forall a. a -> Maybe a
Just (Tree a, [Crumb a])
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Zipper a -> Maybe (Zipper a)
goUp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Zipper a -> Maybe (Zipper a)
goLeft

top :: Zipper a -> Zipper a
top :: forall a. Zipper a -> Zipper a
top Zipper a
z = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Zipper a
z forall a. Zipper a -> Zipper a
top (forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper a
z)

toTree :: Zipper a -> Tree a
toTree :: forall a. Zipper a -> Tree a
toTree = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Zipper a -> Zipper a
top

goToNthLeaf :: Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf :: forall a. Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf Int
_ z :: Zipper a
z@(Leaf Int
_, [Crumb a]
_) = forall a. a -> Maybe a
Just Zipper a
z
goToNthLeaf Int
n z :: Zipper a
z@(Tree a
t, [Crumb a]
_) =
  if forall a. Tree a -> Int
numLeaves (forall a. Tree a -> Tree a
left Tree a
t) forall a. Ord a => a -> a -> Bool
> Int
n
  then do Zipper a
z' <- forall a. Zipper a -> Maybe (Zipper a)
goLeft Zipper a
z
          forall a. Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf Int
n Zipper a
z'
  else do Zipper a
z' <- forall a. Zipper a -> Maybe (Zipper a)
goRight Zipper a
z
          forall a. Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf (Int
n forall a. Num a => a -> a -> a
- (forall a. Tree a -> Int
numLeaves forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> Tree a
left forall a b. (a -> b) -> a -> b
$ Tree a
t)) Zipper a
z'

toggleSplits :: Tree Split -> Tree Split
toggleSplits :: Tree Split -> Tree Split
toggleSplits (Leaf Int
l) = forall a. Int -> Tree a
Leaf Int
l
toggleSplits (Node Split
s Tree Split
l Tree Split
r) = forall a. a -> Tree a -> Tree a -> Tree a
Node (Split -> Split
oppositeSplit Split
s) (Tree Split -> Tree Split
toggleSplits Tree Split
l) (Tree Split -> Tree Split
toggleSplits Tree Split
r)

splitCurrent :: Zipper Split -> Maybe (Zipper Split)
splitCurrent :: Zipper Split -> Maybe (Zipper Split)
splitCurrent (Leaf Int
_, []) = forall a. a -> Maybe a
Just (forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Vertical Rational
0.5) (forall a. Int -> Tree a
Leaf Int
0) (forall a. Int -> Tree a
Leaf Int
0), [])
splitCurrent (Leaf Int
_, Crumb Split
crumb:[Crumb Split]
cs) = forall a. a -> Maybe a
Just (forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Crumb a -> a
parentVal forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) Rational
0.5) (forall a. Int -> Tree a
Leaf Int
0) (forall a. Int -> Tree a
Leaf Int
0), Crumb Split
crumbforall a. a -> [a] -> [a]
:[Crumb Split]
cs)
splitCurrent (Tree Split
n, []) = forall a. a -> Maybe a
Just (forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Vertical Rational
0.5) (forall a. Int -> Tree a
Leaf Int
0) (Tree Split -> Tree Split
toggleSplits Tree Split
n), [])
splitCurrent (Tree Split
n, Crumb Split
crumb:[Crumb Split]
cs) = forall a. a -> Maybe a
Just (forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Crumb a -> a
parentVal forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) Rational
0.5) (forall a. Int -> Tree a
Leaf Int
0) (Tree Split -> Tree Split
toggleSplits Tree Split
n), Crumb Split
crumbforall a. a -> [a] -> [a]
:[Crumb Split]
cs)

removeCurrent :: Zipper a -> Maybe (Zipper a)
removeCurrent :: forall a. Zipper a -> Maybe (Zipper a)
removeCurrent (Leaf Int
_, LeftCrumb a
_ Tree a
r:[Crumb a]
cs) = forall a. a -> Maybe a
Just (Tree a
r, [Crumb a]
cs)
removeCurrent (Leaf Int
_, RightCrumb a
_ Tree a
l:[Crumb a]
cs) = forall a. a -> Maybe a
Just (Tree a
l, [Crumb a]
cs)
removeCurrent (Leaf Int
_, []) = forall a. Maybe a
Nothing
removeCurrent (Node a
_ (Leaf Int
_) r :: Tree a
r@Node{}, [Crumb a]
cs) = forall a. a -> Maybe a
Just (Tree a
r, [Crumb a]
cs)
removeCurrent (Node a
_ l :: Tree a
l@Node{} (Leaf Int
_), [Crumb a]
cs) = forall a. a -> Maybe a
Just (Tree a
l, [Crumb a]
cs)
removeCurrent (Node a
_ (Leaf Int
_) (Leaf Int
_), [Crumb a]
cs) = forall a. a -> Maybe a
Just (forall a. Int -> Tree a
Leaf Int
0, [Crumb a]
cs)
removeCurrent z :: (Tree a, [Crumb a])
z@(Node{}, [Crumb a]
_) = forall a. Zipper a -> Maybe (Zipper a)
goLeft (Tree a, [Crumb a])
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Zipper a -> Maybe (Zipper a)
removeCurrent

rotateCurrent :: Zipper Split -> Maybe (Zipper Split)
rotateCurrent :: Zipper Split -> Maybe (Zipper Split)
rotateCurrent l :: Zipper Split
l@(Tree Split
_, []) = forall a. a -> Maybe a
Just Zipper Split
l
rotateCurrent (Tree Split
n, Crumb Split
c:[Crumb Split]
cs) = forall a. a -> Maybe a
Just (Tree Split
n, forall a. (a -> a) -> Crumb a -> Crumb a
modifyParentVal Split -> Split
oppositeSplit Crumb Split
cforall a. a -> [a] -> [a]
:[Crumb Split]
cs)

swapCurrent :: Zipper a -> Maybe (Zipper a)
swapCurrent :: forall a. Zipper a -> Maybe (Zipper a)
swapCurrent l :: Zipper a
l@(Tree a
_, []) = forall a. a -> Maybe a
Just Zipper a
l
swapCurrent (Tree a
n, Crumb a
c:[Crumb a]
cs) = forall a. a -> Maybe a
Just (Tree a
n, forall a. Crumb a -> Crumb a
swapCrumb Crumb a
cforall a. a -> [a] -> [a]
:[Crumb a]
cs)

insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertLeftLeaf (Leaf Int
n) (Node Split
x Tree Split
l Tree Split
r, Crumb Split
crumb:[Crumb Split]
cs) = forall a. a -> Maybe a
Just (forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Crumb a -> a
parentVal forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) Rational
0.5) (forall a. Int -> Tree a
Leaf Int
n) (forall a. a -> Tree a -> Tree a -> Tree a
Node Split
x Tree Split
l Tree Split
r), Crumb Split
crumbforall a. a -> [a] -> [a]
:[Crumb Split]
cs)
insertLeftLeaf (Leaf Int
n) (Leaf Int
x, Crumb Split
crumb:[Crumb Split]
cs) = forall a. a -> Maybe a
Just (forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Crumb a -> a
parentVal forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) Rational
0.5) (forall a. Int -> Tree a
Leaf Int
n) (forall a. Int -> Tree a
Leaf Int
x), Crumb Split
crumbforall a. a -> [a] -> [a]
:[Crumb Split]
cs)
insertLeftLeaf Node{} Zipper Split
z = forall a. a -> Maybe a
Just Zipper Split
z
insertLeftLeaf Tree Split
_ Zipper Split
_ = forall a. Maybe a
Nothing

insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertRightLeaf (Leaf Int
n) (Node Split
x Tree Split
l Tree Split
r, Crumb Split
crumb:[Crumb Split]
cs) = forall a. a -> Maybe a
Just (forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Crumb a -> a
parentVal forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) Rational
0.5) (forall a. a -> Tree a -> Tree a -> Tree a
Node Split
x Tree Split
l Tree Split
r) (forall a. Int -> Tree a
Leaf Int
n), Crumb Split
crumbforall a. a -> [a] -> [a]
:[Crumb Split]
cs)
insertRightLeaf (Leaf Int
n) (Leaf Int
x, Crumb Split
crumb:[Crumb Split]
cs) = forall a. a -> Maybe a
Just (forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Crumb a -> a
parentVal forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) Rational
0.5) (forall a. Int -> Tree a
Leaf Int
x) (forall a. Int -> Tree a
Leaf Int
n), Crumb Split
crumbforall a. a -> [a] -> [a]
:[Crumb Split]
cs)
insertRightLeaf Node{} Zipper Split
z = forall a. a -> Maybe a
Just Zipper Split
z
insertRightLeaf Tree Split
_ Zipper Split
_ = forall a. Maybe a
Nothing

findRightLeaf :: Zipper Split -> Maybe (Zipper Split)
findRightLeaf :: Zipper Split -> Maybe (Zipper Split)
findRightLeaf n :: Zipper Split
n@(Node{}, [Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
goRight Zipper Split
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findRightLeaf
findRightLeaf l :: Zipper Split
l@(Leaf Int
_, [Crumb Split]
_) = forall a. a -> Maybe a
Just Zipper Split
l

findLeftLeaf :: Zipper Split -> Maybe (Zipper Split)
findLeftLeaf :: Zipper Split -> Maybe (Zipper Split)
findLeftLeaf n :: Zipper Split
n@(Node{}, [Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
goLeft Zipper Split
n
findLeftLeaf l :: Zipper Split
l@(Leaf Int
_, [Crumb Split]
_) = forall a. a -> Maybe a
Just Zipper Split
l

findTheClosestLeftmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestLeftmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestLeftmostLeaf s :: Zipper Split
s@(Tree Split
_, (RightCrumb Split
_ Tree Split
_):[Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Zipper a -> Maybe (Zipper a)
goLeft forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findRightLeaf
findTheClosestLeftmostLeaf s :: Zipper Split
s@(Tree Split
_, (LeftCrumb Split
_ Tree Split
_):[Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findTheClosestLeftmostLeaf
findTheClosestLeftmostLeaf Zipper Split
_ = forall a. Maybe a
Nothing

findTheClosestRightmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf s :: Zipper Split
s@(Tree Split
_, (RightCrumb Split
_ Tree Split
_):[Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf
findTheClosestRightmostLeaf s :: Zipper Split
s@(Tree Split
_, (LeftCrumb Split
_ Tree Split
_):[Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Zipper a -> Maybe (Zipper a)
goRight forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findLeftLeaf
findTheClosestRightmostLeaf Zipper Split
_ = forall a. Maybe a
Nothing

splitShiftLeftCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftLeftCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftLeftCurrent l :: Zipper Split
l@(Tree Split
_, []) = forall a. a -> Maybe a
Just Zipper Split
l
splitShiftLeftCurrent l :: Zipper Split
l@(Tree Split
_, (RightCrumb Split
_ Tree Split
_):[Crumb Split]
_) = forall a. a -> Maybe a
Just Zipper Split
l -- Do nothing. We can swap windows instead.
splitShiftLeftCurrent l :: Zipper Split
l@(Tree Split
n, [Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
removeCurrent Zipper Split
l forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findTheClosestLeftmostLeaf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertRightLeaf Tree Split
n

splitShiftRightCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftRightCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftRightCurrent l :: Zipper Split
l@(Tree Split
_, []) = forall a. a -> Maybe a
Just Zipper Split
l
splitShiftRightCurrent l :: Zipper Split
l@(Tree Split
_, (LeftCrumb Split
_ Tree Split
_):[Crumb Split]
_) = forall a. a -> Maybe a
Just Zipper Split
l -- Do nothing. We can swap windows instead.
splitShiftRightCurrent l :: Zipper Split
l@(Tree Split
n, [Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
removeCurrent Zipper Split
l forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertLeftLeaf Tree Split
n

isAllTheWay :: Direction2D -> Rational -> Zipper Split -> Bool
isAllTheWay :: Direction2D -> Rational -> Zipper Split -> Bool
isAllTheWay Direction2D
_ Rational
_ (Tree Split
_, []) = Bool
True
isAllTheWay Direction2D
R Rational
_ (Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Bool
False
isAllTheWay Direction2D
L Rational
_ (Tree Split
_, RightCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Bool
False
isAllTheWay Direction2D
D Rational
_ (Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Bool
False
isAllTheWay Direction2D
U Rational
_ (Tree Split
_, RightCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Bool
False
isAllTheWay Direction2D
dir Rational
diff Zipper Split
z = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction2D -> Rational -> Zipper Split -> Bool
isAllTheWay Direction2D
dir Rational
diff

expandTreeTowards :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
_ Rational
_ z :: Zipper Split
z@(Tree Split
_, []) = forall a. a -> Maybe a
Just Zipper Split
z
expandTreeTowards Direction2D
dir Rational
diff Zipper Split
z
  | Direction2D -> Rational -> Zipper Split -> Bool
isAllTheWay Direction2D
dir Rational
diff Zipper Split
z = Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom (Direction2D -> Direction2D
oppositeDirection Direction2D
dir) Rational
diff Zipper Split
z
expandTreeTowards Direction2D
R Rational
diff (Tree Split
t, LeftCrumb Split
s Tree Split
r:[Crumb Split]
cs)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
Vertical = forall a. a -> Maybe a
Just (Tree Split
t, forall a. a -> Tree a -> Crumb a
LeftCrumb (Split -> Rational -> Split
increaseRatio Split
s Rational
diff) Tree Split
rforall a. a -> [a] -> [a]
:[Crumb Split]
cs)
expandTreeTowards Direction2D
L Rational
diff (Tree Split
t, RightCrumb Split
s Tree Split
l:[Crumb Split]
cs)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
Vertical = forall a. a -> Maybe a
Just (Tree Split
t, forall a. a -> Tree a -> Crumb a
RightCrumb (Split -> Rational -> Split
increaseRatio Split
s (-Rational
diff)) Tree Split
lforall a. a -> [a] -> [a]
:[Crumb Split]
cs)
expandTreeTowards Direction2D
D Rational
diff (Tree Split
t, LeftCrumb Split
s Tree Split
r:[Crumb Split]
cs)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = forall a. a -> Maybe a
Just (Tree Split
t, forall a. a -> Tree a -> Crumb a
LeftCrumb (Split -> Rational -> Split
increaseRatio Split
s Rational
diff) Tree Split
rforall a. a -> [a] -> [a]
:[Crumb Split]
cs)
expandTreeTowards Direction2D
U Rational
diff (Tree Split
t, RightCrumb Split
s Tree Split
l:[Crumb Split]
cs)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = forall a. a -> Maybe a
Just (Tree Split
t, forall a. a -> Tree a -> Crumb a
RightCrumb (Split -> Rational -> Split
increaseRatio Split
s (-Rational
diff)) Tree Split
lforall a. a -> [a] -> [a]
:[Crumb Split]
cs)
expandTreeTowards Direction2D
dir Rational
diff Zipper Split
z = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
dir Rational
diff

shrinkTreeFrom :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom Direction2D
_ Rational
_ z :: Zipper Split
z@(Tree Split
_, []) = forall a. a -> Maybe a
Just Zipper Split
z
shrinkTreeFrom Direction2D
R Rational
diff z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
Vertical = forall a. a -> Maybe a
Just Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Zipper a -> Maybe (Zipper a)
goSibling forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
L Rational
diff
shrinkTreeFrom Direction2D
L Rational
diff z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
Vertical = forall a. a -> Maybe a
Just Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Zipper a -> Maybe (Zipper a)
goSibling forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
R Rational
diff
shrinkTreeFrom Direction2D
D Rational
diff z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = forall a. a -> Maybe a
Just Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Zipper a -> Maybe (Zipper a)
goSibling forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
U Rational
diff
shrinkTreeFrom Direction2D
U Rational
diff z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = forall a. a -> Maybe a
Just Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Zipper a -> Maybe (Zipper a)
goSibling forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
D Rational
diff
shrinkTreeFrom Direction2D
dir Rational
diff Zipper Split
z = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom Direction2D
dir Rational
diff

-- Direction2D refers to which direction the divider should move.
autoSizeTree :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
autoSizeTree :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
autoSizeTree Direction2D
_ Rational
_ z :: Zipper Split
z@(Tree Split
_, []) = forall a. a -> Maybe a
Just Zipper Split
z
autoSizeTree Direction2D
d Rational
f Zipper Split
z =
    forall a. a -> Maybe a
Just Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Axis -> Zipper Split -> Maybe (Zipper Split)
getSplit (Direction2D -> Axis
toAxis Direction2D
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
resizeTree Direction2D
d Rational
f

-- resizing once found the correct split. YOU MUST FIND THE RIGHT SPLIT FIRST.
resizeTree :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
resizeTree :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
resizeTree Direction2D
_ Rational
_ z :: Zipper Split
z@(Tree Split
_, []) = forall a. a -> Maybe a
Just Zipper Split
z
resizeTree Direction2D
R Rational
diff z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  forall a. a -> Maybe a
Just Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
R Rational
diff
resizeTree Direction2D
L Rational
diff z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  forall a. a -> Maybe a
Just Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom    Direction2D
R Rational
diff
resizeTree Direction2D
U Rational
diff z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  forall a. a -> Maybe a
Just Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom    Direction2D
D Rational
diff
resizeTree Direction2D
D Rational
diff z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  forall a. a -> Maybe a
Just Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
D Rational
diff
resizeTree Direction2D
R Rational
diff z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  forall a. a -> Maybe a
Just Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom    Direction2D
L Rational
diff
resizeTree Direction2D
L Rational
diff z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  forall a. a -> Maybe a
Just Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
L Rational
diff
resizeTree Direction2D
U Rational
diff z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  forall a. a -> Maybe a
Just Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
U Rational
diff
resizeTree Direction2D
D Rational
diff z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  forall a. a -> Maybe a
Just Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom    Direction2D
U Rational
diff

getSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
getSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
getSplit Axis
_ (Tree Split
_, []) = forall a. Maybe a
Nothing
getSplit Axis
d Zipper Split
z =
 do let fs :: Maybe (Zipper Split)
fs = Axis -> Zipper Split -> Maybe (Zipper Split)
findSplit Axis
d Zipper Split
z
    if forall a. Maybe a -> Bool
isNothing Maybe (Zipper Split)
fs
      then Axis -> Zipper Split -> Maybe (Zipper Split)
findClosest Axis
d Zipper Split
z
      else Maybe (Zipper Split)
fs

findClosest :: Axis -> Zipper Split -> Maybe (Zipper Split)
findClosest :: Axis -> Zipper Split -> Maybe (Zipper Split)
findClosest Axis
_ z :: Zipper Split
z@(Tree Split
_, []) = forall a. a -> Maybe a
Just Zipper Split
z
findClosest Axis
d z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
d = forall a. a -> Maybe a
Just Zipper Split
z
findClosest Axis
d z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
d = forall a. a -> Maybe a
Just Zipper Split
z
findClosest Axis
d Zipper Split
z = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Axis -> Zipper Split -> Maybe (Zipper Split)
findClosest Axis
d

findSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
findSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
findSplit Axis
_ (Tree Split
_, []) = forall a. Maybe a
Nothing
findSplit Axis
d z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s forall a. Eq a => a -> a -> Bool
== Axis
d = forall a. a -> Maybe a
Just Zipper Split
z
findSplit Axis
d Zipper Split
z = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Axis -> Zipper Split -> Maybe (Zipper Split)
findSplit Axis
d

resizeSplit :: Direction2D -> (Rational,Rational) -> Zipper Split -> Maybe (Zipper Split)
resizeSplit :: Direction2D
-> (Rational, Rational) -> Zipper Split -> Maybe (Zipper Split)
resizeSplit Direction2D
_ (Rational, Rational)
_ z :: Zipper Split
z@(Tree Split
_, []) = forall a. a -> Maybe a
Just Zipper Split
z
resizeSplit Direction2D
dir (Rational
xsc,Rational
ysc) Zipper Split
z = case Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
dir Zipper Split
z of
  Maybe (Zipper Split)
Nothing -> forall a. a -> Maybe a
Just Zipper Split
z
  Just (t :: Tree Split
t@Node{}, [Crumb Split]
crumb) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Direction2D
dir of
    Direction2D
R -> (Tree Split
t{value :: Split
value=Split
sp{ratio :: Rational
ratio=forall {a}. (Ord a, Fractional a) => a -> a -> a
scaleRatio (Split -> Rational
ratio Split
sp) Rational
xsc}}, [Crumb Split]
crumb)
    Direction2D
D -> (Tree Split
t{value :: Split
value=Split
sp{ratio :: Rational
ratio=forall {a}. (Ord a, Fractional a) => a -> a -> a
scaleRatio (Split -> Rational
ratio Split
sp) Rational
ysc}}, [Crumb Split]
crumb)
    Direction2D
L -> (Tree Split
t{value :: Split
value=Split
sp{ratio :: Rational
ratio=Rational
1forall a. Num a => a -> a -> a
-forall {a}. (Ord a, Fractional a) => a -> a -> a
scaleRatio (Rational
1forall a. Num a => a -> a -> a
-Split -> Rational
ratio Split
sp) Rational
xsc}}, [Crumb Split]
crumb)
    Direction2D
U -> (Tree Split
t{value :: Split
value=Split
sp{ratio :: Rational
ratio=Rational
1forall a. Num a => a -> a -> a
-forall {a}. (Ord a, Fractional a) => a -> a -> a
scaleRatio (Rational
1forall a. Num a => a -> a -> a
-Split -> Rational
ratio Split
sp) Rational
ysc}}, [Crumb Split]
crumb)
    where sp :: Split
sp = forall a. Tree a -> a
value Tree Split
t
          scaleRatio :: a -> a -> a
scaleRatio a
r a
fac = forall a. Ord a => a -> a -> a
min a
0.9 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max a
0.1 forall a b. (a -> b) -> a -> b
$ a
rforall a. Num a => a -> a -> a
*a
fac
  Just (Leaf{}, [Crumb Split]
_) ->
    forall a. HasCallStack => a
undefined -- silence -Wincomplete-uni-patterns (goToBorder/goUp never return a Leaf)

-- starting from a leaf, go to node representing a border of the according window
goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
L z :: Zipper Split
z@(Tree Split
_, RightCrumb (Split Axis
Vertical Rational
_) Tree Split
_:[Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z
goToBorder Direction2D
L Zipper Split
z = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
L
goToBorder Direction2D
R z :: Zipper Split
z@(Tree Split
_, LeftCrumb  (Split Axis
Vertical Rational
_) Tree Split
_:[Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z
goToBorder Direction2D
R Zipper Split
z = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
R
goToBorder Direction2D
U z :: Zipper Split
z@(Tree Split
_, RightCrumb (Split Axis
Horizontal Rational
_) Tree Split
_:[Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z
goToBorder Direction2D
U Zipper Split
z = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
U
goToBorder Direction2D
D z :: Zipper Split
z@(Tree Split
_, LeftCrumb  (Split Axis
Horizontal Rational
_) Tree Split
_:[Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z
goToBorder Direction2D
D Zipper Split
z = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
D

-- takes a list of indices and numerates the leaves of a given tree
numerate :: [Int] -> Tree a -> Tree a
numerate :: forall a. [Int] -> Tree a -> Tree a
numerate [Int]
ns Tree a
t = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall {a}. [Int] -> Tree a -> ([Int], Tree a)
num [Int]
ns Tree a
t
  where num :: [Int] -> Tree a -> ([Int], Tree a)
num (Int
n:[Int]
nns) (Leaf Int
_) = ([Int]
nns, forall a. Int -> Tree a
Leaf Int
n)
        num [] (Leaf Int
_) = ([], forall a. Int -> Tree a
Leaf Int
0)
        num [Int]
n (Node a
s Tree a
l Tree a
r) = ([Int]
n'', forall a. a -> Tree a -> Tree a -> Tree a
Node a
s Tree a
nl Tree a
nr)
          where ([Int]
n', Tree a
nl)  = [Int] -> Tree a -> ([Int], Tree a)
num [Int]
n Tree a
l
                ([Int]
n'', Tree a
nr) = [Int] -> Tree a -> ([Int], Tree a)
num [Int]
n' Tree a
r

-- return values of leaves from left to right as list
flatten :: Tree a -> [Int]
flatten :: forall a. Tree a -> [Int]
flatten (Leaf Int
n) = [Int
n]
flatten (Node a
_ Tree a
l Tree a
r) = forall a. Tree a -> [Int]
flatten Tree a
lforall a. [a] -> [a] -> [a]
++forall a. Tree a -> [Int]
flatten Tree a
r

-- adjust ratios to make window areas equal
equalize :: Zipper Split -> Maybe (Zipper Split)
equalize :: Zipper Split -> Maybe (Zipper Split)
equalize (Tree Split
t, [Crumb Split]
cs) = forall a. a -> Maybe a
Just (Tree Split -> Tree Split
eql Tree Split
t, [Crumb Split]
cs)
  where eql :: Tree Split -> Tree Split
eql (Leaf Int
n) = forall a. Int -> Tree a
Leaf Int
n
        eql n :: Tree Split
n@(Node Split
s Tree Split
l Tree Split
r) = forall a. a -> Tree a -> Tree a -> Tree a
Node Split
s{ratio :: Rational
ratio=forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Tree a -> Int
numLeaves Tree Split
l) forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Tree a -> Int
numLeaves Tree Split
n)}
                                  (Tree Split -> Tree Split
eql Tree Split
l) (Tree Split -> Tree Split
eql Tree Split
r)

-- generate a symmetrical balanced tree for n leaves from given tree, preserving leaf labels
balancedTree :: Zipper Split -> Maybe (Zipper Split)
balancedTree :: Zipper Split -> Maybe (Zipper Split)
balancedTree (Tree Split
t, [Crumb Split]
cs) =  forall a. a -> Maybe a
Just (forall a. [Int] -> Tree a -> Tree a
numerate (forall a. Tree a -> [Int]
flatten Tree Split
t) forall a b. (a -> b) -> a -> b
$ forall {t}. Integral t => t -> Tree Split
balanced (forall a. Tree a -> Int
numLeaves Tree Split
t), [Crumb Split]
cs)
  where balanced :: t -> Tree Split
balanced t
1 = forall a. Int -> Tree a
Leaf Int
0
        balanced t
2 = forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Horizontal Rational
0.5) (forall a. Int -> Tree a
Leaf Int
0) (forall a. Int -> Tree a
Leaf Int
0)
        balanced t
m = forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Horizontal Rational
0.5) (t -> Tree Split
balanced (t
mforall a. Integral a => a -> a -> a
`div`t
2)) (t -> Tree Split
balanced (t
mforall a. Num a => a -> a -> a
-t
mforall a. Integral a => a -> a -> a
`div`t
2))

-- attempt to rotate splits optimally in order choose more quad-like rects
optimizeOrientation :: Rectangle -> Zipper Split -> Maybe (Zipper Split)
optimizeOrientation :: Rectangle -> Zipper Split -> Maybe (Zipper Split)
optimizeOrientation Rectangle
rct (Tree Split
t, [Crumb Split]
cs) = forall a. a -> Maybe a
Just (Tree Split -> Rectangle -> Tree Split
opt Tree Split
t Rectangle
rct, [Crumb Split]
cs)
  where opt :: Tree Split -> Rectangle -> Tree Split
opt (Leaf Int
v) Rectangle
_ = forall a. Int -> Tree a
Leaf Int
v
        opt (Node Split
sp Tree Split
l Tree Split
r) Rectangle
rect = forall a. a -> Tree a -> Tree a -> Tree a
Node Split
sp' (Tree Split -> Rectangle -> Tree Split
opt Tree Split
l Rectangle
lrect) (Tree Split -> Rectangle -> Tree Split
opt Tree Split
r Rectangle
rrect)
         where (Rectangle Position
_ Position
_ Dimension
w1 Dimension
h1,Rectangle Position
_ Position
_ Dimension
w2 Dimension
h2) = Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split (Split -> Axis
axis Split
sp) (Split -> Rational
ratio Split
sp) Rectangle
rect
               (Rectangle Position
_ Position
_ Dimension
w3 Dimension
h3,Rectangle Position
_ Position
_ Dimension
w4 Dimension
h4) = Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split (Split -> Axis
axis forall a b. (a -> b) -> a -> b
$ Split -> Split
oppositeSplit Split
sp) (Split -> Rational
ratio Split
sp) Rectangle
rect
               f :: a -> a -> Double
f a
w a
h = if a
w forall a. Ord a => a -> a -> Bool
> a
h then Double
w'forall a. Fractional a => a -> a -> a
/Double
h' else Double
h'forall a. Fractional a => a -> a -> a
/Double
w' where (Double
w',Double
h') = (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w :: Double, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
h :: Double)
               wratio :: Double
wratio = forall a. Ord a => a -> a -> a
min (forall {a}. Integral a => a -> a -> Double
f Dimension
w1 Dimension
h1) (forall {a}. Integral a => a -> a -> Double
f Dimension
w2 Dimension
h2)
               wratio' :: Double
wratio' = forall a. Ord a => a -> a -> a
min (forall {a}. Integral a => a -> a -> Double
f Dimension
w3 Dimension
h3) (forall {a}. Integral a => a -> a -> Double
f Dimension
w4 Dimension
h4)
               sp' :: Split
sp' = if Double
wratioforall a. Ord a => a -> a -> Bool
<Double
wratio' then Split
sp else Split -> Split
oppositeSplit Split
sp
               (Rectangle
lrect, Rectangle
rrect) = Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split (Split -> Axis
axis Split
sp') (Split -> Rational
ratio Split
sp') Rectangle
rect


-- initially focused leaf, path from root to selected node, window ids of borders highlighting the selection
data NodeRef = NodeRef { NodeRef -> Int
refLeaf :: Int, NodeRef -> [Direction2D]
refPath :: [Direction2D], NodeRef -> [Window]
refWins :: [Window] } deriving (Int -> NodeRef -> ShowS
[NodeRef] -> ShowS
NodeRef -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeRef] -> ShowS
$cshowList :: [NodeRef] -> ShowS
show :: NodeRef -> String
$cshow :: NodeRef -> String
showsPrec :: Int -> NodeRef -> ShowS
$cshowsPrec :: Int -> NodeRef -> ShowS
Show,ReadPrec [NodeRef]
ReadPrec NodeRef
Int -> ReadS NodeRef
ReadS [NodeRef]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NodeRef]
$creadListPrec :: ReadPrec [NodeRef]
readPrec :: ReadPrec NodeRef
$creadPrec :: ReadPrec NodeRef
readList :: ReadS [NodeRef]
$creadList :: ReadS [NodeRef]
readsPrec :: Int -> ReadS NodeRef
$creadsPrec :: Int -> ReadS NodeRef
Read,NodeRef -> NodeRef -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeRef -> NodeRef -> Bool
$c/= :: NodeRef -> NodeRef -> Bool
== :: NodeRef -> NodeRef -> Bool
$c== :: NodeRef -> NodeRef -> Bool
Eq)
noRef :: NodeRef
noRef :: NodeRef
noRef = Int -> [Direction2D] -> [Window] -> NodeRef
NodeRef (-Int
1) [] []

goToNode :: NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode :: forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode (NodeRef Int
_ [Direction2D]
dirs [Window]
_) Zipper a
z = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {a}. Zipper a -> Direction2D -> Maybe (Zipper a)
gofun Zipper a
z [Direction2D]
dirs
  where gofun :: Zipper a -> Direction2D -> Maybe (Zipper a)
gofun Zipper a
z' Direction2D
L = forall a. Zipper a -> Maybe (Zipper a)
goLeft Zipper a
z'
        gofun Zipper a
z' Direction2D
R = forall a. Zipper a -> Maybe (Zipper a)
goRight Zipper a
z'
        gofun Zipper a
_ Direction2D
_ = forall a. Maybe a
Nothing

toNodeRef :: Int -> Maybe (Zipper Split) -> NodeRef
toNodeRef :: Int -> Maybe (Zipper Split) -> NodeRef
toNodeRef Int
_ Maybe (Zipper Split)
Nothing = NodeRef
noRef
toNodeRef Int
l (Just (Tree Split
_, [Crumb Split]
cs)) = Int -> [Direction2D] -> [Window] -> NodeRef
NodeRef Int
l (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Crumb a -> Direction2D
crumbToDir [Crumb Split]
cs) []
  where crumbToDir :: Crumb a -> Direction2D
crumbToDir (LeftCrumb a
_ Tree a
_) = Direction2D
L
        crumbToDir (RightCrumb a
_ Tree a
_) = Direction2D
R

-- returns the leaf a noderef is leading to, if any
nodeRefToLeaf :: NodeRef -> Maybe (Zipper a) -> Maybe Int
nodeRefToLeaf :: forall a. NodeRef -> Maybe (Zipper a) -> Maybe Int
nodeRefToLeaf NodeRef
n (Just Zipper a
z) = case forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
n Zipper a
z of
  Just (Leaf Int
l, [Crumb a]
_) -> forall a. a -> Maybe a
Just Int
l
  Just (Node{}, [Crumb a]
_) -> forall a. Maybe a
Nothing
  Maybe (Zipper a)
Nothing -> forall a. Maybe a
Nothing
nodeRefToLeaf NodeRef
_ Maybe (Zipper a)
Nothing = forall a. Maybe a
Nothing

leafToNodeRef :: Int -> BinarySpacePartition a -> NodeRef
leafToNodeRef :: forall a. Int -> BinarySpacePartition a -> NodeRef
leafToNodeRef Int
l BinarySpacePartition a
b = Int -> Maybe (Zipper Split) -> NodeRef
toNodeRef Int
l (forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf Int
l)

data BinarySpacePartition a = BinarySpacePartition { forall a. BinarySpacePartition a -> [(Window, Rectangle)]
getOldRects :: [(Window,Rectangle)]
                                                   , forall a. BinarySpacePartition a -> NodeRef
getFocusedNode :: NodeRef
                                                   , forall a. BinarySpacePartition a -> NodeRef
getSelectedNode :: NodeRef
                                                   , forall a. BinarySpacePartition a -> Maybe (Tree Split)
getTree :: Maybe (Tree Split) } deriving (Int -> BinarySpacePartition a -> ShowS
forall a. Int -> BinarySpacePartition a -> ShowS
forall a. [BinarySpacePartition a] -> ShowS
forall a. BinarySpacePartition a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinarySpacePartition a] -> ShowS
$cshowList :: forall a. [BinarySpacePartition a] -> ShowS
show :: BinarySpacePartition a -> String
$cshow :: forall a. BinarySpacePartition a -> String
showsPrec :: Int -> BinarySpacePartition a -> ShowS
$cshowsPrec :: forall a. Int -> BinarySpacePartition a -> ShowS
Show, ReadPrec [BinarySpacePartition a]
ReadPrec (BinarySpacePartition a)
ReadS [BinarySpacePartition a]
forall a. ReadPrec [BinarySpacePartition a]
forall a. ReadPrec (BinarySpacePartition a)
forall a. Int -> ReadS (BinarySpacePartition a)
forall a. ReadS [BinarySpacePartition a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BinarySpacePartition a]
$creadListPrec :: forall a. ReadPrec [BinarySpacePartition a]
readPrec :: ReadPrec (BinarySpacePartition a)
$creadPrec :: forall a. ReadPrec (BinarySpacePartition a)
readList :: ReadS [BinarySpacePartition a]
$creadList :: forall a. ReadS [BinarySpacePartition a]
readsPrec :: Int -> ReadS (BinarySpacePartition a)
$creadsPrec :: forall a. Int -> ReadS (BinarySpacePartition a)
Read,BinarySpacePartition a -> BinarySpacePartition a -> Bool
forall a. BinarySpacePartition a -> BinarySpacePartition a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinarySpacePartition a -> BinarySpacePartition a -> Bool
$c/= :: forall a. BinarySpacePartition a -> BinarySpacePartition a -> Bool
== :: BinarySpacePartition a -> BinarySpacePartition a -> Bool
$c== :: forall a. BinarySpacePartition a -> BinarySpacePartition a -> Bool
Eq)

-- | an empty BinarySpacePartition to use as a default for adding windows to.
emptyBSP :: BinarySpacePartition a
emptyBSP :: forall a. BinarySpacePartition a
emptyBSP = forall a.
[(Window, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition a
BinarySpacePartition [] NodeRef
noRef NodeRef
noRef forall a. Maybe a
Nothing

makeBSP :: Tree Split -> BinarySpacePartition a
makeBSP :: forall a. Tree Split -> BinarySpacePartition a
makeBSP = forall a.
[(Window, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition a
BinarySpacePartition [] NodeRef
noRef NodeRef
noRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

makeZipper :: BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper :: forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = forall a. Maybe a
Nothing
makeZipper (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just Tree Split
t)) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> Zipper a
toZipper forall a b. (a -> b) -> a -> b
$ Tree Split
t

size :: BinarySpacePartition a -> Int
size :: forall a. BinarySpacePartition a -> Int
size = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a. Tree a -> Int
numLeaves forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BinarySpacePartition a -> Maybe (Tree Split)
getTree

zipperToBinarySpacePartition :: Maybe (Zipper Split) -> BinarySpacePartition b
zipperToBinarySpacePartition :: forall b. Maybe (Zipper Split) -> BinarySpacePartition b
zipperToBinarySpacePartition Maybe (Zipper Split)
Nothing = forall a. BinarySpacePartition a
emptyBSP
zipperToBinarySpacePartition (Just Zipper Split
z) = forall a.
[(Window, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition a
BinarySpacePartition [] NodeRef
noRef NodeRef
noRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Zipper a -> Tree a
toTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Zipper a -> Zipper a
top forall a b. (a -> b) -> a -> b
$ Zipper Split
z

rectangles :: BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles :: forall a. BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) Rectangle
_ = []
rectangles (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) Rectangle
rootRect = [Rectangle
rootRect]
rectangles (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just Tree Split
node)) Rectangle
rootRect =
    forall a. BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles (forall a. Tree Split -> BinarySpacePartition a
makeBSP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> Tree a
left forall a b. (a -> b) -> a -> b
$ Tree Split
node) Rectangle
leftBox forall a. [a] -> [a] -> [a]
++
    forall a. BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles (forall a. Tree Split -> BinarySpacePartition a
makeBSP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> Tree a
right forall a b. (a -> b) -> a -> b
$ Tree Split
node) Rectangle
rightBox
    where (Rectangle
leftBox, Rectangle
rightBox) = Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split (Split -> Axis
axis Split
info) (Split -> Rational
ratio Split
info) Rectangle
rootRect
          info :: Split
info = forall a. Tree a -> a
value Tree Split
node

getNodeRect :: BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
getNodeRect :: forall a.
BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
getNodeRect BinarySpacePartition a
b Rectangle
r NodeRef
n = forall a. a -> Maybe a -> a
fromMaybe (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
1 Dimension
1) (forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> Zipper Split -> Maybe Rectangle
getRect [])
  where getRect :: [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> Zipper Split -> Maybe Rectangle
getRect [(Split, (Rectangle, Rectangle) -> Rectangle)]
ls (Tree Split
_, []) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Rectangle
r' (Split
s,(Rectangle, Rectangle) -> Rectangle
f) -> (Rectangle, Rectangle) -> Rectangle
f forall a b. (a -> b) -> a -> b
$ Split -> Rectangle -> (Rectangle, Rectangle)
split' Split
s Rectangle
r') Rectangle
r [(Split, (Rectangle, Rectangle) -> Rectangle)]
ls
        getRect [(Split, (Rectangle, Rectangle) -> Rectangle)]
ls z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> Zipper Split -> Maybe Rectangle
getRect ((Split
s,forall a b. (a, b) -> a
fst)forall a. a -> [a] -> [a]
:[(Split, (Rectangle, Rectangle) -> Rectangle)]
ls)
        getRect [(Split, (Rectangle, Rectangle) -> Rectangle)]
ls z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
s Tree Split
_:[Crumb Split]
_) = forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> Zipper Split -> Maybe Rectangle
getRect ((Split
s,forall a b. (a, b) -> b
snd)forall a. a -> [a] -> [a]
:[(Split, (Rectangle, Rectangle) -> Rectangle)]
ls)
        split' :: Split -> Rectangle -> (Rectangle, Rectangle)
split' Split
s = Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split (Split -> Axis
axis Split
s) (Split -> Rational
ratio Split
s)

doToNth :: (Zipper Split -> Maybe (Zipper Split)) -> BinarySpacePartition a -> BinarySpacePartition a
doToNth :: forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
f BinarySpacePartition a
b = BinarySpacePartition a
b{getTree :: Maybe (Tree Split)
getTree=forall a. BinarySpacePartition a -> Maybe (Tree Split)
getTree forall a b. (a -> b) -> a -> b
$ forall b. Maybe (Zipper Split) -> BinarySpacePartition b
zipperToBinarySpacePartition forall a b. (a -> b) -> a -> b
$ forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode (forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition a
b) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
f}

splitNth :: BinarySpacePartition a -> BinarySpacePartition a
splitNth :: forall a. BinarySpacePartition a -> BinarySpacePartition a
splitNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = forall a. Tree Split -> BinarySpacePartition a
makeBSP (forall a. Int -> Tree a
Leaf Int
0)
splitNth BinarySpacePartition a
b = forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
splitCurrent BinarySpacePartition a
b

removeNth :: BinarySpacePartition a -> BinarySpacePartition a
removeNth :: forall a. BinarySpacePartition a -> BinarySpacePartition a
removeNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = forall a. BinarySpacePartition a
emptyBSP
removeNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = forall a. BinarySpacePartition a
emptyBSP
removeNth BinarySpacePartition a
b = forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth forall a. Zipper a -> Maybe (Zipper a)
removeCurrent BinarySpacePartition a
b

rotateNth :: BinarySpacePartition a -> BinarySpacePartition a
rotateNth :: forall a. BinarySpacePartition a -> BinarySpacePartition a
rotateNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = forall a. BinarySpacePartition a
emptyBSP
rotateNth b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
rotateNth BinarySpacePartition a
b = forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
rotateCurrent BinarySpacePartition a
b

swapNth :: BinarySpacePartition a -> BinarySpacePartition a
swapNth :: forall a. BinarySpacePartition a -> BinarySpacePartition a
swapNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = forall a. BinarySpacePartition a
emptyBSP
swapNth b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
swapNth BinarySpacePartition a
b = forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth forall a. Zipper a -> Maybe (Zipper a)
swapCurrent BinarySpacePartition a
b

splitShiftNth :: Direction1D -> BinarySpacePartition a -> BinarySpacePartition a
splitShiftNth :: forall a.
Direction1D -> BinarySpacePartition a -> BinarySpacePartition a
splitShiftNth Direction1D
_ (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = forall a. BinarySpacePartition a
emptyBSP
splitShiftNth Direction1D
_ b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
splitShiftNth Direction1D
Prev BinarySpacePartition a
b = forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
splitShiftLeftCurrent BinarySpacePartition a
b
splitShiftNth Direction1D
Next BinarySpacePartition a
b = forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
splitShiftRightCurrent BinarySpacePartition a
b

growNthTowards :: Direction2D -> Rational -> BinarySpacePartition a -> BinarySpacePartition a
growNthTowards :: forall a.
Direction2D
-> Rational -> BinarySpacePartition a -> BinarySpacePartition a
growNthTowards Direction2D
_ Rational
_ (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = forall a. BinarySpacePartition a
emptyBSP
growNthTowards Direction2D
_ Rational
_ b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
growNthTowards Direction2D
dir Rational
diff BinarySpacePartition a
b = forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
dir Rational
diff) BinarySpacePartition a
b

shrinkNthFrom :: Direction2D -> Rational -> BinarySpacePartition a -> BinarySpacePartition a
shrinkNthFrom :: forall a.
Direction2D
-> Rational -> BinarySpacePartition a -> BinarySpacePartition a
shrinkNthFrom Direction2D
_ Rational
_ (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing)= forall a. BinarySpacePartition a
emptyBSP
shrinkNthFrom Direction2D
_ Rational
_ b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
shrinkNthFrom Direction2D
dir Rational
diff BinarySpacePartition a
b = forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom Direction2D
dir Rational
diff) BinarySpacePartition a
b

autoSizeNth :: Direction2D -> Rational -> BinarySpacePartition a -> BinarySpacePartition a
autoSizeNth :: forall a.
Direction2D
-> Rational -> BinarySpacePartition a -> BinarySpacePartition a
autoSizeNth Direction2D
_ Rational
_ (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = forall a. BinarySpacePartition a
emptyBSP
autoSizeNth Direction2D
_ Rational
_ b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
autoSizeNth Direction2D
dir Rational
diff BinarySpacePartition a
b = forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
autoSizeTree Direction2D
dir Rational
diff) BinarySpacePartition a
b

resizeSplitNth :: Direction2D -> (Rational,Rational) -> BinarySpacePartition a -> BinarySpacePartition a
resizeSplitNth :: forall a.
Direction2D
-> (Rational, Rational)
-> BinarySpacePartition a
-> BinarySpacePartition a
resizeSplitNth Direction2D
_ (Rational, Rational)
_ (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = forall a. BinarySpacePartition a
emptyBSP
resizeSplitNth Direction2D
_ (Rational, Rational)
_ b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
resizeSplitNth Direction2D
dir (Rational, Rational)
sc BinarySpacePartition a
b = forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Direction2D
-> (Rational, Rational) -> Zipper Split -> Maybe (Zipper Split)
resizeSplit Direction2D
dir (Rational, Rational)
sc) BinarySpacePartition a
b

-- rotate tree left or right around parent of nth leaf
rotateTreeNth :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
rotateTreeNth :: forall a.
Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
rotateTreeNth Direction2D
_ (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = forall a. BinarySpacePartition a
emptyBSP
rotateTreeNth Direction2D
U BinarySpacePartition a
b = BinarySpacePartition a
b
rotateTreeNth Direction2D
D BinarySpacePartition a
b = BinarySpacePartition a
b
rotateTreeNth Direction2D
dir b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just Tree Split
_)) =
  forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (\Zipper Split
t -> case forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
t of
                Maybe (Zipper Split)
Nothing     -> forall a. a -> Maybe a
Just Zipper Split
t
                Just (Tree Split
t', [Crumb Split]
c) -> forall a. a -> Maybe a
Just (forall a. Direction2D -> Tree a -> Tree a
rotTree Direction2D
dir Tree Split
t', [Crumb Split]
c)) BinarySpacePartition a
b

equalizeNth :: BinarySpacePartition a -> BinarySpacePartition a
equalizeNth :: forall a. BinarySpacePartition a -> BinarySpacePartition a
equalizeNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = forall a. BinarySpacePartition a
emptyBSP
equalizeNth b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
equalizeNth BinarySpacePartition a
b = forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
equalize BinarySpacePartition a
b

rebalanceNth :: BinarySpacePartition a -> Rectangle -> BinarySpacePartition a
rebalanceNth :: forall a.
BinarySpacePartition a -> Rectangle -> BinarySpacePartition a
rebalanceNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) Rectangle
_ = forall a. BinarySpacePartition a
emptyBSP
rebalanceNth b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) Rectangle
_ = BinarySpacePartition a
b
rebalanceNth BinarySpacePartition a
b Rectangle
r = forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Zipper Split -> Maybe (Zipper Split)
balancedTree forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Rectangle -> Zipper Split -> Maybe (Zipper Split)
optimizeOrientation Rectangle
r) BinarySpacePartition a
b

flattenLeaves :: BinarySpacePartition a -> [Int]
flattenLeaves :: forall a. BinarySpacePartition a -> [Int]
flattenLeaves (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = []
flattenLeaves (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just Tree Split
t)) = forall a. Tree a -> [Int]
flatten Tree Split
t

-- we do this before an action to look afterwards which leaves moved where
numerateLeaves :: BinarySpacePartition a -> BinarySpacePartition a
numerateLeaves :: forall a. BinarySpacePartition a -> BinarySpacePartition a
numerateLeaves b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = BinarySpacePartition a
b
numerateLeaves b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just Tree Split
t)) = BinarySpacePartition a
b{getTree :: Maybe (Tree Split)
getTree=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [Int] -> Tree a -> Tree a
numerate [Int]
ns Tree Split
t}
  where ns :: [Int]
ns = [Int
0..(forall a. Tree a -> Int
numLeaves Tree Split
tforall a. Num a => a -> a -> a
-Int
1)]

-- if there is a selected and focused node and the focused is not a part of selected,
-- move selected node to be a child of focused node
moveNode :: BinarySpacePartition a -> BinarySpacePartition a
moveNode :: forall a. BinarySpacePartition a -> BinarySpacePartition a
moveNode b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ (NodeRef (-1) [Direction2D]
_ [Window]
_) NodeRef
_ Maybe (Tree Split)
_) = BinarySpacePartition a
b
moveNode b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ (NodeRef (-1) [Direction2D]
_ [Window]
_) Maybe (Tree Split)
_) = BinarySpacePartition a
b
moveNode b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = BinarySpacePartition a
b
moveNode b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
f NodeRef
s (Just Tree Split
ot)) =
  case forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
s of
    Just (Tree Split
n, LeftCrumb Split
_ Tree Split
t:[Crumb Split]
cs)  -> BinarySpacePartition a
b{getTree :: Maybe (Tree Split)
getTree=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Tree Split -> Zipper Split -> Tree Split
insert Tree Split
n forall a b. (a -> b) -> a -> b
$ forall a. Zipper a -> Zipper a
top (Tree Split
t, [Crumb Split]
cs)}
    Just (Tree Split
n, RightCrumb Split
_ Tree Split
t:[Crumb Split]
cs) -> BinarySpacePartition a
b{getTree :: Maybe (Tree Split)
getTree=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Tree Split -> Zipper Split -> Tree Split
insert Tree Split
n forall a b. (a -> b) -> a -> b
$ forall a. Zipper a -> Zipper a
top (Tree Split
t, [Crumb Split]
cs)}
    Maybe (Zipper Split)
_ -> BinarySpacePartition a
b
  where insert :: Tree Split -> Zipper Split -> Tree Split
insert Tree Split
t Zipper Split
z = case forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
f Zipper Split
z of
          Maybe (Zipper Split)
Nothing -> Tree Split
ot --return original tree (abort)
          Just (Tree Split
n, Crumb Split
c:[Crumb Split]
cs) -> forall a. Zipper a -> Tree a
toTree (forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Crumb a -> a
parentVal forall a b. (a -> b) -> a -> b
$ Crumb Split
c) Rational
0.5) Tree Split
t Tree Split
n, Crumb Split
cforall a. a -> [a] -> [a]
:[Crumb Split]
cs)
          Just (Tree Split
n, []) -> forall a. Zipper a -> Tree a
toTree (forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Vertical Rational
0.5) Tree Split
t Tree Split
n, [])

------------------------------------------

-- returns index of focused window or 0 for empty stack
index :: W.Stack a -> Int
index :: forall a. Stack a -> Int
index Stack a
s = case forall a. Zipper a -> ([a], Maybe Int)
toIndex (forall a. a -> Maybe a
Just Stack a
s) of
            ([a]
_, Maybe Int
Nothing) -> Int
0
            ([a]
_, Just Int
int) -> Int
int

--move windows to new positions according to tree transformations, keeping focus on originally focused window
--CAREFUL here! introduce a bug here and have fun debugging as your windows start to disappear or explode
adjustStack :: Maybe (W.Stack Window)  --original stack
            -> Maybe (W.Stack Window)  --stack without floating windows
            -> [Window]                --just floating windows of this WS
            -> Maybe (BinarySpacePartition Window) -- Tree with numbered leaves telling what to move where
            -> Maybe (W.Stack Window)  --resulting stack
adjustStack :: Maybe (Stack Window)
-> Maybe (Stack Window)
-> [Window]
-> Maybe (BinarySpacePartition Window)
-> Maybe (Stack Window)
adjustStack Maybe (Stack Window)
orig Maybe (Stack Window)
Nothing [Window]
_ Maybe (BinarySpacePartition Window)
_ = Maybe (Stack Window)
orig    --no new stack -> no changes
adjustStack Maybe (Stack Window)
orig Maybe (Stack Window)
_ [Window]
_ Maybe (BinarySpacePartition Window)
Nothing = Maybe (Stack Window)
orig    --empty tree   -> no changes
adjustStack Maybe (Stack Window)
orig Maybe (Stack Window)
s [Window]
fw (Just BinarySpacePartition Window
b) =
 if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lsforall a. Ord a => a -> a -> Bool
<forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
ws then Maybe (Stack Window)
orig      --less leaves than non-floating windows -> tree incomplete, no changes
 else forall a. [a] -> Int -> Zipper a
fromIndex [Window]
ws' Int
fid'
 where ws' :: [Window]
ws' = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Int Window
wsmap) [Int]
ls forall a. [a] -> [a] -> [a]
++ [Window]
fw
       fid' :: Int
fid' = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Window
focused [Window]
ws'
       wsmap :: Map Int Window
wsmap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Window]
ws -- map: old index in list -> window
       ls :: [Int]
ls = forall a. BinarySpacePartition a -> [Int]
flattenLeaves BinarySpacePartition Window
b              -- get new index ordering from tree
       ([Window]
ws,Maybe Int
fid) = forall a. Zipper a -> ([a], Maybe Int)
toIndex Maybe (Stack Window)
s
       focused :: Window
focused = [Window]
ws forall a. [a] -> Int -> a
!! forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
fid

--replace the window stack of the managed workspace with our modified stack
replaceStack :: Maybe (W.Stack Window) -> X ()
replaceStack :: Maybe (Stack Window) -> X ()
replaceStack Maybe (Stack Window)
s = do
  XState
st <- forall s (m :: * -> *). MonadState s m => m s
get
  let wset :: WindowSet
wset = XState -> WindowSet
windowset XState
st
      cur :: Screen String (Layout Window) Window ScreenId ScreenDetail
cur  = forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
wset
      wsp :: Workspace String (Layout Window) Window
wsp  = forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen String (Layout Window) Window ScreenId ScreenDetail
cur
  forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
st{windowset :: WindowSet
windowset=WindowSet
wset{current :: Screen String (Layout Window) Window ScreenId ScreenDetail
W.current=Screen String (Layout Window) Window ScreenId ScreenDetail
cur{workspace :: Workspace String (Layout Window) Window
W.workspace=Workspace String (Layout Window) Window
wsp{stack :: Maybe (Stack Window)
W.stack=Maybe (Stack Window)
s}}}}

replaceFloating :: M.Map Window W.RationalRect -> X ()
replaceFloating :: Map Window RationalRect -> X ()
replaceFloating Map Window RationalRect
wsm = do
  XState
st <- forall s (m :: * -> *). MonadState s m => m s
get
  let wset :: WindowSet
wset = XState -> WindowSet
windowset XState
st
  forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
st{windowset :: WindowSet
windowset=WindowSet
wset{floating :: Map Window RationalRect
W.floating=Map Window RationalRect
wsm}}

-- some helpers to filter windows
--
getFloating :: X [Window]
getFloating :: X [Window]
getFloating = forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset -- all floating windows

getHidden :: X [Window]
getHidden :: X [Window]
getHidden = X (Maybe (Stack Window))
getStackSet forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall a. Query a -> Window -> X a
runQuery Query Bool
isMinimized) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe (Stack a) -> [a]
W.integrate'

getStackSet :: X (Maybe (W.Stack Window))
getStackSet :: X (Maybe (Stack Window))
getStackSet = forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset -- windows on this WS (with floating)

getScreenRect :: X Rectangle
getScreenRect :: X Rectangle
getScreenRect = ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset

withoutFloating :: [Window] -> [Window] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window)
withoutFloating :: [Window]
-> [Window] -> Maybe (Stack Window) -> Maybe (Stack Window)
withoutFloating [Window]
fs [Window]
hs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing ([Window] -> [Window] -> Stack Window -> Maybe (Stack Window)
unfloat [Window]
fs [Window]
hs)

-- ignore messages if current focus is on floating window, otherwise return stack without floating
unfloat :: [Window] -> [Window] -> W.Stack Window -> Maybe (W.Stack Window)
unfloat :: [Window] -> [Window] -> Stack Window -> Maybe (Stack Window)
unfloat [Window]
fs [Window]
hs Stack Window
s = if forall a. Stack a -> a
W.focus Stack Window
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
fs
      then forall a. Maybe a
Nothing
      else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Stack Window
s{up :: [Window]
W.up = forall a. Stack a -> [a]
W.up Stack Window
s forall a. Eq a => [a] -> [a] -> [a]
\\ ([Window]
fs forall a. [a] -> [a] -> [a]
++ [Window]
hs), down :: [Window]
W.down = forall a. Stack a -> [a]
W.down Stack Window
s forall a. Eq a => [a] -> [a] -> [a]
\\ ([Window]
fs forall a. [a] -> [a] -> [a]
++ [Window]
hs)}

instance LayoutClass BinarySpacePartition Window where
  doLayout :: BinarySpacePartition Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (BinarySpacePartition Window))
doLayout BinarySpacePartition Window
b Rectangle
r Stack Window
s = do
    let b' :: BinarySpacePartition Window
b' = forall a. BinarySpacePartition a -> BinarySpacePartition a
layout BinarySpacePartition Window
b
    BinarySpacePartition Window
b'' <- BinarySpacePartition Window
-> Bool -> Rectangle -> X (BinarySpacePartition Window)
updateNodeRef BinarySpacePartition Window
b' (forall a. BinarySpacePartition a -> Int
size BinarySpacePartition Window
bforall a. Eq a => a -> a -> Bool
/=forall a. BinarySpacePartition a -> Int
size BinarySpacePartition Window
b') Rectangle
r
    let rs :: [Rectangle]
rs = forall a. BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles BinarySpacePartition Window
b'' Rectangle
r
        wrs :: [(Window, Rectangle)]
wrs = forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
ws [Rectangle]
rs
    forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
wrs, forall a. a -> Maybe a
Just BinarySpacePartition Window
b''{getOldRects :: [(Window, Rectangle)]
getOldRects=[(Window, Rectangle)]
wrs})
    where
      ws :: [Window]
ws = forall a. Stack a -> [a]
W.integrate Stack Window
s
      l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
ws
      layout :: BinarySpacePartition a -> BinarySpacePartition a
layout BinarySpacePartition a
bsp
        | Int
l forall a. Eq a => a -> a -> Bool
== Int
sz = BinarySpacePartition a
bsp
        | Int
l forall a. Ord a => a -> a -> Bool
> Int
sz = BinarySpacePartition a -> BinarySpacePartition a
layout forall a b. (a -> b) -> a -> b
$ forall a. BinarySpacePartition a -> BinarySpacePartition a
splitNth BinarySpacePartition a
bsp
        | Bool
otherwise = BinarySpacePartition a -> BinarySpacePartition a
layout forall a b. (a -> b) -> a -> b
$ forall a. BinarySpacePartition a -> BinarySpacePartition a
removeNth BinarySpacePartition a
bsp
        where sz :: Int
sz = forall a. BinarySpacePartition a -> Int
size BinarySpacePartition a
bsp

  handleMessage :: BinarySpacePartition Window
-> SomeMessage -> X (Maybe (BinarySpacePartition Window))
handleMessage BinarySpacePartition Window
b_orig SomeMessage
m
   | Just msg :: WindowArrangerMsg
msg@(SetGeometry Rectangle
_) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = BinarySpacePartition Window
-> WindowArrangerMsg -> X (Maybe (BinarySpacePartition Window))
handleResize BinarySpacePartition Window
b WindowArrangerMsg
msg
   | Just FocusParent
FocusParent <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
       let n :: NodeRef
n = forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Window
b
       let n' :: NodeRef
n' = Int -> Maybe (Zipper Split) -> NodeRef
toNodeRef (NodeRef -> Int
refLeaf NodeRef
n) (forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition Window
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Zipper a -> Maybe (Zipper a)
goUp)
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just BinarySpacePartition Window
b{getFocusedNode :: NodeRef
getFocusedNode=NodeRef
n'{refWins :: [Window]
refWins=NodeRef -> [Window]
refWins NodeRef
n}}
   | Just SelectMoveNode
SelectNode <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
       let n :: NodeRef
n = forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Window
b
       let s :: NodeRef
s = forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition Window
b
       [Window] -> X ()
removeBorder forall a b. (a -> b) -> a -> b
$ NodeRef -> [Window]
refWins NodeRef
s
       let s' :: NodeRef
s' = if NodeRef -> Int
refLeaf NodeRef
n forall a. Eq a => a -> a -> Bool
== NodeRef -> Int
refLeaf NodeRef
s Bool -> Bool -> Bool
&& NodeRef -> [Direction2D]
refPath NodeRef
n forall a. Eq a => a -> a -> Bool
== NodeRef -> [Direction2D]
refPath NodeRef
s
                then NodeRef
noRef else NodeRef
n{refWins :: [Window]
refWins=[]}
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just BinarySpacePartition Window
b{getSelectedNode :: NodeRef
getSelectedNode=NodeRef
s'}
   | Bool
otherwise = do
       Maybe (Stack Window)
ws <- X (Maybe (Stack Window))
getStackSet
       [Window]
fs <- X [Window]
getFloating
       [Window]
hs <- X [Window]
getHidden
       Rectangle
r <- X Rectangle
getScreenRect
       -- removeBorder $ refWins $ getSelectedNode b
       let lws :: Maybe (Stack Window)
lws = [Window]
-> [Window] -> Maybe (Stack Window) -> Maybe (Stack Window)
withoutFloating [Window]
fs [Window]
hs Maybe (Stack Window)
ws                                 -- tiled windows on WS
           lfs :: [Window]
lfs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. Stack a -> [a]
W.integrate Maybe (Stack Window)
ws forall a. Eq a => [a] -> [a] -> [a]
\\ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. Stack a -> [a]
W.integrate Maybe (Stack Window)
lws      -- untiled windows on WS
           b' :: Maybe (BinarySpacePartition Window)
b'  = Rectangle -> Maybe (BinarySpacePartition Window)
handleMesg Rectangle
r                -- transform tree (concerns only tiled windows)
           ws' :: Maybe (Stack Window)
ws' = Maybe (Stack Window)
-> Maybe (Stack Window)
-> [Window]
-> Maybe (BinarySpacePartition Window)
-> Maybe (Stack Window)
adjustStack Maybe (Stack Window)
ws Maybe (Stack Window)
lws [Window]
lfs Maybe (BinarySpacePartition Window)
b'   -- apply transformation to window stack, reintegrate floating wins
       Maybe (Stack Window) -> X ()
replaceStack Maybe (Stack Window)
ws'
       forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (BinarySpacePartition Window)
b'
    where handleMesg :: Rectangle -> Maybe (BinarySpacePartition Window)
handleMesg Rectangle
r = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResizeDirectional -> BinarySpacePartition Window
resize        (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Rotate -> BinarySpacePartition a
rotate        (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Swap -> BinarySpacePartition a
swap          (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. TreeRotate -> BinarySpacePartition a
rotateTr      (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {a}. Rectangle -> TreeBalance -> BinarySpacePartition a
balanceTr Rectangle
r) (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SelectMoveNode -> BinarySpacePartition Window
move          (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. SplitShiftDirectional -> BinarySpacePartition a
splitShift    (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              ]
          resize :: ResizeDirectional -> BinarySpacePartition Window
resize (ExpandTowardsBy Direction2D
dir Rational
diff) = forall a.
Direction2D
-> Rational -> BinarySpacePartition a -> BinarySpacePartition a
growNthTowards Direction2D
dir Rational
diff BinarySpacePartition Window
b
          resize (ShrinkFromBy Direction2D
dir Rational
diff) = forall a.
Direction2D
-> Rational -> BinarySpacePartition a -> BinarySpacePartition a
shrinkNthFrom Direction2D
dir Rational
diff BinarySpacePartition Window
b
          resize (MoveSplitBy Direction2D
dir Rational
diff) = forall a.
Direction2D
-> Rational -> BinarySpacePartition a -> BinarySpacePartition a
autoSizeNth Direction2D
dir Rational
diff BinarySpacePartition Window
b
          rotate :: Rotate -> BinarySpacePartition a
rotate Rotate
Rotate = forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc forall a b. (a -> b) -> a -> b
$ forall a. BinarySpacePartition a -> BinarySpacePartition a
rotateNth BinarySpacePartition Window
b
          swap :: Swap -> BinarySpacePartition a
swap Swap
Swap = forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc forall a b. (a -> b) -> a -> b
$ forall a. BinarySpacePartition a -> BinarySpacePartition a
swapNth BinarySpacePartition Window
b
          rotateTr :: TreeRotate -> BinarySpacePartition a
rotateTr TreeRotate
RotateL = forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc forall a b. (a -> b) -> a -> b
$ forall a.
Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
rotateTreeNth Direction2D
L BinarySpacePartition Window
b
          rotateTr TreeRotate
RotateR = forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc forall a b. (a -> b) -> a -> b
$ forall a.
Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
rotateTreeNth Direction2D
R BinarySpacePartition Window
b
          balanceTr :: Rectangle -> TreeBalance -> BinarySpacePartition a
balanceTr Rectangle
_ TreeBalance
Equalize = forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc forall a b. (a -> b) -> a -> b
$ forall a. BinarySpacePartition a -> BinarySpacePartition a
equalizeNth BinarySpacePartition Window
b
          balanceTr Rectangle
r TreeBalance
Balance  = forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc forall a b. (a -> b) -> a -> b
$ forall a.
BinarySpacePartition a -> Rectangle -> BinarySpacePartition a
rebalanceNth BinarySpacePartition Window
b Rectangle
r
          move :: SelectMoveNode -> BinarySpacePartition Window
move SelectMoveNode
MoveNode = forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc forall a b. (a -> b) -> a -> b
$ forall a. BinarySpacePartition a -> BinarySpacePartition a
moveNode BinarySpacePartition Window
b
          move SelectMoveNode
SelectNode = BinarySpacePartition Window
b --should not happen here, is done above, as we need X monad
          splitShift :: SplitShiftDirectional -> BinarySpacePartition a
splitShift (SplitShift Direction1D
dir) = forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc forall a b. (a -> b) -> a -> b
$ forall a.
Direction1D -> BinarySpacePartition a -> BinarySpacePartition a
splitShiftNth Direction1D
dir BinarySpacePartition Window
b

          b :: BinarySpacePartition Window
b = forall a. BinarySpacePartition a -> BinarySpacePartition a
numerateLeaves BinarySpacePartition Window
b_orig
          resetFoc :: BinarySpacePartition a -> BinarySpacePartition a
resetFoc BinarySpacePartition a
bsp = BinarySpacePartition a
bsp{getFocusedNode :: NodeRef
getFocusedNode=(forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition a
bsp){refLeaf :: Int
refLeaf= -Int
1}
                            ,getSelectedNode :: NodeRef
getSelectedNode=(forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition a
bsp){refLeaf :: Int
refLeaf= -Int
1}}

  description :: BinarySpacePartition Window -> String
description BinarySpacePartition Window
_  = String
"BSP"

-- React to SetGeometry message to work with BorderResize/MouseResize
handleResize :: BinarySpacePartition Window -> WindowArrangerMsg -> X (Maybe (BinarySpacePartition Window))
handleResize :: BinarySpacePartition Window
-> WindowArrangerMsg -> X (Maybe (BinarySpacePartition Window))
handleResize BinarySpacePartition Window
b (SetGeometry newrect :: Rectangle
newrect@(Rectangle Position
_ Position
_ Dimension
w Dimension
h)) = do
  Maybe (Stack Window)
ws <- X (Maybe (Stack Window))
getStackSet
  [Window]
fs <- X [Window]
getFloating
  [Window]
hs <- X [Window]
getHidden
  case forall a. Stack a -> a
W.focus forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Stack Window)
ws of
    Maybe Window
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Just Window
win -> do
      (Bool
_,Window
_,Window
_,CInt
_,CInt
_,CInt
mx,CInt
my,Modifier
_) <- forall a. (Display -> X a) -> X a
withDisplay (\Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
d Window
win)
      let oldrect :: Rectangle
oldrect@(Rectangle Position
_ Position
_ Dimension
ow Dimension
oh) = forall a. a -> Maybe a -> a
fromMaybe (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
0 Dimension
0) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Window
win forall a b. (a -> b) -> a -> b
$ forall a. BinarySpacePartition a -> [(Window, Rectangle)]
getOldRects BinarySpacePartition Window
b
      let (Rational
xsc,Rational
ysc)   = (forall a b. (Integral a, Num b) => a -> b
fi Dimension
w forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fi Dimension
ow, forall a b. (Integral a, Num b) => a -> b
fi Dimension
h forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fi Dimension
oh)
          (Rational
xsc',Rational
ysc') = (forall {a}. (Ord a, Fractional a) => a -> a
rough Rational
xsc, forall {a}. (Ord a, Fractional a) => a -> a
rough Rational
ysc)
          dirs :: [Direction2D]
dirs = Rectangle -> Rectangle -> (Int, Int) -> [Direction2D]
changedDirs Rectangle
oldrect Rectangle
newrect (forall a b. (Integral a, Num b) => a -> b
fi CInt
mx,forall a b. (Integral a, Num b) => a -> b
fi CInt
my)
          n :: Maybe Int
n = forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Window
win forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. Stack a -> [a]
W.integrate forall a b. (a -> b) -> a -> b
$ [Window]
-> [Window] -> Maybe (Stack Window) -> Maybe (Stack Window)
withoutFloating [Window]
fs [Window]
hs Maybe (Stack Window)
ws
      -- unless (isNothing dir) $ debug $
      --       show (fi x-fi ox,fi y-fi oy) ++ show (fi w-fi ow,fi h-fi oh)
      --       ++ show dir ++ " " ++ show win ++ " " ++ show (mx,my)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Int
n of
                Just Int
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\BinarySpacePartition Window
b' Direction2D
d -> forall a.
Direction2D
-> (Rational, Rational)
-> BinarySpacePartition a
-> BinarySpacePartition a
resizeSplitNth Direction2D
d (Rational
xsc',Rational
ysc') BinarySpacePartition Window
b') BinarySpacePartition Window
b [Direction2D]
dirs
                Maybe Int
Nothing -> forall a. Maybe a
Nothing --focused window is floating -> ignore
  where rough :: a -> a
rough a
v = forall a. Ord a => a -> a -> a
min a
1.5 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max a
0.75 a
v -- extreme scale factors are forbidden
handleResize BinarySpacePartition Window
_ WindowArrangerMsg
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- find out which borders have been pulled. We need the old and new rects and the mouse coordinates
changedDirs :: Rectangle -> Rectangle -> (Int,Int) -> [Direction2D]
changedDirs :: Rectangle -> Rectangle -> (Int, Int) -> [Direction2D]
changedDirs (Rectangle Position
_ Position
_ Dimension
ow Dimension
oh) (Rectangle Position
_ Position
_ Dimension
w Dimension
h) (Int
mx,Int
my) = forall a. [Maybe a] -> [a]
catMaybes [Maybe Direction2D
lr, Maybe Direction2D
ud]
 where lr :: Maybe Direction2D
lr = if Dimension
owforall a. Eq a => a -> a -> Bool
==Dimension
w then forall a. Maybe a
Nothing
            else forall a. a -> Maybe a
Just (if (forall a b. (Integral a, Num b) => a -> b
fi Int
mx :: Double) forall a. Ord a => a -> a -> Bool
>  (forall a b. (Integral a, Num b) => a -> b
fi Dimension
ow :: Double)forall a. Fractional a => a -> a -> a
/Double
2 then Direction2D
R else Direction2D
L)
       ud :: Maybe Direction2D
ud = if Dimension
ohforall a. Eq a => a -> a -> Bool
==Dimension
h then forall a. Maybe a
Nothing
            else forall a. a -> Maybe a
Just (if (forall a b. (Integral a, Num b) => a -> b
fi Int
my :: Double) forall a. Ord a => a -> a -> Bool
> (forall a b. (Integral a, Num b) => a -> b
fi Dimension
oh :: Double)forall a. Fractional a => a -> a -> a
/Double
2 then Direction2D
D else Direction2D
U)

-- node focus border helpers
----------------------------
updateNodeRef :: BinarySpacePartition Window -> Bool -> Rectangle -> X (BinarySpacePartition Window)
updateNodeRef :: BinarySpacePartition Window
-> Bool -> Rectangle -> X (BinarySpacePartition Window)
updateNodeRef BinarySpacePartition Window
b Bool
force Rectangle
r = do
    let n :: NodeRef
n = forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Window
b
    let s :: NodeRef
s = forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition Window
b
    [Window] -> X ()
removeBorder (NodeRef -> [Window]
refWins NodeRef
nforall a. [a] -> [a] -> [a]
++NodeRef -> [Window]
refWins NodeRef
s)
    Int
l <- X Int
getCurrFocused
    BinarySpacePartition Window
b' <- if NodeRef -> Int
refLeaf NodeRef
n forall a. Eq a => a -> a -> Bool
/= Int
l Bool -> Bool -> Bool
|| NodeRef -> Int
refLeaf NodeRef
n forall a. Eq a => a -> a -> Bool
== (-Int
1) Bool -> Bool -> Bool
|| Bool
force
            then forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Window
b{getFocusedNode :: NodeRef
getFocusedNode=forall a. Int -> BinarySpacePartition a -> NodeRef
leafToNodeRef Int
l BinarySpacePartition Window
b}
            else forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Window
b
    BinarySpacePartition Window
b'' <- if Bool
force then forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Window
b'{getSelectedNode :: NodeRef
getSelectedNode=NodeRef
noRef} else forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Window
b'
    forall a.
Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a)
renderBorders Rectangle
r BinarySpacePartition Window
b''
  where getCurrFocused :: X Int
getCurrFocused = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a. Stack a -> Int
index forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Window]
-> [Window] -> Maybe (Stack Window) -> Maybe (Stack Window)
withoutFloating forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X [Window]
getFloating forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> X [Window]
getHidden forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> X (Maybe (Stack Window))
getStackSet)

-- create border around focused node if necessary
renderBorders :: Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a)
renderBorders :: forall a.
Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a)
renderBorders Rectangle
r BinarySpacePartition a
b = do
  let l :: Maybe Int
l = forall a. NodeRef -> Maybe (Zipper a) -> Maybe Int
nodeRefToLeaf (forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition a
b) forall a b. (a -> b) -> a -> b
$ forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b
  [Window]
wssel <- if NodeRef -> Int
refLeaf (forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition a
b)forall a. Eq a => a -> a -> Bool
/=(-Int
1)
           then Rectangle -> Maybe String -> X [Window]
createBorder (forall a.
BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
getNodeRect BinarySpacePartition a
b Rectangle
r (forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition a
b)) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
"#00ff00"
           else forall (m :: * -> *) a. Monad m => a -> m a
return []
  let b' :: BinarySpacePartition a
b' = BinarySpacePartition a
b{getSelectedNode :: NodeRef
getSelectedNode=(forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition a
b){refWins :: [Window]
refWins=[Window]
wssel}}
  if NodeRef -> Int
refLeaf (forall a. BinarySpacePartition a -> NodeRef
getFocusedNode forall a. BinarySpacePartition a
b')forall a. Eq a => a -> a -> Bool
==(-Int
1) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe Int
l Bool -> Bool -> Bool
|| forall a. BinarySpacePartition a -> Int
size forall a. BinarySpacePartition a
b'forall a. Ord a => a -> a -> Bool
<Int
2 then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. BinarySpacePartition a
b'
    else do
      [Window]
ws' <- Rectangle -> Maybe String -> X [Window]
createBorder (forall a.
BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
getNodeRect forall a. BinarySpacePartition a
b' Rectangle
r (forall a. BinarySpacePartition a -> NodeRef
getFocusedNode forall a. BinarySpacePartition a
b')) forall a. Maybe a
Nothing
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. BinarySpacePartition a
b'{getFocusedNode :: NodeRef
getFocusedNode=(forall a. BinarySpacePartition a -> NodeRef
getFocusedNode forall a. BinarySpacePartition a
b'){refWins :: [Window]
refWins=[Window]
ws'}}

-- create a window for each border line, show, add into stack and set floating
createBorder :: Rectangle -> Maybe String -> X [Window]
createBorder :: Rectangle -> Maybe String -> X [Window]
createBorder (Rectangle Position
wx Position
wy Dimension
ww Dimension
wh) Maybe String
c = do
  Dimension
bw <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> Dimension
borderWidthforall b c a. (b -> c) -> (a -> b) -> a -> c
.XConf -> XConfig Layout
config)
  String
bc <- case Maybe String
c of
         Maybe String
Nothing -> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> String
focusedBorderColorforall b c a. (b -> c) -> (a -> b) -> a -> c
.XConf -> XConfig Layout
config)
         Just String
s -> forall (m :: * -> *) a. Monad m => a -> m a
return String
s
  let rects :: [Rectangle]
rects = [ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
wx Position
wy Dimension
ww (forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw)
              , Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
wx Position
wy (forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Dimension
wh
              , Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
wx (Position
wyforall a. Num a => a -> a -> a
+forall a b. (Integral a, Num b) => a -> b
fi Dimension
whforall a. Num a => a -> a -> a
-forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Dimension
ww (forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw)
              , Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
wxforall a. Num a => a -> a -> a
+forall a b. (Integral a, Num b) => a -> b
fi Dimension
wwforall a. Num a => a -> a -> a
-forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Position
wy (forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Dimension
wh
              ]
  [Window]
ws <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Rectangle
r -> Rectangle -> Maybe Window -> String -> Bool -> X Window
createNewWindow Rectangle
r forall a. Maybe a
Nothing String
bc Bool
False) [Rectangle]
rects
  [Window] -> X ()
showWindows [Window]
ws
  Maybe (Stack Window) -> X ()
replaceStack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (\Stack Window
s -> forall a. a -> Maybe a
Just Stack Window
s{down :: [Window]
W.down=forall a. Stack a -> [a]
W.down Stack Window
s forall a. [a] -> [a] -> [a]
++ [Window]
ws}) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X (Maybe (Stack Window))
getStackSet
  Map Window RationalRect -> X ()
replaceFloating forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
ws forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> RationalRect
toRR [Rectangle]
rects) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *). MonadState s m => m s
get
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s{mapped :: Set Window
mapped=XState -> Set Window
mapped XState
s forall a. Ord a => Set a -> Set a -> Set a
`S.union` forall a. Ord a => [a] -> Set a
S.fromList [Window]
ws})
  -- show <$> mapM isClient ws >>= debug
  forall (m :: * -> *) a. Monad m => a -> m a
return [Window]
ws
  where toRR :: Rectangle -> RationalRect
toRR (Rectangle Position
x Position
y Dimension
w Dimension
h) = Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect (forall a b. (Integral a, Num b) => a -> b
fi Position
x) (forall a b. (Integral a, Num b) => a -> b
fi Position
y) (forall a b. (Integral a, Num b) => a -> b
fi Dimension
w) (forall a b. (Integral a, Num b) => a -> b
fi Dimension
h)

-- remove border line windows from stack + floating, kill
removeBorder :: [Window] -> X ()
removeBorder :: [Window] -> X ()
removeBorder [Window]
ws = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s{mapped :: Set Window
mapped = XState -> Set Window
mapped XState
s forall a. Ord a => Set a -> Set a -> Set a
`S.difference` forall a. Ord a => [a] -> Set a
S.fromList [Window]
ws})
  Map Window RationalRect -> X ()
replaceFloating forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Map k a
M.delete)) [Window]
ws forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *). MonadState s m => m s
get
  Maybe (Stack Window) -> X ()
replaceStack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (\Stack Window
s -> forall a. a -> Maybe a
Just Stack Window
s{down :: [Window]
W.down=forall a. Stack a -> [a]
W.down Stack Window
s forall a. Eq a => [a] -> [a] -> [a]
\\ [Window]
ws}) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X (Maybe (Stack Window))
getStackSet
  [Window] -> X ()
deleteWindows [Window]
ws