module Placer where
import Fudget
import LayoutRequest
import FRequest
--import Geometry(Point, Size(..),Rect)
import NullF(putMessageFu)
--import Command
--import Defaults(defaultSep)
import Placers(horizontalP,verticalP)
import MatrixP(matrixP)
import Spacers(spacerP)
import TableP(tableP)
import AlignP(revP)
import AutoPlacer(autoP)

--import AlignP
--import Alignment

placerF :: Placer -> F a b -> F a b
placerF :: Placer -> F a b -> F a b
placerF Placer
placer = Message FRequest b -> F a b -> F a b
forall ho hi. Message FRequest ho -> F hi ho -> F hi ho
putMessageFu (FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (LayoutMessage -> FRequest
LCmd (Placer -> LayoutMessage
LayoutPlacer Placer
placer)))

spacerF :: Spacer -> F a b -> F a b
spacerF :: Spacer -> F a b -> F a b
spacerF Spacer
spacer = Message FRequest b -> F a b -> F a b
forall ho hi. Message FRequest ho -> F hi ho -> F hi ho
putMessageFu (FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (LayoutMessage -> FRequest
LCmd (Spacer -> LayoutMessage
LayoutSpacer Spacer
spacer)))

spacer1F :: Spacer -> F a b -> F a b
spacer1F Spacer
s = Placer -> F a b -> F a b
forall a b. Placer -> F a b -> F a b
placerF (Spacer
s Spacer -> Placer -> Placer
`spacerP` Placer
autoP)

hBoxF :: F a b -> F a b
hBoxF = Placer -> F a b -> F a b
forall a b. Placer -> F a b -> F a b
placerF Placer
horizontalP
vBoxF :: F a b -> F a b
vBoxF = Placer -> F a b -> F a b
forall a b. Placer -> F a b -> F a b
placerF Placer
verticalP

revHBoxF :: F a b -> F a b
revHBoxF = Placer -> F a b -> F a b
forall a b. Placer -> F a b -> F a b
placerF (Placer -> Placer
revP Placer
horizontalP)
revVBoxF :: F a b -> F a b
revVBoxF = Placer -> F a b -> F a b
forall a b. Placer -> F a b -> F a b
placerF (Placer -> Placer
revP Placer
verticalP)

matrixF :: Int -> F a b -> F a b
matrixF = Placer -> F a b -> F a b
forall a b. Placer -> F a b -> F a b
placerF (Placer -> F a b -> F a b)
-> (Int -> Placer) -> Int -> F a b -> F a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Placer
matrixP
tableF :: Int -> F a b -> F a b
tableF  = Placer -> F a b -> F a b
forall a b. Placer -> F a b -> F a b
placerF (Placer -> F a b -> F a b)
-> (Int -> Placer) -> Int -> F a b -> F a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Placer
tableP