module Layoutspec(marginHVAlignLs, hvAlignLs, marginLs, sepLs,hBoxLs', vBoxLs',
placeLs,spaceLs,revLs, permLs, leafLs, layoutF, Layout) where
import AlignP
import Fudget
import LayoutF(LayoutDirection(..), lF)
import LayoutRequest
import Placers
import Spacers
import Utils(oo,unconcat)
data Layout = LeafL | NodeL Placer [Layout]
layoutF :: Layout -> (F a b) -> F a b
layoutF :: forall a b. Layout -> F a b -> F a b
layoutF Layout
layout F a b
f =
let (Int
n, Placer
lter) = Layout -> (Int, Placer)
layouter Layout
layout
in forall a b. Int -> LayoutDirection -> Placer -> F a b -> F a b
lF Int
n LayoutDirection
Forward Placer
lter F a b
f
leafLs :: Layout
leafLs = Layout
LeafL
revLs :: Layout -> Layout
revLs Layout
LeafL = Layout
LeafL
revLs (NodeL Placer
lter [Layout]
ls') = Placer -> [Layout] -> Layout
NodeL (Placer -> Placer
revP Placer
lter) [Layout]
ls'
npermLs :: p -> Layout -> Layout
npermLs p
_ Layout
LeafL = Layout
LeafL
permLs :: [Int] -> Layout -> Layout
permLs [Int]
perm (NodeL Placer
lter [Layout]
ls') = Placer -> [Layout] -> Layout
NodeL ([Int] -> Placer -> Placer
permuteP [Int]
perm Placer
lter) [Layout]
ls'
modLs :: (Placer -> Placer) -> Layout -> Layout
modLs Placer -> Placer
ltermod Layout
l =
case Layout
l of
Layout
LeafL -> Placer -> [Layout] -> Layout
NodeL (Placer -> Placer
ltermod Placer
idP) [Layout
LeafL]
NodeL Placer
lter [Layout]
ls' -> Placer -> [Layout] -> Layout
NodeL (Placer -> Placer
ltermod Placer
lter) [Layout]
ls'
placeLs :: Placer -> [Layout] -> Layout
placeLs = Placer -> [Layout] -> Layout
NodeL
spaceLs :: Spacer -> Layout -> Layout
spaceLs = (Placer -> Placer) -> Layout -> Layout
modLs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spacer -> Placer -> Placer
spacerP
vBoxLs' :: Int -> [Layout] -> Layout
vBoxLs' = Placer -> [Layout] -> Layout
placeLs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Placer
verticalP'
hBoxLs' :: Int -> [Layout] -> Layout
hBoxLs' = Placer -> [Layout] -> Layout
placeLs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Placer
horizontalP'
sepLs :: Size -> Layout -> Layout
sepLs = Spacer -> Layout -> Layout
spaceLs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Spacer
sepS
marginLs :: Int -> Layout -> Layout
marginLs = Spacer -> Layout -> Layout
spaceLs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Spacer
marginS
hvAlignLs :: Alignment -> Alignment -> Layout -> Layout
hvAlignLs = forall {t1} {t2} {t3} {t4}.
(t1 -> t2) -> (t3 -> t4 -> t1) -> t3 -> t4 -> t2
oo Spacer -> Layout -> Layout
spaceLs Alignment -> Alignment -> Spacer
hvAlignS
marginHVAlignLs :: Int -> Alignment -> Alignment -> Layout -> Layout
marginHVAlignLs Int
sep Alignment
ha Alignment
va = Spacer -> Layout -> Layout
spaceLs (Int -> Alignment -> Alignment -> Spacer
marginHVAlignS Int
sep Alignment
ha Alignment
va)
layouter :: Layout -> (Int, Placer)
layouter Layout
layout =
case Layout
layout of
Layout
LeafL -> (Int
1, Placer
idP)
NodeL Placer
lter [Layout]
ls' -> let ([Int]
ns, [Placer]
lters) = forall a b. [(a, b)] -> ([a], [b])
unzip (forall a b. (a -> b) -> [a] -> [b]
map Layout -> (Int, Placer)
layouter [Layout]
ls')
in (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ns, Placer -> [Int] -> [Placer] -> Placer
combl Placer
lter [Int]
ns [Placer]
lters)
combl :: Placer -> [Int] -> [Placer] -> Placer
combl Placer
rootlter [Int]
ns [Placer]
nodelters = Placer1 -> Placer
P forall a b. (a -> b) -> a -> b
$ \ [LayoutRequest]
leafreqs ->
let ([LayoutRequest]
nodereqs, [Rect -> [Rect]]
noderess) =
forall a b. [(a, b)] -> ([a], [b])
unzip (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Placer -> Placer1
unP [Placer]
nodelters (forall {a}. [Int] -> [a] -> [[a]]
unconcat [Int]
ns [LayoutRequest]
leafreqs))
(LayoutRequest
rootreq, Rect -> [Rect]
rootres) = Placer -> Placer1
unP Placer
rootlter [LayoutRequest]
nodereqs
leafres :: Rect -> [Rect]
leafres Rect
rootrect = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {t} {t}. (t -> t, t) -> t
apply (forall a b. [a] -> [b] -> [(a, b)]
zip [Rect -> [Rect]]
noderess (Rect -> [Rect]
rootres Rect
rootrect))
in (LayoutRequest
rootreq, Rect -> [Rect]
leafres)
apply :: (t -> t, t) -> t
apply (t -> t
f, t
x) = t -> t
f t
x