module Layoutspec(marginHVAlignLs, hvAlignLs, marginLs, sepLs,hBoxLs', vBoxLs',
        placeLs,spaceLs,revLs, permLs, leafLs, layoutF, Layout) where
import AlignP
--import Alignment(Alignment(..))
import Fudget
--import Geometry(Point, Rect, Size(..))
--import LayoutDir(LayoutDir, Orientation)
import LayoutF(LayoutDirection(..), lF)
import LayoutRequest
import Placers
import Spacers
import Utils(oo,unconcat)

data Layout = LeafL | NodeL Placer [Layout]  --deriving (Eq, Ord)

layoutF :: Layout -> (F a b) -> F a b
layoutF :: 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  Int -> LayoutDirection -> Placer -> F a b -> F a b
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 ((Placer -> Placer) -> Layout -> Layout)
-> (Spacer -> Placer -> Placer) -> Spacer -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spacer -> Placer -> Placer
spacerP

vBoxLs' :: Int -> [Layout] -> Layout
vBoxLs' = Placer -> [Layout] -> Layout
placeLs (Placer -> [Layout] -> Layout)
-> (Int -> Placer) -> Int -> [Layout] -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Placer
verticalP'
hBoxLs' :: Int -> [Layout] -> Layout
hBoxLs' = Placer -> [Layout] -> Layout
placeLs (Placer -> [Layout] -> Layout)
-> (Int -> Placer) -> Int -> [Layout] -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Placer
horizontalP'

sepLs :: Size -> Layout -> Layout
sepLs = Spacer -> Layout -> Layout
spaceLs (Spacer -> Layout -> Layout)
-> (Size -> Spacer) -> Size -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Spacer
sepS
marginLs :: Int -> Layout -> Layout
marginLs = Spacer -> Layout -> Layout
spaceLs (Spacer -> Layout -> Layout)
-> (Int -> Spacer) -> Int -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Spacer
marginS
hvAlignLs :: Alignment -> Alignment -> Layout -> Layout
hvAlignLs = (Spacer -> Layout -> Layout)
-> (Alignment -> Alignment -> Spacer)
-> Alignment
-> Alignment
-> Layout
-> Layout
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 -> (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) = [(Int, Placer)] -> ([Int], [Placer])
forall a b. [(a, b)] -> ([a], [b])
unzip ((Layout -> (Int, Placer)) -> [Layout] -> [(Int, Placer)]
forall a b. (a -> b) -> [a] -> [b]
map Layout -> (Int, Placer)
layouter [Layout]
ls')
                        in  ([Int] -> Int
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 (Placer1 -> Placer) -> Placer1 -> Placer
forall a b. (a -> b) -> a -> b
$ \ [LayoutRequest]
leafreqs ->
    let ([LayoutRequest]
nodereqs, [Rect -> [Rect]]
noderess) =
            [(LayoutRequest, Rect -> [Rect])]
-> ([LayoutRequest], [Rect -> [Rect]])
forall a b. [(a, b)] -> ([a], [b])
unzip ((Placer -> Placer1)
-> [Placer]
-> [[LayoutRequest]]
-> [(LayoutRequest, Rect -> [Rect])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Placer -> Placer1
unP [Placer]
nodelters ([Int] -> [LayoutRequest] -> [[LayoutRequest]]
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 = ((Rect -> [Rect], Rect) -> [Rect])
-> [(Rect -> [Rect], Rect)] -> [Rect]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Rect -> [Rect], Rect) -> [Rect]
forall t t. (t -> t, t) -> t
apply ([Rect -> [Rect]] -> [Rect] -> [(Rect -> [Rect], Rect)]
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