module LayoutF(serCompLF, compLF, listLF, untaggedListLF,
	       --rbLayoutF,
               nullLF, holeF, holeF', lF, LayoutDirection(..),orientP) where
--import TableP
import CompF
import CompOps((>^=<))
import Fudget
import FRequest
import Geometry() -- instances
import LayoutDir(Orientation(..))
import LayoutRequest
import Placers
import ListF
import NullF
import FudgetIO
import SerCompF(serCompF)
import Utils(number)
--import Xtypes
import AlignP(revP)
import Placer(placerF)

data LayoutDirection = Forward | Backward  deriving (LayoutDirection -> LayoutDirection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayoutDirection -> LayoutDirection -> Bool
$c/= :: LayoutDirection -> LayoutDirection -> Bool
== :: LayoutDirection -> LayoutDirection -> Bool
$c== :: LayoutDirection -> LayoutDirection -> Bool
Eq, Eq LayoutDirection
LayoutDirection -> LayoutDirection -> Bool
LayoutDirection -> LayoutDirection -> Ordering
LayoutDirection -> LayoutDirection -> LayoutDirection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LayoutDirection -> LayoutDirection -> LayoutDirection
$cmin :: LayoutDirection -> LayoutDirection -> LayoutDirection
max :: LayoutDirection -> LayoutDirection -> LayoutDirection
$cmax :: LayoutDirection -> LayoutDirection -> LayoutDirection
>= :: LayoutDirection -> LayoutDirection -> Bool
$c>= :: LayoutDirection -> LayoutDirection -> Bool
> :: LayoutDirection -> LayoutDirection -> Bool
$c> :: LayoutDirection -> LayoutDirection -> Bool
<= :: LayoutDirection -> LayoutDirection -> Bool
$c<= :: LayoutDirection -> LayoutDirection -> Bool
< :: LayoutDirection -> LayoutDirection -> Bool
$c< :: LayoutDirection -> LayoutDirection -> Bool
compare :: LayoutDirection -> LayoutDirection -> Ordering
$ccompare :: LayoutDirection -> LayoutDirection -> Ordering
Ord,Int -> LayoutDirection -> ShowS
[LayoutDirection] -> ShowS
LayoutDirection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutDirection] -> ShowS
$cshowList :: [LayoutDirection] -> ShowS
show :: LayoutDirection -> String
$cshow :: LayoutDirection -> String
showsPrec :: Int -> LayoutDirection -> ShowS
$cshowsPrec :: Int -> LayoutDirection -> ShowS
Show)

holeF' :: Size -> F hi ho
holeF' Size
s = forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow (LayoutRequest -> FRequest
layoutRequestCmd (Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
s Bool
False Bool
False)) forall {hi} {ho}. F hi ho
nullF
holeF :: F hi ho
holeF = forall {hi} {ho}. Size -> F hi ho
holeF' Size
0
nullLF :: F hi ho
nullLF = forall {hi} {ho}. F hi ho
holeF

--listLF :: Eq a => Placer -> [(a, F b c)] -> F (a, b) (a, c)
listLF :: Placer -> [(a, F b c)] -> F (a, b) (a, c)
listLF Placer
placer [(a, F b c)]
fl = forall a b. Int -> LayoutDirection -> Placer -> F a b -> F a b
lF (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, F b c)]
fl) LayoutDirection
Forward Placer
placer (forall a b c. Eq a => [(a, F b c)] -> F (a, b) (a, c)
listF [(a, F b c)]
fl)

untaggedListLF :: Placer -> [F a b] -> F (Int, a) b
untaggedListLF :: forall a b. Placer -> [F a b] -> F (Int, a) b
untaggedListLF Placer
layout [F a b]
fs = forall a b. (a, b) -> b
snd forall a b e. (a -> b) -> F e a -> F e b
>^=< forall {a} {b} {c}.
Eq a =>
Placer -> [(a, F b c)] -> F (a, b) (a, c)
listLF Placer
layout (forall a. Int -> [a] -> [(Int, a)]
number Int
0 [F a b]
fs)

compLF :: (F a b, Orientation) -> F c d -> F (Either a c) (Either b d)
compLF = forall a b c d e f.
(F a b -> F c d -> F e f) -> (F a b, Orientation) -> F c d -> F e f
cLF forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
compF
serCompLF :: (F d f, Orientation) -> F e d -> F e f
serCompLF = forall a b c d e f.
(F a b -> F c d -> F e f) -> (F a b, Orientation) -> F c d -> F e f
cLF forall {a1} {b} {a2}. F a1 b -> F a2 a1 -> F a2 b
serCompF
--rbLayoutF sep = lF 3 Forward (rightBelowP sep)

cLF :: ((F a b) -> (F c d) -> F e f) -> (F a b,Orientation) -> F c d -> F e f
cLF :: forall a b c d e f.
(F a b -> F c d -> F e f) -> (F a b, Orientation) -> F c d -> F e f
cLF F a b -> F c d -> F e f
cF (F a b
f1,Orientation
ori) F c d
f2 = forall a b. Int -> LayoutDirection -> Placer -> F a b -> F a b
lF Int
2 LayoutDirection
Forward (Orientation -> Placer
orientP Orientation
ori) (F a b -> F c d -> F e f
cF F a b
f1 F c d
f2)

lF :: Int -> LayoutDirection -> Placer -> (F a b) -> F a b
lF :: forall a b. Int -> LayoutDirection -> Placer -> F a b -> F a b
lF Int
0 LayoutDirection
_ Placer
_ F a b
f = forall {hi} {ho}. F hi ho
nullLF
lF Int
nofudgets LayoutDirection
dir Placer
placer F a b
f = forall a b. Placer -> F a b -> F a b
placerF Placer
placer' F a b
f where 
     placer' :: Placer
placer' = if LayoutDirection
dir forall a. Eq a => a -> a -> Bool
== LayoutDirection
Backward then Placer -> Placer
revP Placer
placer else Placer
placer

orientP :: Orientation -> Placer
orientP :: Orientation -> Placer
orientP Orientation
ori =
   case Orientation
ori of
     Orientation
Above -> Placer
verticalP
     Orientation
Below -> Placer -> Placer
revP Placer
verticalP
     Orientation
LeftOf -> Placer
horizontalP
     Orientation
RightOf -> Placer -> Placer
revP Placer
horizontalP