{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module XMonad.Layout.BinarySpacePartition (
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
import XMonad.Layout.WindowArranger (WindowArrangerMsg(SetGeometry))
import XMonad.Util.XUtils
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Ratio ((%))
data TreeRotate = RotateL | RotateR
instance Message TreeRotate
data TreeBalance = Balance | Equalize
instance Message TreeBalance
data ResizeDirectional =
ExpandTowardsBy Direction2D Rational
| ShrinkFromBy Direction2D Rational
| MoveSplitBy Direction2D Rational
instance Message ResizeDirectional
pattern ExpandTowards :: Direction2D -> ResizeDirectional
pattern $bExpandTowards :: Direction2D -> ResizeDirectional
$mExpandTowards :: forall {r}.
ResizeDirectional -> (Direction2D -> r) -> ((# #) -> r) -> r
ExpandTowards d = ExpandTowardsBy d 0.05
pattern ShrinkFrom :: Direction2D -> ResizeDirectional
pattern $bShrinkFrom :: Direction2D -> ResizeDirectional
$mShrinkFrom :: forall {r}.
ResizeDirectional -> (Direction2D -> r) -> ((# #) -> r) -> r
ShrinkFrom d = ShrinkFromBy d 0.05
pattern MoveSplit :: Direction2D -> ResizeDirectional
pattern $bMoveSplit :: Direction2D -> ResizeDirectional
$mMoveSplit :: forall {r}.
ResizeDirectional -> (Direction2D -> r) -> ((# #) -> r) -> r
MoveSplit d = MoveSplitBy d 0.05
data Rotate = Rotate
instance Message Rotate
data Swap = Swap
instance Message Swap
data FocusParent = FocusParent
instance Message FocusParent
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)
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
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
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
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
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
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
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
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
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
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)
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))
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
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
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)
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
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
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)]
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
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, [])
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
adjustStack :: Maybe (W.Stack Window)
-> Maybe (W.Stack Window)
-> [Window]
-> Maybe (BinarySpacePartition Window)
-> Maybe (W.Stack Window)
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
adjustStack Maybe (Stack Window)
orig Maybe (Stack Window)
_ [Window]
_ Maybe (BinarySpacePartition Window)
Nothing = Maybe (Stack Window)
orig
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
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
ls :: [Int]
ls = forall a. BinarySpacePartition a -> [Int]
flattenLeaves BinarySpacePartition Window
b
([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
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}}
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
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
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)
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
let lws :: Maybe (Stack Window)
lws = [Window]
-> [Window] -> Maybe (Stack Window) -> Maybe (Stack Window)
withoutFloating [Window]
fs [Window]
hs Maybe (Stack Window)
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
b' :: Maybe (BinarySpacePartition Window)
b' = Rectangle -> Maybe (BinarySpacePartition Window)
handleMesg Rectangle
r
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'
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
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"
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
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
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
handleResize BinarySpacePartition Window
_ WindowArrangerMsg
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
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)
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)
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'}}
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})
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)
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