{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
module XMonad.Layout.BinarySpacePartition (
emptyBSP
, BinarySpacePartition
, Rotate(..)
, Swap(..)
, ResizeDirectional(..)
, TreeRotate(..)
, TreeBalance(..)
, FocusParent(..)
, SelectMoveNode(..)
, Direction2D(..)
, SplitShiftDirectional(..)
) where
import XMonad
import qualified XMonad.StackSet as W
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.List ((\\), elemIndex, foldl')
import Data.Maybe (fromMaybe, isNothing, isJust, mapMaybe, catMaybes)
import Control.Applicative
import Control.Monad
import Data.Ratio ((%))
data TreeRotate = RotateL | RotateR deriving Typeable
instance Message TreeRotate
data TreeBalance = Balance | Equalize deriving Typeable
instance Message TreeBalance
data ResizeDirectional = ExpandTowards Direction2D | ShrinkFrom Direction2D | MoveSplit Direction2D deriving Typeable
instance Message ResizeDirectional
data Rotate = Rotate deriving Typeable
instance Message Rotate
data Swap = Swap deriving Typeable
instance Message Swap
data FocusParent = FocusParent deriving Typeable
instance Message FocusParent
data SelectMoveNode = SelectNode | MoveNode deriving Typeable
instance Message SelectMoveNode
data Axis = Horizontal | Vertical deriving (Int -> Axis -> ShowS
[Axis] -> ShowS
Axis -> String
(Int -> Axis -> ShowS)
-> (Axis -> String) -> ([Axis] -> ShowS) -> Show Axis
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]
(Int -> ReadS Axis)
-> ReadS [Axis] -> ReadPrec Axis -> ReadPrec [Axis] -> Read 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
(Axis -> Axis -> Bool) -> (Axis -> Axis -> Bool) -> Eq Axis
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)
data SplitShiftDirectional = SplitShift Direction1D deriving Typeable
instance Message SplitShiftDirectional
oppositeDirection :: Direction2D -> Direction2D
oppositeDirection :: Direction2D -> Direction2D
oppositeDirection U = Direction2D
D
oppositeDirection D = Direction2D
U
oppositeDirection L = Direction2D
R
oppositeDirection R = Direction2D
L
oppositeAxis :: Axis -> Axis
oppositeAxis :: Axis -> Axis
oppositeAxis Vertical = Axis
Horizontal
oppositeAxis Horizontal = Axis
Vertical
toAxis :: Direction2D -> Axis
toAxis :: Direction2D -> Axis
toAxis U = Axis
Horizontal
toAxis D = Axis
Horizontal
toAxis L = Axis
Vertical
toAxis R = Axis
Vertical
split :: Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split :: Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split Horizontal r :: Rational
r (Rectangle sx :: Position
sx sy :: Position
sy sw :: Dimension
sw sh :: 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 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh') Dimension
sw (Dimension
sh Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
sh')
sh' :: Dimension
sh' = Rational -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Dimension) -> Rational -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r
split Vertical r :: Rational
r (Rectangle sx :: Position
sx sy :: Position
sy sw :: Dimension
sw sh :: 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 -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw') Position
sy (Dimension
sw Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
sw') Dimension
sh
sw' :: Dimension
sw' = Rational -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Dimension) -> Rational -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw Rational -> Rational -> Rational
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
(Int -> Split -> ShowS)
-> (Split -> String) -> ([Split] -> ShowS) -> Show Split
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]
(Int -> ReadS Split)
-> ReadS [Split]
-> ReadPrec Split
-> ReadPrec [Split]
-> Read 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
(Split -> Split -> Bool) -> (Split -> Split -> Bool) -> Eq Split
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 d :: Axis
d r :: Rational
r) = Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis Axis
d) Rational
r
increaseRatio :: Split -> Rational -> Split
increaseRatio :: Split -> Rational -> Split
increaseRatio (Split d :: Axis
d r :: Rational
r) delta :: Rational
delta = Axis -> Rational -> Split
Split Axis
d (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min 0.9 (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max 0.1 (Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
delta)))
resizeDiff :: Rational
resizeDiff :: Rational
resizeDiff = 0.05
data Tree a = Leaf Int | Node { Tree a -> a
value :: a
, Tree a -> Tree a
left :: Tree a
, Tree a -> Tree a
right :: Tree a
} deriving (Int -> Tree a -> ShowS
[Tree a] -> ShowS
Tree a -> String
(Int -> Tree a -> ShowS)
-> (Tree a -> String) -> ([Tree a] -> ShowS) -> Show (Tree a)
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)
Int -> ReadS (Tree a)
ReadS [Tree a]
(Int -> ReadS (Tree a))
-> ReadS [Tree a]
-> ReadPrec (Tree a)
-> ReadPrec [Tree a]
-> Read (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
(Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool) -> Eq (Tree a)
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 :: Tree a -> Int
numLeaves (Leaf _) = 1
numLeaves (Node _ l :: Tree a
l r :: Tree a
r) = Tree a -> Int
forall a. Tree a -> Int
numLeaves Tree a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tree a -> Int
forall a. Tree a -> Int
numLeaves Tree a
r
rotTree :: Direction2D -> Tree a -> Tree a
rotTree :: Direction2D -> Tree a -> Tree a
rotTree _ (Leaf n :: Int
n) = Int -> Tree a
forall a. Int -> Tree a
Leaf Int
n
rotTree R n :: Tree a
n@(Node _ (Leaf _) _) = Tree a
n
rotTree L n :: Tree a
n@(Node _ _ (Leaf _)) = Tree a
n
rotTree R (Node sp :: a
sp (Node sp2 :: a
sp2 l2 :: Tree a
l2 r2 :: Tree a
r2) r :: Tree a
r) = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
sp2 Tree a
l2 (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
sp Tree a
r2 Tree a
r)
rotTree L (Node sp :: a
sp l :: Tree a
l (Node sp2 :: a
sp2 l2 :: Tree a
l2 r2 :: Tree a
r2)) = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
sp2 (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
sp Tree a
l Tree a
l2) Tree a
r2
rotTree _ t :: Tree a
t = Tree a
t
data Crumb a = LeftCrumb a (Tree a) | RightCrumb a (Tree a) deriving (Int -> Crumb a -> ShowS
[Crumb a] -> ShowS
Crumb a -> String
(Int -> Crumb a -> ShowS)
-> (Crumb a -> String) -> ([Crumb a] -> ShowS) -> Show (Crumb a)
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)
Int -> ReadS (Crumb a)
ReadS [Crumb a]
(Int -> ReadS (Crumb a))
-> ReadS [Crumb a]
-> ReadPrec (Crumb a)
-> ReadPrec [Crumb a]
-> Read (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
(Crumb a -> Crumb a -> Bool)
-> (Crumb a -> Crumb a -> Bool) -> Eq (Crumb a)
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 :: Crumb a -> Crumb a
swapCrumb (LeftCrumb s :: a
s t :: Tree a
t) = a -> Tree a -> Crumb a
forall a. a -> Tree a -> Crumb a
RightCrumb a
s Tree a
t
swapCrumb (RightCrumb s :: a
s t :: Tree a
t) = a -> Tree a -> Crumb a
forall a. a -> Tree a -> Crumb a
LeftCrumb a
s Tree a
t
parentVal :: Crumb a -> a
parentVal :: Crumb a -> a
parentVal (LeftCrumb s :: a
s _) = a
s
parentVal (RightCrumb s :: a
s _) = a
s
modifyParentVal :: (a -> a) -> Crumb a -> Crumb a
modifyParentVal :: (a -> a) -> Crumb a -> Crumb a
modifyParentVal f :: a -> a
f (LeftCrumb s :: a
s t :: Tree a
t) = a -> Tree a -> Crumb a
forall a. a -> Tree a -> Crumb a
LeftCrumb (a -> a
f a
s) Tree a
t
modifyParentVal f :: a -> a
f (RightCrumb s :: a
s t :: Tree a
t) = a -> Tree a -> Crumb a
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 :: Tree a -> Zipper a
toZipper t :: Tree a
t = (Tree a
t, [])
goLeft :: Zipper a -> Maybe (Zipper a)
goLeft :: Zipper a -> Maybe (Zipper a)
goLeft (Leaf _, _) = Maybe (Zipper a)
forall a. Maybe a
Nothing
goLeft (Node x :: a
x l :: Tree a
l r :: Tree a
r, bs :: [Crumb a]
bs) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just (Tree a
l, a -> Tree a -> Crumb a
forall a. a -> Tree a -> Crumb a
LeftCrumb a
x Tree a
rCrumb a -> [Crumb a] -> [Crumb a]
forall a. a -> [a] -> [a]
:[Crumb a]
bs)
goRight :: Zipper a -> Maybe (Zipper a)
goRight :: Zipper a -> Maybe (Zipper a)
goRight (Leaf _, _) = Maybe (Zipper a)
forall a. Maybe a
Nothing
goRight (Node x :: a
x l :: Tree a
l r :: Tree a
r, bs :: [Crumb a]
bs) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just (Tree a
r, a -> Tree a -> Crumb a
forall a. a -> Tree a -> Crumb a
RightCrumb a
x Tree a
lCrumb a -> [Crumb a] -> [Crumb a]
forall a. a -> [a] -> [a]
:[Crumb a]
bs)
goUp :: Zipper a -> Maybe (Zipper a)
goUp :: Zipper a -> Maybe (Zipper a)
goUp (_, []) = Maybe (Zipper a)
forall a. Maybe a
Nothing
goUp (t :: Tree a
t, LeftCrumb x :: a
x r :: Tree a
r:cs :: [Crumb a]
cs) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
x Tree a
t Tree a
r, [Crumb a]
cs)
goUp (t :: Tree a
t, RightCrumb x :: a
x l :: Tree a
l:cs :: [Crumb a]
cs) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just (a -> Tree a -> Tree a -> Tree a
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 :: Zipper a -> Maybe (Zipper a)
goSibling (_, []) = Maybe (Zipper a)
forall a. Maybe a
Nothing
goSibling z :: Zipper a
z@(_, LeftCrumb _ _:_) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just Zipper a
z Maybe (Zipper a)
-> (Zipper a -> Maybe (Zipper a)) -> Maybe (Zipper a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goUp Maybe (Zipper a)
-> (Zipper a -> Maybe (Zipper a)) -> Maybe (Zipper a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goRight
goSibling z :: Zipper a
z@(_, RightCrumb _ _:_) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just Zipper a
z Maybe (Zipper a)
-> (Zipper a -> Maybe (Zipper a)) -> Maybe (Zipper a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goUp Maybe (Zipper a)
-> (Zipper a -> Maybe (Zipper a)) -> Maybe (Zipper a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goLeft
top :: Zipper a -> Zipper a
top :: Zipper a -> Zipper a
top z :: Zipper a
z = case Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper a
z of
Nothing -> Zipper a
z
Just z' :: Zipper a
z' -> Zipper a -> Zipper a
forall a. Zipper a -> Zipper a
top Zipper a
z'
toTree :: Zipper a -> Tree a
toTree :: Zipper a -> Tree a
toTree = Zipper a -> Tree a
forall a b. (a, b) -> a
fst (Zipper a -> Tree a)
-> (Zipper a -> Zipper a) -> Zipper a -> Tree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper a -> Zipper a
forall a. Zipper a -> Zipper a
top
goToNthLeaf :: Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf :: Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf _ z :: Zipper a
z@(Leaf _, _) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just Zipper a
z
goToNthLeaf n :: Int
n z :: Zipper a
z@(t :: Tree a
t, _) =
if Tree a -> Int
forall a. Tree a -> Int
numLeaves (Tree a -> Tree a
forall a. Tree a -> Tree a
left Tree a
t) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n
then do Zipper a
z' <- Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goLeft Zipper a
z
Int -> Zipper a -> Maybe (Zipper a)
forall a. Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf Int
n Zipper a
z'
else do Zipper a
z' <- Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goRight Zipper a
z
Int -> Zipper a -> Maybe (Zipper a)
forall a. Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Tree a -> Int
forall a. Tree a -> Int
numLeaves (Tree a -> Int) -> (Tree a -> Tree a) -> Tree a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> Tree a
forall a. Tree a -> Tree a
left (Tree a -> Int) -> Tree a -> Int
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 l :: Int
l) = Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
l
toggleSplits (Node s :: Split
s l :: Tree Split
l r :: Tree Split
r) = Split -> Tree Split -> Tree Split -> Tree Split
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 _, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Vertical 0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf 0) (Int -> Tree Split
forall a. Int -> Tree a
Leaf 0), [])
splitCurrent (Leaf _, crumb :: Crumb Split
crumb:cs :: [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) 0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf 0) (Int -> Tree Split
forall a. Int -> Tree a
Leaf 0), Crumb Split
crumbCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
splitCurrent (n :: Tree Split
n, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Vertical 0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf 0) (Tree Split -> Tree Split
toggleSplits Tree Split
n), [])
splitCurrent (n :: Tree Split
n, crumb :: Crumb Split
crumb:cs :: [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) 0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf 0) (Tree Split -> Tree Split
toggleSplits Tree Split
n), Crumb Split
crumbCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
removeCurrent :: Zipper a -> Maybe (Zipper a)
removeCurrent :: Zipper a -> Maybe (Zipper a)
removeCurrent (Leaf _, LeftCrumb _ r :: Tree a
r:cs :: [Crumb a]
cs) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just (Tree a
r, [Crumb a]
cs)
removeCurrent (Leaf _, RightCrumb _ l :: Tree a
l:cs :: [Crumb a]
cs) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just (Tree a
l, [Crumb a]
cs)
removeCurrent (Leaf _, []) = Maybe (Zipper a)
forall a. Maybe a
Nothing
removeCurrent (Node _ (Leaf _) r :: Tree a
r@(Node _ _ _), cs :: [Crumb a]
cs) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just (Tree a
r, [Crumb a]
cs)
removeCurrent (Node _ l :: Tree a
l@(Node _ _ _) (Leaf _), cs :: [Crumb a]
cs) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just (Tree a
l, [Crumb a]
cs)
removeCurrent (Node _ (Leaf _) (Leaf _), cs :: [Crumb a]
cs) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just (Int -> Tree a
forall a. Int -> Tree a
Leaf 0, [Crumb a]
cs)
removeCurrent z :: Zipper a
z@(Node _ _ _, _) = Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goLeft Zipper a
z Maybe (Zipper a)
-> (Zipper a -> Maybe (Zipper a)) -> Maybe (Zipper a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper a -> Maybe (Zipper a)
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@(_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
l
rotateCurrent (n :: Tree Split
n, c :: Crumb Split
c:cs :: [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Tree Split
n, (Split -> Split) -> Crumb Split -> Crumb Split
forall a. (a -> a) -> Crumb a -> Crumb a
modifyParentVal Split -> Split
oppositeSplit Crumb Split
cCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
swapCurrent :: Zipper a -> Maybe (Zipper a)
swapCurrent :: Zipper a -> Maybe (Zipper a)
swapCurrent l :: Zipper a
l@(_, []) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just Zipper a
l
swapCurrent (n :: Tree a
n, c :: Crumb a
c:cs :: [Crumb a]
cs) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just (Tree a
n, Crumb a -> Crumb a
forall a. Crumb a -> Crumb a
swapCrumb Crumb a
cCrumb a -> [Crumb a] -> [Crumb a]
forall 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 n :: Int
n) ((Node x :: Split
x l :: Tree Split
l r :: Tree Split
r), crumb :: Crumb Split
crumb:cs :: [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) 0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
n) (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node Split
x Tree Split
l Tree Split
r), Crumb Split
crumbCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
insertLeftLeaf (Leaf n :: Int
n) (Leaf x :: Int
x, crumb :: Crumb Split
crumb:cs :: [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) 0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
n) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
x), Crumb Split
crumbCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
insertLeftLeaf (Node _ _ _) z :: Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertRightLeaf (Leaf n :: Int
n) ((Node x :: Split
x l :: Tree Split
l r :: Tree Split
r), crumb :: Crumb Split
crumb:cs :: [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) 0.5) (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node Split
x Tree Split
l Tree Split
r) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
n), Crumb Split
crumbCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
insertRightLeaf (Leaf n :: Int
n) (Leaf x :: Int
x, crumb :: Crumb Split
crumb:cs :: [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) 0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
x) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
n), Crumb Split
crumbCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
insertRightLeaf (Node _ _ _) z :: Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
findRightLeaf :: Zipper Split -> Maybe (Zipper Split)
findRightLeaf :: Zipper Split -> Maybe (Zipper Split)
findRightLeaf n :: Zipper Split
n@(Node _ _ _, _) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goRight Zipper Split
n Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
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 _, _) = Zipper Split -> Maybe (Zipper 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 _ _ _, _) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goLeft Zipper Split
n
findLeftLeaf l :: Zipper Split
l@(Leaf _, _) = Zipper Split -> Maybe (Zipper 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@(_, (RightCrumb _ _):_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
s Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goLeft Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findRightLeaf
findTheClosestLeftmostLeaf s :: Zipper Split
s@(_, (LeftCrumb _ _):_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
s Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findTheClosestLeftmostLeaf
findTheClosestRightmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf s :: Zipper Split
s@(_, (RightCrumb _ _):_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
s Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf
findTheClosestRightmostLeaf s :: Zipper Split
s@(_, (LeftCrumb _ _):_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
s Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goRight Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findLeftLeaf
splitShiftLeftCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftLeftCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftLeftCurrent l :: Zipper Split
l@(_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
l
splitShiftLeftCurrent l :: Zipper Split
l@(_, (RightCrumb _ _):_) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
l
splitShiftLeftCurrent l :: Zipper Split
l@(n :: Tree Split
n, c :: Crumb Split
c:cs :: [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
removeCurrent Zipper Split
l Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findTheClosestLeftmostLeaf Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
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@(_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
l
splitShiftRightCurrent l :: Zipper Split
l@(_, (LeftCrumb _ _):_) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
l
splitShiftRightCurrent l :: Zipper Split
l@(n :: Tree Split
n, c :: Crumb Split
c:cs :: [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
removeCurrent Zipper Split
l Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
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 -> Zipper Split -> Bool
isAllTheWay :: Direction2D -> Zipper Split -> Bool
isAllTheWay _ (_, []) = Bool
True
isAllTheWay R (_, LeftCrumb s :: Split
s _:_)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Bool
False
isAllTheWay L (_, RightCrumb s :: Split
s _:_)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Bool
False
isAllTheWay D (_, LeftCrumb s :: Split
s _:_)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Bool
False
isAllTheWay U (_, RightCrumb s :: Split
s _:_)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Bool
False
isAllTheWay dir :: Direction2D
dir z :: Zipper Split
z = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split) -> (Zipper Split -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool)
-> (Zipper Split -> Bool) -> Zipper Split -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction2D -> Zipper Split -> Bool
isAllTheWay Direction2D
dir
expandTreeTowards :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards _ z :: Zipper Split
z@(_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
expandTreeTowards dir :: Direction2D
dir z :: Zipper Split
z
| Direction2D -> Zipper Split -> Bool
isAllTheWay Direction2D
dir Zipper Split
z = Direction2D -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom (Direction2D -> Direction2D
oppositeDirection Direction2D
dir) Zipper Split
z
expandTreeTowards R (t :: Tree Split
t, LeftCrumb s :: Split
s r :: Tree Split
r:cs :: [Crumb Split]
cs)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Tree Split
t, Split -> Tree Split -> Crumb Split
forall a. a -> Tree a -> Crumb a
LeftCrumb (Split -> Rational -> Split
increaseRatio Split
s Rational
resizeDiff) Tree Split
rCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
expandTreeTowards L (t :: Tree Split
t, RightCrumb s :: Split
s l :: Tree Split
l:cs :: [Crumb Split]
cs)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Tree Split
t, Split -> Tree Split -> Crumb Split
forall a. a -> Tree a -> Crumb a
RightCrumb (Split -> Rational -> Split
increaseRatio Split
s (-Rational
resizeDiff)) Tree Split
lCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
expandTreeTowards D (t :: Tree Split
t, LeftCrumb s :: Split
s r :: Tree Split
r:cs :: [Crumb Split]
cs)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Tree Split
t, Split -> Tree Split -> Crumb Split
forall a. a -> Tree a -> Crumb a
LeftCrumb (Split -> Rational -> Split
increaseRatio Split
s Rational
resizeDiff) Tree Split
rCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
expandTreeTowards U (t :: Tree Split
t, RightCrumb s :: Split
s l :: Tree Split
l:cs :: [Crumb Split]
cs)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Tree Split
t, Split -> Tree Split -> Crumb Split
forall a. a -> Tree a -> Crumb a
RightCrumb (Split -> Rational -> Split
increaseRatio Split
s (-Rational
resizeDiff)) Tree Split
lCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
expandTreeTowards dir :: Direction2D
dir z :: Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
dir
shrinkTreeFrom :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom _ z :: Zipper Split
z@(_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
shrinkTreeFrom R z :: Zipper Split
z@(_, LeftCrumb s :: Split
s _:_)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goSibling Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
L
shrinkTreeFrom L z :: Zipper Split
z@(_, RightCrumb s :: Split
s _:_)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goSibling Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
R
shrinkTreeFrom D z :: Zipper Split
z@(_, LeftCrumb s :: Split
s _:_)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goSibling Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
U
shrinkTreeFrom U z :: Zipper Split
z@(_, RightCrumb s :: Split
s _:_)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goSibling Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
D
shrinkTreeFrom dir :: Direction2D
dir z :: Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom Direction2D
dir
autoSizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
autoSizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
autoSizeTree _ z :: Zipper Split
z@(_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
autoSizeTree d :: Direction2D
d z :: Zipper Split
z =
Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
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) Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
resizeTree Direction2D
d
resizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
resizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
resizeTree _ z :: Zipper Split
z@(_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
resizeTree R z :: Zipper Split
z@(_, LeftCrumb _ _:_) =
Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
R
resizeTree L z :: Zipper Split
z@(_, LeftCrumb _ _:_) =
Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom Direction2D
R
resizeTree U z :: Zipper Split
z@(_, LeftCrumb _ _:_) =
Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom Direction2D
D
resizeTree D z :: Zipper Split
z@(_, LeftCrumb _ _:_) =
Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
D
resizeTree R z :: Zipper Split
z@(_, RightCrumb _ _:_) =
Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom Direction2D
L
resizeTree L z :: Zipper Split
z@(_, RightCrumb _ _:_) =
Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
L
resizeTree U z :: Zipper Split
z@(_, RightCrumb _ _:_) =
Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
U
resizeTree D z :: Zipper Split
z@(_, RightCrumb _ _:_) =
Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom Direction2D
U
getSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
getSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
getSplit _ (_, []) = Maybe (Zipper Split)
forall a. Maybe a
Nothing
getSplit d :: Axis
d z :: Zipper Split
z =
do let fs :: Maybe (Zipper Split)
fs = Axis -> Zipper Split -> Maybe (Zipper Split)
findSplit Axis
d Zipper Split
z
if Maybe (Zipper Split) -> Bool
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 _ z :: Zipper Split
z@(_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
findClosest d :: Axis
d z :: Zipper Split
z@(_, LeftCrumb s :: Split
s _:_)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
d = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
findClosest d :: Axis
d z :: Zipper Split
z@(_, RightCrumb s :: Split
s _:_)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
d = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
findClosest d :: Axis
d z :: Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
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 _ (_, []) = Maybe (Zipper Split)
forall a. Maybe a
Nothing
findSplit d :: Axis
d z :: Zipper Split
z@(_, LeftCrumb s :: Split
s _:_)
| Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
d = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
findSplit d :: Axis
d z :: Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
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 _ _ z :: Zipper Split
z@(_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
resizeSplit dir :: Direction2D
dir (xsc :: Rational
xsc,ysc :: Rational
ysc) z :: Zipper Split
z = case Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
dir Zipper Split
z of
Nothing -> Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
Just (t :: Tree Split
t, crumb :: [Crumb Split]
crumb) -> Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Zipper Split -> Maybe (Zipper Split))
-> Zipper Split -> Maybe (Zipper Split)
forall a b. (a -> b) -> a -> b
$ case Direction2D
dir of
R -> (Tree Split
t{value :: Split
value=Split
sp{ratio :: Rational
ratio=Rational -> Rational -> Rational
forall a. (Ord a, Fractional a) => a -> a -> a
scaleRatio (Split -> Rational
ratio Split
sp) Rational
xsc}}, [Crumb Split]
crumb)
D -> (Tree Split
t{value :: Split
value=Split
sp{ratio :: Rational
ratio=Rational -> Rational -> Rational
forall a. (Ord a, Fractional a) => a -> a -> a
scaleRatio (Split -> Rational
ratio Split
sp) Rational
ysc}}, [Crumb Split]
crumb)
L -> (Tree Split
t{value :: Split
value=Split
sp{ratio :: Rational
ratio=1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational -> Rational -> Rational
forall a. (Ord a, Fractional a) => a -> a -> a
scaleRatio (1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Split -> Rational
ratio Split
sp) Rational
xsc}}, [Crumb Split]
crumb)
U -> (Tree Split
t{value :: Split
value=Split
sp{ratio :: Rational
ratio=1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational -> Rational -> Rational
forall a. (Ord a, Fractional a) => a -> a -> a
scaleRatio (1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Split -> Rational
ratio Split
sp) Rational
ysc}}, [Crumb Split]
crumb)
where sp :: Split
sp = Tree Split -> Split
forall a. Tree a -> a
value Tree Split
t
scaleRatio :: a -> a -> a
scaleRatio r :: a
r fac :: a
fac = a -> a -> a
forall a. Ord a => a -> a -> a
min 0.9 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
max 0.1 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
ra -> a -> a
forall a. Num a => a -> a -> a
*a
fac
goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder L z :: Zipper Split
z@(_, RightCrumb (Split Vertical _) _:_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z
goToBorder L z :: Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
L
goToBorder R z :: Zipper Split
z@(_, LeftCrumb (Split Vertical _) _:_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z
goToBorder R z :: Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
R
goToBorder U z :: Zipper Split
z@(_, RightCrumb (Split Horizontal _) _:_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z
goToBorder U z :: Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
U
goToBorder D z :: Zipper Split
z@(_, LeftCrumb (Split Horizontal _) _:_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z
goToBorder D z :: Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
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 :: [Int] -> Tree a -> Tree a
numerate ns :: [Int]
ns t :: Tree a
t = ([Int], Tree a) -> Tree a
forall a b. (a, b) -> b
snd (([Int], Tree a) -> Tree a) -> ([Int], Tree a) -> Tree a
forall a b. (a -> b) -> a -> b
$ [Int] -> Tree a -> ([Int], Tree a)
forall a. [Int] -> Tree a -> ([Int], Tree a)
num [Int]
ns Tree a
t
where num :: [Int] -> Tree a -> ([Int], Tree a)
num (n :: Int
n:nns :: [Int]
nns) (Leaf _) = ([Int]
nns, Int -> Tree a
forall a. Int -> Tree a
Leaf Int
n)
num [] (Leaf _) = ([], Int -> Tree a
forall a. Int -> Tree a
Leaf 0)
num n :: [Int]
n (Node s :: a
s l :: Tree a
l r :: Tree a
r) = ([Int]
n'', a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
s Tree a
nl Tree a
nr)
where (n' :: [Int]
n', nl :: Tree a
nl) = [Int] -> Tree a -> ([Int], Tree a)
num [Int]
n Tree a
l
(n'' :: [Int]
n'', nr :: Tree a
nr) = [Int] -> Tree a -> ([Int], Tree a)
num [Int]
n' Tree a
r
flatten :: Tree a -> [Int]
flatten :: Tree a -> [Int]
flatten (Leaf n :: Int
n) = [Int
n]
flatten (Node _ l :: Tree a
l r :: Tree a
r) = Tree a -> [Int]
forall a. Tree a -> [Int]
flatten Tree a
l[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++Tree a -> [Int]
forall a. Tree a -> [Int]
flatten Tree a
r
equalize :: Zipper Split -> Maybe (Zipper Split)
equalize :: Zipper Split -> Maybe (Zipper Split)
equalize (t :: Tree Split
t, cs :: [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
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 n :: Int
n) = Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
n
eql n :: Tree Split
n@(Node s :: Split
s l :: Tree Split
l r :: Tree Split
r) = Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node Split
s{ratio :: Rational
ratio=Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Tree Split -> Int
forall a. Tree a -> Int
numLeaves Tree Split
l) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Tree Split -> Int
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 (t :: Tree Split
t, cs :: [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just ([Int] -> Tree Split -> Tree Split
forall a. [Int] -> Tree a -> Tree a
numerate (Tree Split -> [Int]
forall a. Tree a -> [Int]
flatten Tree Split
t) (Tree Split -> Tree Split) -> Tree Split -> Tree Split
forall a b. (a -> b) -> a -> b
$ Int -> Tree Split
forall a. Integral a => a -> Tree Split
balanced (Tree Split -> Int
forall a. Tree a -> Int
numLeaves Tree Split
t), [Crumb Split]
cs)
where balanced :: a -> Tree Split
balanced 1 = Int -> Tree Split
forall a. Int -> Tree a
Leaf 0
balanced 2 = Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Horizontal 0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf 0) (Int -> Tree Split
forall a. Int -> Tree a
Leaf 0)
balanced m :: a
m = Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Horizontal 0.5) (a -> Tree Split
balanced (a
ma -> a -> a
forall a. Integral a => a -> a -> a
`div`2)) (a -> Tree Split
balanced (a
ma -> a -> a
forall a. Num a => a -> a -> a
-a
ma -> a -> a
forall a. Integral a => a -> a -> a
`div`2))
optimizeOrientation :: Rectangle -> Zipper Split -> Maybe (Zipper Split)
optimizeOrientation :: Rectangle -> Zipper Split -> Maybe (Zipper Split)
optimizeOrientation rct :: Rectangle
rct (t :: Tree Split
t, cs :: [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
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 v :: Int
v) _ = Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
v
opt (Node sp :: Split
sp l :: Tree Split
l r :: Tree Split
r) rect :: Rectangle
rect = Split -> Tree Split -> Tree Split -> Tree Split
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 _ _ w1 :: Dimension
w1 h1 :: Dimension
h1,Rectangle _ _ w2 :: Dimension
w2 h2 :: Dimension
h2) = Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split (Split -> Axis
axis Split
sp) (Split -> Rational
ratio Split
sp) Rectangle
rect
(Rectangle _ _ w3 :: Dimension
w3 h3 :: Dimension
h3,Rectangle _ _ w4 :: Dimension
w4 h4 :: Dimension
h4) = Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split (Split -> Axis
axis (Split -> Axis) -> Split -> 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 w :: a
w h :: a
h = if a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
h then Double
w'Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
h' else Double
h'Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
w' where (w' :: Double
w',h' :: Double
h') = (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w :: Double, a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
h :: Double)
wratio :: Double
wratio = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Dimension -> Dimension -> Double
forall a. Integral a => a -> a -> Double
f Dimension
w1 Dimension
h1) (Dimension -> Dimension -> Double
forall a. Integral a => a -> a -> Double
f Dimension
w2 Dimension
h2)
wratio' :: Double
wratio' = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Dimension -> Dimension -> Double
forall a. Integral a => a -> a -> Double
f Dimension
w3 Dimension
h3) (Dimension -> Dimension -> Double
forall a. Integral a => a -> a -> Double
f Dimension
w4 Dimension
h4)
sp' :: Split
sp' = if Double
wratioDouble -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<Double
wratio' then Split
sp else Split -> Split
oppositeSplit Split
sp
(lrect :: Rectangle
lrect, rrect :: 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 -> [Dimension]
refWins :: [Window] } deriving (Int -> NodeRef -> ShowS
[NodeRef] -> ShowS
NodeRef -> String
(Int -> NodeRef -> ShowS)
-> (NodeRef -> String) -> ([NodeRef] -> ShowS) -> Show NodeRef
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]
(Int -> ReadS NodeRef)
-> ReadS [NodeRef]
-> ReadPrec NodeRef
-> ReadPrec [NodeRef]
-> Read 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
(NodeRef -> NodeRef -> Bool)
-> (NodeRef -> NodeRef -> Bool) -> Eq NodeRef
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] -> [Dimension] -> NodeRef
NodeRef (-1) [] []
goToNode :: NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode :: NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode (NodeRef _ dirs :: [Direction2D]
dirs _) z :: Zipper a
z = (Zipper a -> Direction2D -> Maybe (Zipper a))
-> Zipper a -> [Direction2D] -> Maybe (Zipper a)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Zipper a -> Direction2D -> Maybe (Zipper a)
forall a. Zipper a -> Direction2D -> Maybe (Zipper a)
gofun Zipper a
z [Direction2D]
dirs
where gofun :: Zipper a -> Direction2D -> Maybe (Zipper a)
gofun z' :: Zipper a
z' L = Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goLeft Zipper a
z'
gofun z' :: Zipper a
z' R = Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goRight Zipper a
z'
gofun _ _ = Maybe (Zipper a)
forall a. Maybe a
Nothing
toNodeRef :: Int -> Maybe (Zipper Split) -> NodeRef
toNodeRef :: Int -> Maybe (Zipper Split) -> NodeRef
toNodeRef _ Nothing = NodeRef
noRef
toNodeRef l :: Int
l (Just (_, cs :: [Crumb Split]
cs)) = Int -> [Direction2D] -> [Dimension] -> NodeRef
NodeRef Int
l ([Direction2D] -> [Direction2D]
forall a. [a] -> [a]
reverse ([Direction2D] -> [Direction2D]) -> [Direction2D] -> [Direction2D]
forall a b. (a -> b) -> a -> b
$ (Crumb Split -> Direction2D) -> [Crumb Split] -> [Direction2D]
forall a b. (a -> b) -> [a] -> [b]
map Crumb Split -> Direction2D
forall a. Crumb a -> Direction2D
crumbToDir [Crumb Split]
cs) []
where crumbToDir :: Crumb a -> Direction2D
crumbToDir (LeftCrumb _ _) = Direction2D
L
crumbToDir (RightCrumb _ _) = Direction2D
R
nodeRefToLeaf :: NodeRef -> Maybe (Zipper a) -> Maybe Int
nodeRefToLeaf :: NodeRef -> Maybe (Zipper a) -> Maybe Int
nodeRefToLeaf n :: NodeRef
n (Just z :: Zipper a
z) = case NodeRef -> Zipper a -> Maybe (Zipper a)
forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
n Zipper a
z of
Just (Leaf l :: Int
l, _) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
l
Just (Node _ _ _, _) -> Maybe Int
forall a. Maybe a
Nothing
Nothing -> Maybe Int
forall a. Maybe a
Nothing
nodeRefToLeaf _ Nothing = Maybe Int
forall a. Maybe a
Nothing
leafToNodeRef :: Int -> BinarySpacePartition a -> NodeRef
leafToNodeRef :: Int -> BinarySpacePartition a -> NodeRef
leafToNodeRef l :: Int
l b :: BinarySpacePartition a
b = Int -> Maybe (Zipper Split) -> NodeRef
toNodeRef Int
l (BinarySpacePartition a -> Maybe (Zipper Split)
forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Zipper Split -> Maybe (Zipper Split)
forall a. Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf Int
l)
data BinarySpacePartition a = BinarySpacePartition { BinarySpacePartition a -> [(Dimension, Rectangle)]
getOldRects :: [(Window,Rectangle)]
, BinarySpacePartition a -> NodeRef
getFocusedNode :: NodeRef
, BinarySpacePartition a -> NodeRef
getSelectedNode :: NodeRef
, BinarySpacePartition a -> Maybe (Tree Split)
getTree :: Maybe (Tree Split) } deriving (Int -> BinarySpacePartition a -> ShowS
[BinarySpacePartition a] -> ShowS
BinarySpacePartition a -> String
(Int -> BinarySpacePartition a -> ShowS)
-> (BinarySpacePartition a -> String)
-> ([BinarySpacePartition a] -> ShowS)
-> Show (BinarySpacePartition a)
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)
Int -> ReadS (BinarySpacePartition a)
ReadS [BinarySpacePartition a]
(Int -> ReadS (BinarySpacePartition a))
-> ReadS [BinarySpacePartition a]
-> ReadPrec (BinarySpacePartition a)
-> ReadPrec [BinarySpacePartition a]
-> Read (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
(BinarySpacePartition a -> BinarySpacePartition a -> Bool)
-> (BinarySpacePartition a -> BinarySpacePartition a -> Bool)
-> Eq (BinarySpacePartition a)
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 :: BinarySpacePartition a
emptyBSP = [(Dimension, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition a
forall a.
[(Dimension, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition a
BinarySpacePartition [] NodeRef
noRef NodeRef
noRef Maybe (Tree Split)
forall a. Maybe a
Nothing
makeBSP :: Tree Split -> BinarySpacePartition a
makeBSP :: Tree Split -> BinarySpacePartition a
makeBSP = [(Dimension, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition a
forall a.
[(Dimension, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition a
BinarySpacePartition [] NodeRef
noRef NodeRef
noRef (Maybe (Tree Split) -> BinarySpacePartition a)
-> (Tree Split -> Maybe (Tree Split))
-> Tree Split
-> BinarySpacePartition a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Split -> Maybe (Tree Split)
forall a. a -> Maybe a
Just
makeZipper :: BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper :: BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper (BinarySpacePartition _ _ _ Nothing) = Maybe (Zipper Split)
forall a. Maybe a
Nothing
makeZipper (BinarySpacePartition _ _ _ (Just t :: Tree Split
t)) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Zipper Split -> Maybe (Zipper Split))
-> (Tree Split -> Zipper Split)
-> Tree Split
-> Maybe (Zipper Split)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Split -> Zipper Split
forall a. Tree a -> Zipper a
toZipper (Tree Split -> Maybe (Zipper Split))
-> Tree Split -> Maybe (Zipper Split)
forall a b. (a -> b) -> a -> b
$ Tree Split
t
size :: BinarySpacePartition a -> Int
size :: BinarySpacePartition a -> Int
size = Int -> (Tree Split -> Int) -> Maybe (Tree Split) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 0 Tree Split -> Int
forall a. Tree a -> Int
numLeaves (Maybe (Tree Split) -> Int)
-> (BinarySpacePartition a -> Maybe (Tree Split))
-> BinarySpacePartition a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinarySpacePartition a -> Maybe (Tree Split)
forall a. BinarySpacePartition a -> Maybe (Tree Split)
getTree
zipperToBinarySpacePartition :: Maybe (Zipper Split) -> BinarySpacePartition b
zipperToBinarySpacePartition :: Maybe (Zipper Split) -> BinarySpacePartition b
zipperToBinarySpacePartition Nothing = BinarySpacePartition b
forall a. BinarySpacePartition a
emptyBSP
zipperToBinarySpacePartition (Just z :: Zipper Split
z) = [(Dimension, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition b
forall a.
[(Dimension, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition a
BinarySpacePartition [] NodeRef
noRef NodeRef
noRef (Maybe (Tree Split) -> BinarySpacePartition b)
-> (Zipper Split -> Maybe (Tree Split))
-> Zipper Split
-> BinarySpacePartition b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Split -> Maybe (Tree Split)
forall a. a -> Maybe a
Just (Tree Split -> Maybe (Tree Split))
-> (Zipper Split -> Tree Split)
-> Zipper Split
-> Maybe (Tree Split)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper Split -> Tree Split
forall a. Zipper a -> Tree a
toTree (Zipper Split -> Tree Split)
-> (Zipper Split -> Zipper Split) -> Zipper Split -> Tree Split
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper Split -> Zipper Split
forall a. Zipper a -> Zipper a
top (Zipper Split -> BinarySpacePartition b)
-> Zipper Split -> BinarySpacePartition b
forall a b. (a -> b) -> a -> b
$ Zipper Split
z
rectangles :: BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles :: BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles (BinarySpacePartition _ _ _ Nothing) _ = []
rectangles (BinarySpacePartition _ _ _ (Just (Leaf _))) rootRect :: Rectangle
rootRect = [Rectangle
rootRect]
rectangles (BinarySpacePartition _ _ _ (Just node :: Tree Split
node)) rootRect :: Rectangle
rootRect =
BinarySpacePartition Any -> Rectangle -> [Rectangle]
forall a. BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles (Tree Split -> BinarySpacePartition Any
forall a. Tree Split -> BinarySpacePartition a
makeBSP (Tree Split -> BinarySpacePartition Any)
-> (Tree Split -> Tree Split)
-> Tree Split
-> BinarySpacePartition Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Split -> Tree Split
forall a. Tree a -> Tree a
left (Tree Split -> BinarySpacePartition Any)
-> Tree Split -> BinarySpacePartition Any
forall a b. (a -> b) -> a -> b
$ Tree Split
node) Rectangle
leftBox [Rectangle] -> [Rectangle] -> [Rectangle]
forall a. [a] -> [a] -> [a]
++
BinarySpacePartition Any -> Rectangle -> [Rectangle]
forall a. BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles (Tree Split -> BinarySpacePartition Any
forall a. Tree Split -> BinarySpacePartition a
makeBSP (Tree Split -> BinarySpacePartition Any)
-> (Tree Split -> Tree Split)
-> Tree Split
-> BinarySpacePartition Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Split -> Tree Split
forall a. Tree a -> Tree a
right (Tree Split -> BinarySpacePartition Any)
-> Tree Split -> BinarySpacePartition Any
forall a b. (a -> b) -> a -> b
$ Tree Split
node) Rectangle
rightBox
where (leftBox :: Rectangle
leftBox, rightBox :: Rectangle
rightBox) = Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split (Split -> Axis
axis Split
info) (Split -> Rational
ratio Split
info) Rectangle
rootRect
info :: Split
info = Tree Split -> Split
forall a. Tree a -> a
value Tree Split
node
getNodeRect :: BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
getNodeRect :: BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
getNodeRect b :: BinarySpacePartition a
b r :: Rectangle
r n :: NodeRef
n = Rectangle -> Maybe Rectangle -> Rectangle
forall a. a -> Maybe a -> a
fromMaybe (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle 0 0 1 1) (BinarySpacePartition a -> Maybe (Zipper Split)
forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NodeRef -> Zipper Split -> Maybe (Zipper Split)
forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
n Maybe (Zipper Split)
-> (Zipper Split -> Maybe Rectangle) -> Maybe Rectangle
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 ls :: [(Split, (Rectangle, Rectangle) -> Rectangle)]
ls (_, []) = Rectangle -> Maybe Rectangle
forall a. a -> Maybe a
Just (Rectangle -> Maybe Rectangle) -> Rectangle -> Maybe Rectangle
forall a b. (a -> b) -> a -> b
$ (Rectangle
-> (Split, (Rectangle, Rectangle) -> Rectangle) -> Rectangle)
-> Rectangle
-> [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> Rectangle
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\r' :: Rectangle
r' (s :: Split
s,f :: (Rectangle, Rectangle) -> Rectangle
f) -> (Rectangle, Rectangle) -> Rectangle
f ((Rectangle, Rectangle) -> Rectangle)
-> (Rectangle, Rectangle) -> Rectangle
forall a b. (a -> b) -> a -> b
$ Split -> Rectangle -> (Rectangle, Rectangle)
split' Split
s Rectangle
r') Rectangle
r [(Split, (Rectangle, Rectangle) -> Rectangle)]
ls
getRect ls :: [(Split, (Rectangle, Rectangle) -> Rectangle)]
ls z :: Zipper Split
z@(_, LeftCrumb s :: Split
s _:_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe Rectangle) -> Maybe Rectangle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> Zipper Split -> Maybe Rectangle
getRect ((Split
s,(Rectangle, Rectangle) -> Rectangle
forall a b. (a, b) -> a
fst)(Split, (Rectangle, Rectangle) -> Rectangle)
-> [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> [(Split, (Rectangle, Rectangle) -> Rectangle)]
forall a. a -> [a] -> [a]
:[(Split, (Rectangle, Rectangle) -> Rectangle)]
ls)
getRect ls :: [(Split, (Rectangle, Rectangle) -> Rectangle)]
ls z :: Zipper Split
z@(_, RightCrumb s :: Split
s _:_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe Rectangle) -> Maybe Rectangle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> Zipper Split -> Maybe Rectangle
getRect ((Split
s,(Rectangle, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd)(Split, (Rectangle, Rectangle) -> Rectangle)
-> [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> [(Split, (Rectangle, Rectangle) -> Rectangle)]
forall a. a -> [a] -> [a]
:[(Split, (Rectangle, Rectangle) -> Rectangle)]
ls)
split' :: Split -> Rectangle -> (Rectangle, Rectangle)
split' s :: 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 :: (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth f :: Zipper Split -> Maybe (Zipper Split)
f b :: BinarySpacePartition a
b = BinarySpacePartition a
b{getTree :: Maybe (Tree Split)
getTree=BinarySpacePartition Any -> Maybe (Tree Split)
forall a. BinarySpacePartition a -> Maybe (Tree Split)
getTree (BinarySpacePartition Any -> Maybe (Tree Split))
-> BinarySpacePartition Any -> Maybe (Tree Split)
forall a b. (a -> b) -> a -> b
$ Maybe (Zipper Split) -> BinarySpacePartition Any
forall b. Maybe (Zipper Split) -> BinarySpacePartition b
zipperToBinarySpacePartition (Maybe (Zipper Split) -> BinarySpacePartition Any)
-> Maybe (Zipper Split) -> BinarySpacePartition Any
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition a -> Maybe (Zipper Split)
forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NodeRef -> Zipper Split -> Maybe (Zipper Split)
forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode (BinarySpacePartition a -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition a
b) Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
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 :: BinarySpacePartition a -> BinarySpacePartition a
splitNth (BinarySpacePartition _ _ _ Nothing) = Tree Split -> BinarySpacePartition a
forall a. Tree Split -> BinarySpacePartition a
makeBSP (Int -> Tree Split
forall a. Int -> Tree a
Leaf 0)
splitNth b :: BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
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 :: BinarySpacePartition a -> BinarySpacePartition a
removeNth (BinarySpacePartition _ _ _ Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
removeNth (BinarySpacePartition _ _ _ (Just (Leaf _))) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
removeNth b :: BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
removeCurrent BinarySpacePartition a
b
rotateNth :: BinarySpacePartition a -> BinarySpacePartition a
rotateNth :: BinarySpacePartition a -> BinarySpacePartition a
rotateNth (BinarySpacePartition _ _ _ Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
rotateNth b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = BinarySpacePartition a
b
rotateNth b :: BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
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 :: BinarySpacePartition a -> BinarySpacePartition a
swapNth (BinarySpacePartition _ _ _ Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
swapNth b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = BinarySpacePartition a
b
swapNth b :: BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
swapCurrent BinarySpacePartition a
b
splitShiftNth :: Direction1D -> BinarySpacePartition a -> BinarySpacePartition a
splitShiftNth :: Direction1D -> BinarySpacePartition a -> BinarySpacePartition a
splitShiftNth _ (BinarySpacePartition _ _ _ Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
splitShiftNth _ b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = BinarySpacePartition a
b
splitShiftNth Prev b :: BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
splitShiftLeftCurrent BinarySpacePartition a
b
splitShiftNth Next b :: BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
splitShiftRightCurrent BinarySpacePartition a
b
growNthTowards :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
growNthTowards :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
growNthTowards _ (BinarySpacePartition _ _ _ Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
growNthTowards _ b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = BinarySpacePartition a
b
growNthTowards dir :: Direction2D
dir b :: BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Direction2D -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
dir) BinarySpacePartition a
b
shrinkNthFrom :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
shrinkNthFrom :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
shrinkNthFrom _ (BinarySpacePartition _ _ _ Nothing)= BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
shrinkNthFrom _ b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = BinarySpacePartition a
b
shrinkNthFrom dir :: Direction2D
dir b :: BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Direction2D -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom Direction2D
dir) BinarySpacePartition a
b
autoSizeNth :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
autoSizeNth :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
autoSizeNth _ (BinarySpacePartition _ _ _ Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
autoSizeNth _ b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = BinarySpacePartition a
b
autoSizeNth dir :: Direction2D
dir b :: BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Direction2D -> Zipper Split -> Maybe (Zipper Split)
autoSizeTree Direction2D
dir) BinarySpacePartition a
b
resizeSplitNth :: Direction2D -> (Rational,Rational) -> BinarySpacePartition a -> BinarySpacePartition a
resizeSplitNth :: Direction2D
-> (Rational, Rational)
-> BinarySpacePartition a
-> BinarySpacePartition a
resizeSplitNth _ _ (BinarySpacePartition _ _ _ Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
resizeSplitNth _ _ b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = BinarySpacePartition a
b
resizeSplitNth dir :: Direction2D
dir sc :: (Rational, Rational)
sc b :: BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
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 :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
rotateTreeNth _ (BinarySpacePartition _ _ _ Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
rotateTreeNth U b :: BinarySpacePartition a
b = BinarySpacePartition a
b
rotateTreeNth D b :: BinarySpacePartition a
b = BinarySpacePartition a
b
rotateTreeNth dir :: Direction2D
dir b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ _ (Just _)) =
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (\t :: Zipper Split
t -> case Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
t of
Nothing -> Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
t
Just (t' :: Tree Split
t', c :: [Crumb Split]
c) -> Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Direction2D -> Tree Split -> Tree Split
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 :: BinarySpacePartition a -> BinarySpacePartition a
equalizeNth (BinarySpacePartition _ _ _ Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
equalizeNth b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = BinarySpacePartition a
b
equalizeNth b :: BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
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 :: BinarySpacePartition a -> Rectangle -> BinarySpacePartition a
rebalanceNth (BinarySpacePartition _ _ _ Nothing) _ = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
rebalanceNth b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ _ (Just (Leaf _))) _ = BinarySpacePartition a
b
rebalanceNth b :: BinarySpacePartition a
b r :: Rectangle
r = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Zipper Split -> Maybe (Zipper Split)
balancedTree (Zipper Split -> Maybe (Zipper Split))
-> (Zipper Split -> Maybe (Zipper Split))
-> Zipper Split
-> Maybe (Zipper Split)
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 :: BinarySpacePartition a -> [Int]
flattenLeaves (BinarySpacePartition _ _ _ Nothing) = []
flattenLeaves (BinarySpacePartition _ _ _ (Just t :: Tree Split
t)) = Tree Split -> [Int]
forall a. Tree a -> [Int]
flatten Tree Split
t
numerateLeaves :: BinarySpacePartition a -> BinarySpacePartition a
numerateLeaves :: BinarySpacePartition a -> BinarySpacePartition a
numerateLeaves b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ _ Nothing) = BinarySpacePartition a
b
numerateLeaves b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ _ (Just t :: Tree Split
t)) = BinarySpacePartition a
b{getTree :: Maybe (Tree Split)
getTree=Tree Split -> Maybe (Tree Split)
forall a. a -> Maybe a
Just (Tree Split -> Maybe (Tree Split))
-> Tree Split -> Maybe (Tree Split)
forall a b. (a -> b) -> a -> b
$ [Int] -> Tree Split -> Tree Split
forall a. [Int] -> Tree a -> Tree a
numerate [Int]
ns Tree Split
t}
where ns :: [Int]
ns = [0..(Tree Split -> Int
forall a. Tree a -> Int
numLeaves Tree Split
tInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)]
moveNode :: BinarySpacePartition a -> BinarySpacePartition a
moveNode :: BinarySpacePartition a -> BinarySpacePartition a
moveNode b :: BinarySpacePartition a
b@(BinarySpacePartition _ (NodeRef (-1) _ _) _ _) = BinarySpacePartition a
b
moveNode b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ (NodeRef (-1) _ _) _) = BinarySpacePartition a
b
moveNode b :: BinarySpacePartition a
b@(BinarySpacePartition _ _ _ Nothing) = BinarySpacePartition a
b
moveNode b :: BinarySpacePartition a
b@(BinarySpacePartition _ f :: NodeRef
f s :: NodeRef
s (Just ot :: Tree Split
ot)) =
case BinarySpacePartition a -> Maybe (Zipper Split)
forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NodeRef -> Zipper Split -> Maybe (Zipper Split)
forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
s of
Just (n :: Tree Split
n, LeftCrumb _ t :: Tree Split
t:cs :: [Crumb Split]
cs) -> BinarySpacePartition a
b{getTree :: Maybe (Tree Split)
getTree=Tree Split -> Maybe (Tree Split)
forall a. a -> Maybe a
Just (Tree Split -> Maybe (Tree Split))
-> Tree Split -> Maybe (Tree Split)
forall a b. (a -> b) -> a -> b
$ Tree Split -> Zipper Split -> Tree Split
insert Tree Split
n (Zipper Split -> Tree Split) -> Zipper Split -> Tree Split
forall a b. (a -> b) -> a -> b
$ Zipper Split -> Zipper Split
forall a. Zipper a -> Zipper a
top (Tree Split
t, [Crumb Split]
cs)}
Just (n :: Tree Split
n, RightCrumb _ t :: Tree Split
t:cs :: [Crumb Split]
cs) -> BinarySpacePartition a
b{getTree :: Maybe (Tree Split)
getTree=Tree Split -> Maybe (Tree Split)
forall a. a -> Maybe a
Just (Tree Split -> Maybe (Tree Split))
-> Tree Split -> Maybe (Tree Split)
forall a b. (a -> b) -> a -> b
$ Tree Split -> Zipper Split -> Tree Split
insert Tree Split
n (Zipper Split -> Tree Split) -> Zipper Split -> Tree Split
forall a b. (a -> b) -> a -> b
$ Zipper Split -> Zipper Split
forall a. Zipper a -> Zipper a
top (Tree Split
t, [Crumb Split]
cs)}
_ -> BinarySpacePartition a
b
where insert :: Tree Split -> Zipper Split -> Tree Split
insert t :: Tree Split
t z :: Zipper Split
z = case NodeRef -> Zipper Split -> Maybe (Zipper Split)
forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
f Zipper Split
z of
Nothing -> Tree Split
ot
Just (n :: Tree Split
n, c :: Crumb Split
c:cs :: [Crumb Split]
cs) -> Zipper Split -> Tree Split
forall a. Zipper a -> Tree a
toTree (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
c) 0.5) Tree Split
t Tree Split
n, Crumb Split
cCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
Just (n :: Tree Split
n, []) -> Zipper Split -> Tree Split
forall a. Zipper a -> Tree a
toTree (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Vertical 0.5) Tree Split
t Tree Split
n, [])
index :: W.Stack a -> Int
index :: Stack a -> Int
index s :: Stack a
s = case Zipper a -> ([a], Maybe Int)
forall a. Zipper a -> ([a], Maybe Int)
toIndex (Stack a -> Zipper a
forall a. a -> Maybe a
Just Stack a
s) of
(_, Nothing) -> 0
(_, Just int :: Int
int) -> Int
int
adjustStack :: Maybe (W.Stack Window)
-> Maybe (W.Stack Window)
-> [Window]
-> Maybe (BinarySpacePartition Window)
-> Maybe (W.Stack Window)
adjustStack :: Maybe (Stack Dimension)
-> Maybe (Stack Dimension)
-> [Dimension]
-> Maybe (BinarySpacePartition Dimension)
-> Maybe (Stack Dimension)
adjustStack orig :: Maybe (Stack Dimension)
orig Nothing _ _ = Maybe (Stack Dimension)
orig
adjustStack orig :: Maybe (Stack Dimension)
orig _ _ Nothing = Maybe (Stack Dimension)
orig
adjustStack orig :: Maybe (Stack Dimension)
orig s :: Maybe (Stack Dimension)
s fw :: [Dimension]
fw (Just b :: BinarySpacePartition Dimension
b) =
if [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lsInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<[Dimension] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Dimension]
ws then Maybe (Stack Dimension)
orig
else [Dimension] -> Int -> Maybe (Stack Dimension)
forall a. [a] -> Int -> Zipper a
fromIndex [Dimension]
ws' Int
fid'
where ws' :: [Dimension]
ws' = (Int -> Maybe Dimension) -> [Int] -> [Dimension]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> Map Int Dimension -> Maybe Dimension
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Int Dimension
wsmap) [Int]
ls [Dimension] -> [Dimension] -> [Dimension]
forall a. [a] -> [a] -> [a]
++ [Dimension]
fw
fid' :: Int
fid' = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Dimension -> [Dimension] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Dimension
focused [Dimension]
ws'
wsmap :: Map Int Dimension
wsmap = [(Int, Dimension)] -> Map Int Dimension
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, Dimension)] -> Map Int Dimension)
-> [(Int, Dimension)] -> Map Int Dimension
forall a b. (a -> b) -> a -> b
$ [Int] -> [Dimension] -> [(Int, Dimension)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [Dimension]
ws
ls :: [Int]
ls = BinarySpacePartition Dimension -> [Int]
forall a. BinarySpacePartition a -> [Int]
flattenLeaves BinarySpacePartition Dimension
b
(ws :: [Dimension]
ws,fid :: Maybe Int
fid) = Maybe (Stack Dimension) -> ([Dimension], Maybe Int)
forall a. Zipper a -> ([a], Maybe Int)
toIndex Maybe (Stack Dimension)
s
focused :: Dimension
focused = [Dimension]
ws [Dimension] -> Int -> Dimension
forall a. [a] -> Int -> a
!! Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 Maybe Int
fid
replaceStack :: Maybe (W.Stack Window) -> X ()
replaceStack :: Maybe (Stack Dimension) -> X ()
replaceStack s :: Maybe (Stack Dimension)
s = do
XState
st <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
let wset :: WindowSet
wset = XState -> WindowSet
windowset XState
st
cur :: Screen String (Layout Dimension) Dimension ScreenId ScreenDetail
cur = WindowSet
-> Screen String (Layout Dimension) Dimension ScreenId ScreenDetail
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 Dimension) Dimension
wsp = Screen String (Layout Dimension) Dimension ScreenId ScreenDetail
-> Workspace String (Layout Dimension) Dimension
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen String (Layout Dimension) Dimension ScreenId ScreenDetail
cur
XState -> X ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
st{windowset :: WindowSet
windowset=WindowSet
wset{current :: Screen String (Layout Dimension) Dimension ScreenId ScreenDetail
W.current=Screen String (Layout Dimension) Dimension ScreenId ScreenDetail
cur{workspace :: Workspace String (Layout Dimension) Dimension
W.workspace=Workspace String (Layout Dimension) Dimension
wsp{stack :: Maybe (Stack Dimension)
W.stack=Maybe (Stack Dimension)
s}}}}
replaceFloating :: M.Map Window W.RationalRect -> X ()
replaceFloating :: Map Dimension RationalRect -> X ()
replaceFloating wsm :: Map Dimension RationalRect
wsm = do
XState
st <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
let wset :: WindowSet
wset = XState -> WindowSet
windowset XState
st
XState -> X ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
st{windowset :: WindowSet
windowset=WindowSet
wset{floating :: Map Dimension RationalRect
W.floating=Map Dimension RationalRect
wsm}}
getFloating :: X [Window]
getFloating :: X [Dimension]
getFloating = (Map Dimension RationalRect -> [Dimension]
forall k a. Map k a -> [k]
M.keys (Map Dimension RationalRect -> [Dimension])
-> (WindowSet -> Map Dimension RationalRect)
-> WindowSet
-> [Dimension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Map Dimension RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating) (WindowSet -> [Dimension]) -> X WindowSet -> X [Dimension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
getStackSet :: X (Maybe (W.Stack Window))
getStackSet :: X (Maybe (Stack Dimension))
getStackSet = (Workspace String (Layout Dimension) Dimension
-> Maybe (Stack Dimension)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Dimension) Dimension
-> Maybe (Stack Dimension))
-> (WindowSet -> Workspace String (Layout Dimension) Dimension)
-> WindowSet
-> Maybe (Stack Dimension)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Dimension) Dimension ScreenId ScreenDetail
-> Workspace String (Layout Dimension) Dimension
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Dimension) Dimension ScreenId ScreenDetail
-> Workspace String (Layout Dimension) Dimension)
-> (WindowSet
-> Screen
String (Layout Dimension) Dimension ScreenId ScreenDetail)
-> WindowSet
-> Workspace String (Layout Dimension) Dimension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (Layout Dimension) Dimension ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current) (WindowSet -> Maybe (Stack Dimension))
-> X WindowSet -> X (Maybe (Stack Dimension))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> WindowSet) -> X WindowSet
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 (ScreenDetail -> Rectangle)
-> (WindowSet -> ScreenDetail) -> WindowSet -> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Dimension) Dimension ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail (Screen String (Layout Dimension) Dimension ScreenId ScreenDetail
-> ScreenDetail)
-> (WindowSet
-> Screen
String (Layout Dimension) Dimension ScreenId ScreenDetail)
-> WindowSet
-> ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (Layout Dimension) Dimension ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current) (WindowSet -> Rectangle) -> X WindowSet -> X Rectangle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
withoutFloating :: [Window] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window)
withoutFloating :: [Dimension] -> Maybe (Stack Dimension) -> Maybe (Stack Dimension)
withoutFloating fs :: [Dimension]
fs = Maybe (Stack Dimension)
-> (Stack Dimension -> Maybe (Stack Dimension))
-> Maybe (Stack Dimension)
-> Maybe (Stack Dimension)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (Stack Dimension)
forall a. Maybe a
Nothing ([Dimension] -> Stack Dimension -> Maybe (Stack Dimension)
unfloat [Dimension]
fs)
unfloat :: [Window] -> W.Stack Window -> Maybe (W.Stack Window)
unfloat :: [Dimension] -> Stack Dimension -> Maybe (Stack Dimension)
unfloat fs :: [Dimension]
fs s :: Stack Dimension
s = if Stack Dimension -> Dimension
forall a. Stack a -> a
W.focus Stack Dimension
s Dimension -> [Dimension] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Dimension]
fs
then Maybe (Stack Dimension)
forall a. Maybe a
Nothing
else Stack Dimension -> Maybe (Stack Dimension)
forall a. a -> Maybe a
Just (Stack Dimension -> Maybe (Stack Dimension))
-> Stack Dimension -> Maybe (Stack Dimension)
forall a b. (a -> b) -> a -> b
$ Stack Dimension
s{up :: [Dimension]
W.up = Stack Dimension -> [Dimension]
forall a. Stack a -> [a]
W.up Stack Dimension
s [Dimension] -> [Dimension] -> [Dimension]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Dimension]
fs, down :: [Dimension]
W.down = Stack Dimension -> [Dimension]
forall a. Stack a -> [a]
W.down Stack Dimension
s [Dimension] -> [Dimension] -> [Dimension]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Dimension]
fs}
instance LayoutClass BinarySpacePartition Window where
doLayout :: BinarySpacePartition Dimension
-> Rectangle
-> Stack Dimension
-> X ([(Dimension, Rectangle)],
Maybe (BinarySpacePartition Dimension))
doLayout b :: BinarySpacePartition Dimension
b r :: Rectangle
r s :: Stack Dimension
s = do
let b' :: BinarySpacePartition Dimension
b' = BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a. BinarySpacePartition a -> BinarySpacePartition a
layout BinarySpacePartition Dimension
b
BinarySpacePartition Dimension
b'' <- BinarySpacePartition Dimension
-> Bool -> Rectangle -> X (BinarySpacePartition Dimension)
updateNodeRef BinarySpacePartition Dimension
b' (BinarySpacePartition Dimension -> Int
forall a. BinarySpacePartition a -> Int
size BinarySpacePartition Dimension
bInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=BinarySpacePartition Dimension -> Int
forall a. BinarySpacePartition a -> Int
size BinarySpacePartition Dimension
b') Rectangle
r
let rs :: [Rectangle]
rs = BinarySpacePartition Dimension -> Rectangle -> [Rectangle]
forall a. BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles BinarySpacePartition Dimension
b'' Rectangle
r
wrs :: [(Dimension, Rectangle)]
wrs = [Dimension] -> [Rectangle] -> [(Dimension, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Dimension]
ws [Rectangle]
rs
([(Dimension, Rectangle)], Maybe (BinarySpacePartition Dimension))
-> X ([(Dimension, Rectangle)],
Maybe (BinarySpacePartition Dimension))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Dimension, Rectangle)]
wrs, BinarySpacePartition Dimension
-> Maybe (BinarySpacePartition Dimension)
forall a. a -> Maybe a
Just BinarySpacePartition Dimension
b''{getOldRects :: [(Dimension, Rectangle)]
getOldRects=[(Dimension, Rectangle)]
wrs})
where
ws :: [Dimension]
ws = Stack Dimension -> [Dimension]
forall a. Stack a -> [a]
W.integrate Stack Dimension
s
l :: Int
l = [Dimension] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Dimension]
ws
layout :: BinarySpacePartition a -> BinarySpacePartition a
layout bsp :: BinarySpacePartition a
bsp
| Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = BinarySpacePartition a
bsp
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
sz = BinarySpacePartition a -> BinarySpacePartition a
layout (BinarySpacePartition a -> BinarySpacePartition a)
-> BinarySpacePartition a -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition a -> BinarySpacePartition a
forall a. BinarySpacePartition a -> BinarySpacePartition a
splitNth BinarySpacePartition a
bsp
| Bool
otherwise = BinarySpacePartition a -> BinarySpacePartition a
layout (BinarySpacePartition a -> BinarySpacePartition a)
-> BinarySpacePartition a -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition a -> BinarySpacePartition a
forall a. BinarySpacePartition a -> BinarySpacePartition a
removeNth BinarySpacePartition a
bsp
where sz :: Int
sz = BinarySpacePartition a -> Int
forall a. BinarySpacePartition a -> Int
size BinarySpacePartition a
bsp
handleMessage :: BinarySpacePartition Dimension
-> SomeMessage -> X (Maybe (BinarySpacePartition Dimension))
handleMessage b_orig :: BinarySpacePartition Dimension
b_orig m :: SomeMessage
m
| Just msg :: WindowArrangerMsg
msg@(SetGeometry _) <- SomeMessage -> Maybe WindowArrangerMsg
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = BinarySpacePartition Dimension
-> WindowArrangerMsg -> X (Maybe (BinarySpacePartition Dimension))
handleResize BinarySpacePartition Dimension
b WindowArrangerMsg
msg
| Just FocusParent <- SomeMessage -> Maybe FocusParent
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
let n :: NodeRef
n = BinarySpacePartition Dimension -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Dimension
b
let n' :: NodeRef
n' = Int -> Maybe (Zipper Split) -> NodeRef
toNodeRef (NodeRef -> Int
refLeaf NodeRef
n) (BinarySpacePartition Dimension -> Maybe (Zipper Split)
forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition Dimension
b Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NodeRef -> Zipper Split -> Maybe (Zipper Split)
forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
n Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp)
Maybe (BinarySpacePartition Dimension)
-> X (Maybe (BinarySpacePartition Dimension))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (BinarySpacePartition Dimension)
-> X (Maybe (BinarySpacePartition Dimension)))
-> Maybe (BinarySpacePartition Dimension)
-> X (Maybe (BinarySpacePartition Dimension))
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Dimension
-> Maybe (BinarySpacePartition Dimension)
forall a. a -> Maybe a
Just BinarySpacePartition Dimension
b{getFocusedNode :: NodeRef
getFocusedNode=NodeRef
n'{refWins :: [Dimension]
refWins=NodeRef -> [Dimension]
refWins NodeRef
n}}
| Just SelectNode <- SomeMessage -> Maybe SelectMoveNode
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
let n :: NodeRef
n = BinarySpacePartition Dimension -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Dimension
b
let s :: NodeRef
s = BinarySpacePartition Dimension -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition Dimension
b
[Dimension] -> X ()
removeBorder ([Dimension] -> X ()) -> [Dimension] -> X ()
forall a b. (a -> b) -> a -> b
$ NodeRef -> [Dimension]
refWins NodeRef
s
let s' :: NodeRef
s' = if NodeRef -> Int
refLeaf NodeRef
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== NodeRef -> Int
refLeaf NodeRef
s Bool -> Bool -> Bool
&& NodeRef -> [Direction2D]
refPath NodeRef
n [Direction2D] -> [Direction2D] -> Bool
forall a. Eq a => a -> a -> Bool
== NodeRef -> [Direction2D]
refPath NodeRef
s
then NodeRef
noRef else NodeRef
n{refWins :: [Dimension]
refWins=[]}
Maybe (BinarySpacePartition Dimension)
-> X (Maybe (BinarySpacePartition Dimension))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (BinarySpacePartition Dimension)
-> X (Maybe (BinarySpacePartition Dimension)))
-> Maybe (BinarySpacePartition Dimension)
-> X (Maybe (BinarySpacePartition Dimension))
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Dimension
-> Maybe (BinarySpacePartition Dimension)
forall a. a -> Maybe a
Just BinarySpacePartition Dimension
b{getSelectedNode :: NodeRef
getSelectedNode=NodeRef
s'}
| Bool
otherwise = do
Maybe (Stack Dimension)
ws <- X (Maybe (Stack Dimension))
getStackSet
[Dimension]
fs <- X [Dimension]
getFloating
Rectangle
r <- X Rectangle
getScreenRect
let lws :: Maybe (Stack Dimension)
lws = [Dimension] -> Maybe (Stack Dimension) -> Maybe (Stack Dimension)
withoutFloating [Dimension]
fs Maybe (Stack Dimension)
ws
lfs :: [Dimension]
lfs = [Dimension]
-> (Stack Dimension -> [Dimension])
-> Maybe (Stack Dimension)
-> [Dimension]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack Dimension -> [Dimension]
forall a. Stack a -> [a]
W.integrate Maybe (Stack Dimension)
ws [Dimension] -> [Dimension] -> [Dimension]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Dimension]
-> (Stack Dimension -> [Dimension])
-> Maybe (Stack Dimension)
-> [Dimension]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack Dimension -> [Dimension]
forall a. Stack a -> [a]
W.integrate Maybe (Stack Dimension)
lws
b' :: Maybe (BinarySpacePartition Dimension)
b' = Rectangle -> Maybe (BinarySpacePartition Dimension)
handleMesg Rectangle
r
ws' :: Maybe (Stack Dimension)
ws' = Maybe (Stack Dimension)
-> Maybe (Stack Dimension)
-> [Dimension]
-> Maybe (BinarySpacePartition Dimension)
-> Maybe (Stack Dimension)
adjustStack Maybe (Stack Dimension)
ws Maybe (Stack Dimension)
lws [Dimension]
lfs Maybe (BinarySpacePartition Dimension)
b'
Maybe (Stack Dimension) -> X ()
replaceStack Maybe (Stack Dimension)
ws'
Maybe (BinarySpacePartition Dimension)
-> X (Maybe (BinarySpacePartition Dimension))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (BinarySpacePartition Dimension)
b'
where handleMesg :: Rectangle -> Maybe (BinarySpacePartition Dimension)
handleMesg r :: Rectangle
r = [Maybe (BinarySpacePartition Dimension)]
-> Maybe (BinarySpacePartition Dimension)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ (ResizeDirectional -> BinarySpacePartition Dimension)
-> Maybe ResizeDirectional
-> Maybe (BinarySpacePartition Dimension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResizeDirectional -> BinarySpacePartition Dimension
resize (SomeMessage -> Maybe ResizeDirectional
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
, (Rotate -> BinarySpacePartition Dimension)
-> Maybe Rotate -> Maybe (BinarySpacePartition Dimension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rotate -> BinarySpacePartition Dimension
forall a. Rotate -> BinarySpacePartition a
rotate (SomeMessage -> Maybe Rotate
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
, (Swap -> BinarySpacePartition Dimension)
-> Maybe Swap -> Maybe (BinarySpacePartition Dimension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Swap -> BinarySpacePartition Dimension
forall a. Swap -> BinarySpacePartition a
swap (SomeMessage -> Maybe Swap
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
, (TreeRotate -> BinarySpacePartition Dimension)
-> Maybe TreeRotate -> Maybe (BinarySpacePartition Dimension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TreeRotate -> BinarySpacePartition Dimension
forall a. TreeRotate -> BinarySpacePartition a
rotateTr (SomeMessage -> Maybe TreeRotate
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
, (TreeBalance -> BinarySpacePartition Dimension)
-> Maybe TreeBalance -> Maybe (BinarySpacePartition Dimension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rectangle -> TreeBalance -> BinarySpacePartition Dimension
forall a. Rectangle -> TreeBalance -> BinarySpacePartition a
balanceTr Rectangle
r) (SomeMessage -> Maybe TreeBalance
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
, (SelectMoveNode -> BinarySpacePartition Dimension)
-> Maybe SelectMoveNode -> Maybe (BinarySpacePartition Dimension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SelectMoveNode -> BinarySpacePartition Dimension
move (SomeMessage -> Maybe SelectMoveNode
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
, (SplitShiftDirectional -> BinarySpacePartition Dimension)
-> Maybe SplitShiftDirectional
-> Maybe (BinarySpacePartition Dimension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SplitShiftDirectional -> BinarySpacePartition Dimension
forall a. SplitShiftDirectional -> BinarySpacePartition a
splitShift (SomeMessage -> Maybe SplitShiftDirectional
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
]
resize :: ResizeDirectional -> BinarySpacePartition Dimension
resize (ExpandTowards dir :: Direction2D
dir) = Direction2D
-> BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a.
Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
growNthTowards Direction2D
dir BinarySpacePartition Dimension
b
resize (ShrinkFrom dir :: Direction2D
dir) = Direction2D
-> BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a.
Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
shrinkNthFrom Direction2D
dir BinarySpacePartition Dimension
b
resize (MoveSplit dir :: Direction2D
dir) = Direction2D
-> BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a.
Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
autoSizeNth Direction2D
dir BinarySpacePartition Dimension
b
rotate :: Rotate -> BinarySpacePartition a
rotate Rotate = BinarySpacePartition Dimension -> BinarySpacePartition a
forall a a. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Dimension -> BinarySpacePartition a)
-> BinarySpacePartition Dimension -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a. BinarySpacePartition a -> BinarySpacePartition a
rotateNth BinarySpacePartition Dimension
b
swap :: Swap -> BinarySpacePartition a
swap Swap = BinarySpacePartition Dimension -> BinarySpacePartition a
forall a a. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Dimension -> BinarySpacePartition a)
-> BinarySpacePartition Dimension -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a. BinarySpacePartition a -> BinarySpacePartition a
swapNth BinarySpacePartition Dimension
b
rotateTr :: TreeRotate -> BinarySpacePartition a
rotateTr RotateL = BinarySpacePartition Dimension -> BinarySpacePartition a
forall a a. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Dimension -> BinarySpacePartition a)
-> BinarySpacePartition Dimension -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ Direction2D
-> BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a.
Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
rotateTreeNth Direction2D
L BinarySpacePartition Dimension
b
rotateTr RotateR = BinarySpacePartition Dimension -> BinarySpacePartition a
forall a a. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Dimension -> BinarySpacePartition a)
-> BinarySpacePartition Dimension -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ Direction2D
-> BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a.
Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
rotateTreeNth Direction2D
R BinarySpacePartition Dimension
b
balanceTr :: Rectangle -> TreeBalance -> BinarySpacePartition a
balanceTr _ Equalize = BinarySpacePartition Dimension -> BinarySpacePartition a
forall a a. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Dimension -> BinarySpacePartition a)
-> BinarySpacePartition Dimension -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a. BinarySpacePartition a -> BinarySpacePartition a
equalizeNth BinarySpacePartition Dimension
b
balanceTr r :: Rectangle
r Balance = BinarySpacePartition Dimension -> BinarySpacePartition a
forall a a. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Dimension -> BinarySpacePartition a)
-> BinarySpacePartition Dimension -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Dimension
-> Rectangle -> BinarySpacePartition Dimension
forall a.
BinarySpacePartition a -> Rectangle -> BinarySpacePartition a
rebalanceNth BinarySpacePartition Dimension
b Rectangle
r
move :: SelectMoveNode -> BinarySpacePartition Dimension
move MoveNode = BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a a. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Dimension -> BinarySpacePartition Dimension)
-> BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a. BinarySpacePartition a -> BinarySpacePartition a
moveNode BinarySpacePartition Dimension
b
move SelectNode = BinarySpacePartition Dimension
b
splitShift :: SplitShiftDirectional -> BinarySpacePartition a
splitShift (SplitShift dir :: Direction1D
dir) = BinarySpacePartition Dimension -> BinarySpacePartition a
forall a a. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Dimension -> BinarySpacePartition a)
-> BinarySpacePartition Dimension -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ Direction1D
-> BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a.
Direction1D -> BinarySpacePartition a -> BinarySpacePartition a
splitShiftNth Direction1D
dir BinarySpacePartition Dimension
b
b :: BinarySpacePartition Dimension
b = BinarySpacePartition Dimension -> BinarySpacePartition Dimension
forall a. BinarySpacePartition a -> BinarySpacePartition a
numerateLeaves BinarySpacePartition Dimension
b_orig
resetFoc :: BinarySpacePartition a -> BinarySpacePartition a
resetFoc bsp :: BinarySpacePartition a
bsp = BinarySpacePartition a
bsp{getFocusedNode :: NodeRef
getFocusedNode=(BinarySpacePartition a -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition a
bsp){refLeaf :: Int
refLeaf=(-1)}
,getSelectedNode :: NodeRef
getSelectedNode=(BinarySpacePartition a -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition a
bsp){refLeaf :: Int
refLeaf=(-1)}}
description :: BinarySpacePartition Dimension -> String
description _ = "BSP"
handleResize :: BinarySpacePartition Window -> WindowArrangerMsg -> X (Maybe (BinarySpacePartition Window))
handleResize :: BinarySpacePartition Dimension
-> WindowArrangerMsg -> X (Maybe (BinarySpacePartition Dimension))
handleResize b :: BinarySpacePartition Dimension
b (SetGeometry newrect :: Rectangle
newrect@(Rectangle _ _ w :: Dimension
w h :: Dimension
h)) = do
Maybe (Stack Dimension)
ws <- X (Maybe (Stack Dimension))
getStackSet
[Dimension]
fs <- X [Dimension]
getFloating
case Stack Dimension -> Dimension
forall a. Stack a -> a
W.focus (Stack Dimension -> Dimension)
-> Maybe (Stack Dimension) -> Maybe Dimension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Stack Dimension)
ws of
Nothing -> Maybe (BinarySpacePartition Dimension)
-> X (Maybe (BinarySpacePartition Dimension))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (BinarySpacePartition Dimension)
forall a. Maybe a
Nothing
Just win :: Dimension
win -> do
(_,_,_,_,_,mx :: CInt
mx,my :: CInt
my,_) <- (Display
-> X (Bool, Dimension, Dimension, CInt, CInt, CInt, CInt,
Modifier))
-> X (Bool, Dimension, Dimension, CInt, CInt, CInt, CInt, Modifier)
forall a. (Display -> X a) -> X a
withDisplay (\d :: Display
d -> IO (Bool, Dimension, Dimension, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Dimension, Dimension, CInt, CInt, CInt, CInt, Modifier)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Bool, Dimension, Dimension, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Dimension, Dimension, CInt, CInt, CInt, CInt,
Modifier))
-> IO
(Bool, Dimension, Dimension, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Dimension, Dimension, CInt, CInt, CInt, CInt, Modifier)
forall a b. (a -> b) -> a -> b
$ Display
-> Dimension
-> IO
(Bool, Dimension, Dimension, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
d Dimension
win)
let oldrect :: Rectangle
oldrect@(Rectangle _ _ ow :: Dimension
ow oh :: Dimension
oh) = Rectangle -> Maybe Rectangle -> Rectangle
forall a. a -> Maybe a -> a
fromMaybe (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle 0 0 0 0) (Maybe Rectangle -> Rectangle) -> Maybe Rectangle -> Rectangle
forall a b. (a -> b) -> a -> b
$ Dimension -> [(Dimension, Rectangle)] -> Maybe Rectangle
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Dimension
win ([(Dimension, Rectangle)] -> Maybe Rectangle)
-> [(Dimension, Rectangle)] -> Maybe Rectangle
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Dimension -> [(Dimension, Rectangle)]
forall a. BinarySpacePartition a -> [(Dimension, Rectangle)]
getOldRects BinarySpacePartition Dimension
b
let (xsc :: Rational
xsc,ysc :: Rational
ysc) = (Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
ow, Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
oh)
(xsc' :: Rational
xsc',ysc' :: Rational
ysc') = (Rational -> Rational
forall a. (Ord a, Fractional a) => a -> a
rough Rational
xsc, Rational -> Rational
forall a. (Ord a, Fractional a) => a -> a
rough Rational
ysc)
dirs :: [Direction2D]
dirs = Rectangle -> Rectangle -> (Int, Int) -> [Direction2D]
changedDirs Rectangle
oldrect Rectangle
newrect (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
mx,CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
my)
n :: Maybe Int
n = Dimension -> [Dimension] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Dimension
win ([Dimension] -> Maybe Int) -> [Dimension] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [Dimension]
-> (Stack Dimension -> [Dimension])
-> Maybe (Stack Dimension)
-> [Dimension]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack Dimension -> [Dimension]
forall a. Stack a -> [a]
W.integrate (Maybe (Stack Dimension) -> [Dimension])
-> Maybe (Stack Dimension) -> [Dimension]
forall a b. (a -> b) -> a -> b
$ [Dimension] -> Maybe (Stack Dimension) -> Maybe (Stack Dimension)
withoutFloating [Dimension]
fs Maybe (Stack Dimension)
ws
Maybe (BinarySpacePartition Dimension)
-> X (Maybe (BinarySpacePartition Dimension))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (BinarySpacePartition Dimension)
-> X (Maybe (BinarySpacePartition Dimension)))
-> Maybe (BinarySpacePartition Dimension)
-> X (Maybe (BinarySpacePartition Dimension))
forall a b. (a -> b) -> a -> b
$ case Maybe Int
n of
Just _ -> BinarySpacePartition Dimension
-> Maybe (BinarySpacePartition Dimension)
forall a. a -> Maybe a
Just (BinarySpacePartition Dimension
-> Maybe (BinarySpacePartition Dimension))
-> BinarySpacePartition Dimension
-> Maybe (BinarySpacePartition Dimension)
forall a b. (a -> b) -> a -> b
$ (BinarySpacePartition Dimension
-> Direction2D -> BinarySpacePartition Dimension)
-> BinarySpacePartition Dimension
-> [Direction2D]
-> BinarySpacePartition Dimension
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\b' :: BinarySpacePartition Dimension
b' d :: Direction2D
d -> Direction2D
-> (Rational, Rational)
-> BinarySpacePartition Dimension
-> BinarySpacePartition Dimension
forall a.
Direction2D
-> (Rational, Rational)
-> BinarySpacePartition a
-> BinarySpacePartition a
resizeSplitNth Direction2D
d (Rational
xsc',Rational
ysc') BinarySpacePartition Dimension
b') BinarySpacePartition Dimension
b [Direction2D]
dirs
Nothing -> Maybe (BinarySpacePartition Dimension)
forall a. Maybe a
Nothing
where rough :: a -> a
rough v :: a
v = a -> a -> a
forall a. Ord a => a -> a -> a
min 1.5 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
max 0.75 a
v
handleResize _ _ = Maybe (BinarySpacePartition Dimension)
-> X (Maybe (BinarySpacePartition Dimension))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (BinarySpacePartition Dimension)
forall a. Maybe a
Nothing
changedDirs :: Rectangle -> Rectangle -> (Int,Int) -> [Direction2D]
changedDirs :: Rectangle -> Rectangle -> (Int, Int) -> [Direction2D]
changedDirs (Rectangle _ _ ow :: Dimension
ow oh :: Dimension
oh) (Rectangle _ _ w :: Dimension
w h :: Dimension
h) (mx :: Int
mx,my :: Int
my) = [Maybe Direction2D] -> [Direction2D]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Direction2D
lr, Maybe Direction2D
ud]
where lr :: Maybe Direction2D
lr = if Dimension
owDimension -> Dimension -> Bool
forall a. Eq a => a -> a -> Bool
==Dimension
w then Maybe Direction2D
forall a. Maybe a
Nothing
else Direction2D -> Maybe Direction2D
forall a. a -> Maybe a
Just (if (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fi Int
mx :: Double) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> (Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fi Dimension
ow :: Double)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2 then Direction2D
R else Direction2D
L)
ud :: Maybe Direction2D
ud = if Dimension
ohDimension -> Dimension -> Bool
forall a. Eq a => a -> a -> Bool
==Dimension
h then Maybe Direction2D
forall a. Maybe a
Nothing
else Direction2D -> Maybe Direction2D
forall a. a -> Maybe a
Just (if (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fi Int
my :: Double) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> (Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fi Dimension
oh :: Double)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2 then Direction2D
D else Direction2D
U)
updateNodeRef :: BinarySpacePartition Window -> Bool -> Rectangle -> X (BinarySpacePartition Window)
updateNodeRef :: BinarySpacePartition Dimension
-> Bool -> Rectangle -> X (BinarySpacePartition Dimension)
updateNodeRef b :: BinarySpacePartition Dimension
b force :: Bool
force r :: Rectangle
r = do
let n :: NodeRef
n = BinarySpacePartition Dimension -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Dimension
b
let s :: NodeRef
s = BinarySpacePartition Dimension -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition Dimension
b
[Dimension] -> X ()
removeBorder (NodeRef -> [Dimension]
refWins NodeRef
n[Dimension] -> [Dimension] -> [Dimension]
forall a. [a] -> [a] -> [a]
++NodeRef -> [Dimension]
refWins NodeRef
s)
Int
l <- X Int
getCurrFocused
BinarySpacePartition Dimension
b' <- if NodeRef -> Int
refLeaf NodeRef
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
l Bool -> Bool -> Bool
|| NodeRef -> Int
refLeaf NodeRef
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-1) Bool -> Bool -> Bool
|| Bool
force
then BinarySpacePartition Dimension
-> X (BinarySpacePartition Dimension)
forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Dimension
b{getFocusedNode :: NodeRef
getFocusedNode=Int -> BinarySpacePartition Dimension -> NodeRef
forall a. Int -> BinarySpacePartition a -> NodeRef
leafToNodeRef Int
l BinarySpacePartition Dimension
b}
else BinarySpacePartition Dimension
-> X (BinarySpacePartition Dimension)
forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Dimension
b
BinarySpacePartition Dimension
b'' <- if Bool
force then BinarySpacePartition Dimension
-> X (BinarySpacePartition Dimension)
forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Dimension
b'{getSelectedNode :: NodeRef
getSelectedNode=NodeRef
noRef} else BinarySpacePartition Dimension
-> X (BinarySpacePartition Dimension)
forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Dimension
b'
Rectangle
-> BinarySpacePartition Dimension
-> X (BinarySpacePartition Dimension)
forall a.
Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a)
renderBorders Rectangle
r BinarySpacePartition Dimension
b''
where getCurrFocused :: X Int
getCurrFocused = Int -> (Stack Dimension -> Int) -> Maybe (Stack Dimension) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 0 Stack Dimension -> Int
forall a. Stack a -> Int
index (Maybe (Stack Dimension) -> Int)
-> X (Maybe (Stack Dimension)) -> X Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Dimension] -> Maybe (Stack Dimension) -> Maybe (Stack Dimension)
withoutFloating ([Dimension] -> Maybe (Stack Dimension) -> Maybe (Stack Dimension))
-> X [Dimension]
-> X (Maybe (Stack Dimension) -> Maybe (Stack Dimension))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X [Dimension]
getFloating X (Maybe (Stack Dimension) -> Maybe (Stack Dimension))
-> X (Maybe (Stack Dimension)) -> X (Maybe (Stack Dimension))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> X (Maybe (Stack Dimension))
getStackSet)
renderBorders :: Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a)
renderBorders :: Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a)
renderBorders r :: Rectangle
r b :: BinarySpacePartition a
b = do
let l :: Maybe Int
l = NodeRef -> Maybe (Zipper Split) -> Maybe Int
forall a. NodeRef -> Maybe (Zipper a) -> Maybe Int
nodeRefToLeaf (BinarySpacePartition a -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition a
b) (Maybe (Zipper Split) -> Maybe Int)
-> Maybe (Zipper Split) -> Maybe Int
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition a -> Maybe (Zipper Split)
forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b
[Dimension]
wssel <- if NodeRef -> Int
refLeaf (BinarySpacePartition a -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition a
b)Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=(-1)
then Rectangle -> Maybe String -> X [Dimension]
createBorder (BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
forall a.
BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
getNodeRect BinarySpacePartition a
b Rectangle
r (BinarySpacePartition a -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition a
b)) (Maybe String -> X [Dimension]) -> Maybe String -> X [Dimension]
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just "#00ff00"
else [Dimension] -> X [Dimension]
forall (m :: * -> *) a. Monad m => a -> m a
return []
let b' :: BinarySpacePartition a
b' = BinarySpacePartition a
b{getSelectedNode :: NodeRef
getSelectedNode=(BinarySpacePartition a -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition a
b){refWins :: [Dimension]
refWins=[Dimension]
wssel}}
if NodeRef -> Int
refLeaf (BinarySpacePartition Any -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Any
forall a. BinarySpacePartition a
b')Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==(-1) Bool -> Bool -> Bool
|| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
l Bool -> Bool -> Bool
|| BinarySpacePartition Any -> Int
forall a. BinarySpacePartition a -> Int
size BinarySpacePartition Any
forall a. BinarySpacePartition a
b'Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<2 then BinarySpacePartition a -> X (BinarySpacePartition a)
forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition a
forall a. BinarySpacePartition a
b'
else do
[Dimension]
ws' <- Rectangle -> Maybe String -> X [Dimension]
createBorder (BinarySpacePartition Any -> Rectangle -> NodeRef -> Rectangle
forall a.
BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
getNodeRect BinarySpacePartition Any
forall a. BinarySpacePartition a
b' Rectangle
r (BinarySpacePartition Any -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Any
forall a. BinarySpacePartition a
b')) Maybe String
forall a. Maybe a
Nothing
BinarySpacePartition a -> X (BinarySpacePartition a)
forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Any
forall a. BinarySpacePartition a
b'{getFocusedNode :: NodeRef
getFocusedNode=(BinarySpacePartition Any -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Any
forall a. BinarySpacePartition a
b'){refWins :: [Dimension]
refWins=[Dimension]
ws'}}
createBorder :: Rectangle -> Maybe String -> X [Window]
createBorder :: Rectangle -> Maybe String -> X [Dimension]
createBorder (Rectangle wx :: Position
wx wy :: Position
wy ww :: Dimension
ww wh :: Dimension
wh) c :: Maybe String
c = do
Dimension
bw <- (XConf -> Dimension) -> X Dimension
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> Dimension
forall (l :: * -> *). XConfig l -> Dimension
borderWidth(XConfig Layout -> Dimension)
-> (XConf -> XConfig Layout) -> XConf -> Dimension
forall b c a. (b -> c) -> (a -> b) -> a -> c
.XConf -> XConfig Layout
config)
String
bc <- case Maybe String
c of
Nothing -> (XConf -> String) -> X String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> String
forall (l :: * -> *). XConfig l -> String
focusedBorderColor(XConfig Layout -> String)
-> (XConf -> XConfig Layout) -> XConf -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.XConf -> XConfig Layout
config)
Just s :: String
s -> String -> X String
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 (Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw)
, Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
wx Position
wy (Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Dimension
wh
, Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
wx (Position
wyPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
whPosition -> Position -> Position
forall a. Num a => a -> a -> a
-Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Dimension
ww (Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw)
, Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
wxPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
wwPosition -> Position -> Position
forall a. Num a => a -> a -> a
-Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Position
wy (Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Dimension
wh
]
[Dimension]
ws <- (Rectangle -> X Dimension) -> [Rectangle] -> X [Dimension]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\r :: Rectangle
r -> Rectangle -> Maybe Dimension -> String -> Bool -> X Dimension
createNewWindow Rectangle
r Maybe Dimension
forall a. Maybe a
Nothing String
bc Bool
False) [Rectangle]
rects
[Dimension] -> X ()
showWindows [Dimension]
ws
Maybe (Stack Dimension)
-> (Stack Dimension -> Maybe (Stack Dimension))
-> Maybe (Stack Dimension)
-> Maybe (Stack Dimension)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (Stack Dimension)
forall a. Maybe a
Nothing (\s :: Stack Dimension
s -> Stack Dimension -> Maybe (Stack Dimension)
forall a. a -> Maybe a
Just Stack Dimension
s{down :: [Dimension]
W.down=Stack Dimension -> [Dimension]
forall a. Stack a -> [a]
W.down Stack Dimension
s [Dimension] -> [Dimension] -> [Dimension]
forall a. [a] -> [a] -> [a]
++ [Dimension]
ws}) (Maybe (Stack Dimension) -> Maybe (Stack Dimension))
-> X (Maybe (Stack Dimension)) -> X (Maybe (Stack Dimension))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (Maybe (Stack Dimension))
getStackSet X (Maybe (Stack Dimension))
-> (Maybe (Stack Dimension) -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Stack Dimension) -> X ()
replaceStack
Map Dimension RationalRect
-> Map Dimension RationalRect -> Map Dimension RationalRect
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Dimension, RationalRect)] -> Map Dimension RationalRect
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Dimension, RationalRect)] -> Map Dimension RationalRect)
-> [(Dimension, RationalRect)] -> Map Dimension RationalRect
forall a b. (a -> b) -> a -> b
$ [Dimension] -> [RationalRect] -> [(Dimension, RationalRect)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Dimension]
ws ([RationalRect] -> [(Dimension, RationalRect)])
-> [RationalRect] -> [(Dimension, RationalRect)]
forall a b. (a -> b) -> a -> b
$ (Rectangle -> RationalRect) -> [Rectangle] -> [RationalRect]
forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> RationalRect
toRR [Rectangle]
rects) (Map Dimension RationalRect -> Map Dimension RationalRect)
-> (XState -> Map Dimension RationalRect)
-> XState
-> Map Dimension RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Map Dimension RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating (WindowSet -> Map Dimension RationalRect)
-> (XState -> WindowSet) -> XState -> Map Dimension RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset (XState -> Map Dimension RationalRect)
-> X XState -> X (Map Dimension RationalRect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X XState
forall s (m :: * -> *). MonadState s m => m s
get X (Map Dimension RationalRect)
-> (Map Dimension RationalRect -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map Dimension RationalRect -> X ()
replaceFloating
(XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: XState
s -> XState
s{mapped :: Set Dimension
mapped=XState -> Set Dimension
mapped XState
s Set Dimension -> Set Dimension -> Set Dimension
forall a. Ord a => Set a -> Set a -> Set a
`S.union` [Dimension] -> Set Dimension
forall a. Ord a => [a] -> Set a
S.fromList [Dimension]
ws})
[Dimension] -> X [Dimension]
forall (m :: * -> *) a. Monad m => a -> m a
return [Dimension]
ws
where toRR :: Rectangle -> RationalRect
toRR (Rectangle x :: Position
x y :: Position
y w :: Dimension
w h :: Dimension
h) = Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect (Position -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Position
x) (Position -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Position
y) (Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w) (Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h)
removeBorder :: [Window] -> X ()
removeBorder :: [Dimension] -> X ()
removeBorder ws :: [Dimension]
ws = do
(XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: XState
s -> XState
s{mapped :: Set Dimension
mapped = XState -> Set Dimension
mapped XState
s Set Dimension -> Set Dimension -> Set Dimension
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` [Dimension] -> Set Dimension
forall a. Ord a => [a] -> Set a
S.fromList [Dimension]
ws})
(Map Dimension RationalRect
-> [Dimension] -> Map Dimension RationalRect)
-> [Dimension]
-> Map Dimension RationalRect
-> Map Dimension RationalRect
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Map Dimension RationalRect
-> Dimension -> Map Dimension RationalRect)
-> Map Dimension RationalRect
-> [Dimension]
-> Map Dimension RationalRect
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Dimension
-> Map Dimension RationalRect -> Map Dimension RationalRect)
-> Map Dimension RationalRect
-> Dimension
-> Map Dimension RationalRect
forall a b c. (a -> b -> c) -> b -> a -> c
flip Dimension
-> Map Dimension RationalRect -> Map Dimension RationalRect
forall k a. Ord k => k -> Map k a -> Map k a
M.delete)) [Dimension]
ws (Map Dimension RationalRect -> Map Dimension RationalRect)
-> (XState -> Map Dimension RationalRect)
-> XState
-> Map Dimension RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Map Dimension RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating (WindowSet -> Map Dimension RationalRect)
-> (XState -> WindowSet) -> XState -> Map Dimension RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset (XState -> Map Dimension RationalRect)
-> X XState -> X (Map Dimension RationalRect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X XState
forall s (m :: * -> *). MonadState s m => m s
get X (Map Dimension RationalRect)
-> (Map Dimension RationalRect -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map Dimension RationalRect -> X ()
replaceFloating
Maybe (Stack Dimension)
-> (Stack Dimension -> Maybe (Stack Dimension))
-> Maybe (Stack Dimension)
-> Maybe (Stack Dimension)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (Stack Dimension)
forall a. Maybe a
Nothing (\s :: Stack Dimension
s -> Stack Dimension -> Maybe (Stack Dimension)
forall a. a -> Maybe a
Just Stack Dimension
s{down :: [Dimension]
W.down=Stack Dimension -> [Dimension]
forall a. Stack a -> [a]
W.down Stack Dimension
s [Dimension] -> [Dimension] -> [Dimension]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Dimension]
ws}) (Maybe (Stack Dimension) -> Maybe (Stack Dimension))
-> X (Maybe (Stack Dimension)) -> X (Maybe (Stack Dimension))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (Maybe (Stack Dimension))
getStackSet X (Maybe (Stack Dimension))
-> (Maybe (Stack Dimension) -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Stack Dimension) -> X ()
replaceStack
[Dimension] -> X ()
deleteWindows [Dimension]
ws