module LinearSplitP where
import AllFudgets
import HbcUtils(apFst,chopList)
import Data.Maybe(isJust,listToMaybe)
horizontalSplitP :: Placer
horizontalSplitP = Distance -> Placer
horizontalSplitP' forall a. Num a => a
defaultSep
verticalSplitP :: Placer
verticalSplitP = Distance -> Placer
verticalSplitP' forall a. Num a => a
defaultSep
horizontalSplitP' :: Distance -> Placer
horizontalSplitP' = LayoutDir -> Distance -> Placer
linearSplitP LayoutDir
Horizontal
verticalSplitP' :: Distance -> Placer
verticalSplitP' = LayoutDir -> Distance -> Placer
linearSplitP LayoutDir
Vertical
linearSplitP :: LayoutDir -> Distance -> Placer
linearSplitP LayoutDir
dir Distance
sep = Placer1 -> Placer
P Placer1
linearSplitP'
where
linearSplitP' :: Placer1
linearSplitP' [] = Placer1
linearP' []
linearSplitP' [LayoutRequest
r] = Placer1
linearP' [LayoutRequest
r]
linearSplitP' [LayoutRequest]
reqs0 = (LayoutRequest
req,Rect -> [Rect]
placer2)
where
reqss :: [[LayoutRequest]]
reqss = [LayoutRequest] -> [[LayoutRequest]]
chopReqs [LayoutRequest]
reqs0
([LayoutRequest]
reqs1,[Rect -> [Rect]]
placers2) = forall a b. [(a, b)] -> ([a], [b])
unzip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Placer1
linearP' [[LayoutRequest]]
reqss)
(LayoutRequest
req,Rect -> [Rect]
placer2a) = Placer1
linearP' [LayoutRequest]
reqs1
positions :: [Maybe (Point, Point, Alignment)]
positions = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( \ [LayoutRequest]
r->forall a. [a] -> Maybe a
listToMaybe [LayoutRequest]
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LayoutRequest -> Maybe (Point, Point, Alignment)
wantedPos) [[LayoutRequest]]
reqss
placer2 :: Rect -> [Rect]
placer2 r :: Rect
r@(Rect Point
_ Point
s) =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. a -> a
id [Rect -> [Rect]]
placers2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {c}.
RealFrac c =>
Point -> [Maybe (Point, Point, c)] -> [Rect] -> [Rect]
adjPlaces Point
s [Maybe (Point, Point, Alignment)]
positions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> [Rect]
placer2a forall a b. (a -> b) -> a -> b
$ Rect
r
adjPlaces :: Point -> [Maybe (Point, Point, c)] -> [Rect] -> [Rect]
adjPlaces Point
asize (Maybe (Point, Point, c)
_:[Maybe (Point, Point, c)]
ps) (Rect
r:[Rect]
rs) = forall {c}.
RealFrac c =>
[Maybe (Point, Point, c)] -> Rect -> [Rect] -> [Rect]
adjPlaces' [Maybe (Point, Point, c)]
ps Rect
r [Rect]
rs
where
adjPlaces' :: [Maybe (Point, Point, c)] -> Rect -> [Rect] -> [Rect]
adjPlaces' (Maybe (Point, Point, c)
optp:[Maybe (Point, Point, c)]
ps) r1 :: Rect
r1@(Rect Point
p1 Point
s1) (r2 :: Rect
r2@(Rect Point
p2 Point
s2):[Rect]
rs) =
case Maybe (Point, Point, c)
optp of
Maybe (Point, Point, c)
Nothing -> Rect
r1forall a. a -> [a] -> [a]
:[Maybe (Point, Point, c)] -> Rect -> [Rect] -> [Rect]
adjPlaces' [Maybe (Point, Point, c)]
ps Rect
r2 [Rect]
rs
Just (Point
p0,Point
s,c
a) -> Rect
r1' forall a. a -> [a] -> [a]
: [Maybe (Point, Point, c)] -> Rect -> [Rect] -> [Rect]
adjPlaces' [Maybe (Point, Point, c)]
ps Rect
r2' [Rect]
rs
where v :: Point
v = LayoutDir -> Distance -> Distance -> Point
mkp LayoutDir
dir Distance
d Distance
0
where
d :: Distance
d = forall a. Ord a => a -> a -> a
max Distance
1 (Distance
d0forall a. Num a => a -> a -> a
+Distance
d1)forall a. Num a => a -> a -> a
-Distance
d1
d0 :: Distance
d0 = LayoutDir -> Point -> Distance
xc LayoutDir
dir Point
pforall a. Num a => a -> a -> a
-LayoutDir -> Point -> Distance
xc LayoutDir
dir (Rect -> Point
rectpos Rect
r2)
d1 :: Distance
d1 = LayoutDir -> Point -> Distance
xc LayoutDir
dir Point
s1
p :: Point
p = Point
p0 forall a. Num a => a -> a -> a
+ forall {a}. RealFrac a => a -> Point -> Point
scalePoint c
a (Point
asizeforall a. Num a => a -> a -> a
-Point
s)
r1' :: Rect
r1' = Point -> Point -> Rect
Rect Point
p1 (Point
s1forall a. Num a => a -> a -> a
+Point
v)
r2' :: Rect
r2' = Point -> Point -> Rect
Rect (Point
p2forall a. Num a => a -> a -> a
+Point
v) (Point
s2forall a. Num a => a -> a -> a
-Point
v)
adjPlaces' [] Rect
r [] = [Rect
r]
chopReqs :: [LayoutRequest] -> [[LayoutRequest]]
chopReqs = forall a b. ([a] -> (b, [a])) -> [a] -> [b]
chopList [LayoutRequest] -> ([LayoutRequest], [LayoutRequest])
splitReqs
splitReqs :: [LayoutRequest] -> ([LayoutRequest], [LayoutRequest])
splitReqs (LayoutRequest
r:[LayoutRequest]
rs) = forall {t} {a} {b}. (t -> a) -> (t, b) -> (a, b)
apFst (LayoutRequest
rforall a. a -> [a] -> [a]
:) (forall a. (a -> Bool) -> [a] -> ([a], [a])
break LayoutRequest -> Bool
wantPos [LayoutRequest]
rs)
splitReqs [] = ([],[])
wantPos :: LayoutRequest -> Bool
wantPos = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutRequest -> Maybe (Point, Point, Alignment)
wantedPos
linearP' :: Placer1
linearP' = Placer -> Placer1
unP (LayoutDir -> Distance -> Placer
linearP LayoutDir
dir Distance
sep)