-- | Sizes a block element & positions their children.
-- Taking into account size bounds.
module Graphics.Layout.Flow(flowMinWidth, flowNatWidth, flowMaxWidth, flowWidth,
        flowNatHeight, flowMinHeight, flowMaxHeight, flowHeight,
        positionFlow, layoutFlow) where

import Graphics.Layout.Box as B

-- | Compute the minimum width of a block element with children of the given sizes.
flowMinWidth :: Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowMinWidth :: forall a b.
Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowMinWidth Double
_ PaddedBox {min :: forall m n. PaddedBox m n -> Size m n
B.min = Size (Pixels Double
x) a
_} [PaddedBox b Double]
_ = Double
x
flowMinWidth Double
parent PaddedBox {min :: forall m n. PaddedBox m n -> Size m n
B.min = Size (Percent Double
x) a
_} [PaddedBox b Double]
_ = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
parent
flowMinWidth Double
parent self :: PaddedBox a Length
self@PaddedBox {min :: forall m n. PaddedBox m n -> Size m n
B.min = Size Length
Preferred a
_} [PaddedBox b Double]
childs =
    Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
forall a b.
Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowNatWidth Double
parent PaddedBox a Length
self [PaddedBox b Double]
childs
flowMinWidth Double
_ PaddedBox a Length
_ [PaddedBox b Double]
childs = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (Double
0Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
:) ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (PaddedBox b Double -> Double) -> [PaddedBox b Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map PaddedBox b Double -> Double
forall {a} {m}. Num a => PaddedBox m a -> a
minWidth [PaddedBox b Double]
childs
-- | Compute the natural width of a block element with children of the given sizes.
flowNatWidth :: Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowNatWidth :: forall a b.
Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowNatWidth Double
_ PaddedBox {size :: forall m n. PaddedBox m n -> Size m n
size = Size (Pixels Double
x) a
_} [PaddedBox b Double]
_ = Double
x
flowNatWidth Double
parent PaddedBox {size :: forall m n. PaddedBox m n -> Size m n
size = Size (Percent Double
x) a
_} [PaddedBox b Double]
_ = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
parent
flowNatWidth Double
parent self :: PaddedBox a Length
self@PaddedBox {size :: forall m n. PaddedBox m n -> Size m n
size = Size Length
Min a
_, min :: forall m n. PaddedBox m n -> Size m n
B.min = Size Length
x a
_} [PaddedBox b Double]
childs
    -- Avoid infinite loops!
    | Length
x Length -> Length -> Bool
forall a. Eq a => a -> a -> Bool
/= Length
Preferred = Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
forall a b.
Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowMinWidth Double
parent PaddedBox a Length
self [PaddedBox b Double]
childs
flowNatWidth Double
parent PaddedBox a Length
_ [PaddedBox b Double]
childs = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (Double
0Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
:) ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (PaddedBox b Double -> Double) -> [PaddedBox b Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map PaddedBox b Double -> Double
forall {a} {m}. Num a => PaddedBox m a -> a
maxWidth [PaddedBox b Double]
childs
-- | Compute the maximum width of a block element inside the given parent size.
flowMaxWidth :: PaddedBox a Double -> PaddedBox b Length -> Double
flowMaxWidth :: forall a b. PaddedBox a Double -> PaddedBox b Length -> Double
flowMaxWidth PaddedBox a Double
_ PaddedBox {max :: forall m n. PaddedBox m n -> Size m n
B.max = Size (Pixels Double
x) b
_} = Double
x
flowMaxWidth PaddedBox a Double
parent PaddedBox {max :: forall m n. PaddedBox m n -> Size m n
B.max = Size (Percent Double
x) b
_} = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Size a Double -> Double
forall m n. Size m n -> n
inline (Size a Double -> Double) -> Size a Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox a Double -> Size a Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox a Double
parent)
flowMaxWidth PaddedBox a Double
parent self :: PaddedBox b Length
self@PaddedBox {max :: forall m n. PaddedBox m n -> Size m n
B.max = Size Length
Auto b
_} = Size a Double -> Double
forall m n. Size m n -> n
inline (PaddedBox a Double -> Size a Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox a Double
parent) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ws
    where
        ws :: Double
ws = Length -> Double
l2d (Border b Length -> Length
forall m n. Border m n -> n
left (Border b Length -> Length) -> Border b Length -> Length
forall a b. (a -> b) -> a -> b
$ PaddedBox b Length -> Border b Length
forall m n. PaddedBox m n -> Border m n
margin PaddedBox b Length
self) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Length -> Double
l2d (Border b Length -> Length
forall m n. Border m n -> n
left (Border b Length -> Length) -> Border b Length -> Length
forall a b. (a -> b) -> a -> b
$ PaddedBox b Length -> Border b Length
forall m n. PaddedBox m n -> Border m n
border PaddedBox b Length
self) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Length -> Double
l2d (Border b Length -> Length
forall m n. Border m n -> n
left (Border b Length -> Length) -> Border b Length -> Length
forall a b. (a -> b) -> a -> b
$ PaddedBox b Length -> Border b Length
forall m n. PaddedBox m n -> Border m n
padding PaddedBox b Length
self) Double -> Double -> Double
forall a. Num a => a -> a -> a
+
            Length -> Double
l2d (Border b Length -> Length
forall m n. Border m n -> n
right (Border b Length -> Length) -> Border b Length -> Length
forall a b. (a -> b) -> a -> b
$ PaddedBox b Length -> Border b Length
forall m n. PaddedBox m n -> Border m n
padding PaddedBox b Length
self) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Length -> Double
l2d (Border b Length -> Length
forall m n. Border m n -> n
right (Border b Length -> Length) -> Border b Length -> Length
forall a b. (a -> b) -> a -> b
$ PaddedBox b Length -> Border b Length
forall m n. PaddedBox m n -> Border m n
border PaddedBox b Length
self) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Length -> Double
l2d (Border b Length -> Length
forall m n. Border m n -> n
right (Border b Length -> Length) -> Border b Length -> Length
forall a b. (a -> b) -> a -> b
$ PaddedBox b Length -> Border b Length
forall m n. PaddedBox m n -> Border m n
margin PaddedBox b Length
self)
        l2d :: Length -> Double
l2d = Double -> Length -> Double
lowerLength (Double -> Length -> Double) -> Double -> Length -> Double
forall a b. (a -> b) -> a -> b
$ Size a Double -> Double
forall m n. Size m n -> n
inline (Size a Double -> Double) -> Size a Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox a Double -> Size a Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox a Double
parent
flowMaxWidth PaddedBox a Double
parent self :: PaddedBox b Length
self@PaddedBox {max :: forall m n. PaddedBox m n -> Size m n
B.max = Size Length
Preferred b
_} =
    Double -> PaddedBox b Length -> [PaddedBox Any Double] -> Double
forall a b.
Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowNatWidth (Size a Double -> Double
forall m n. Size m n -> n
inline (Size a Double -> Double) -> Size a Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox a Double -> Size a Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox a Double
parent) PaddedBox b Length
self []
flowMaxWidth PaddedBox a Double
parent self :: PaddedBox b Length
self@PaddedBox {max :: forall m n. PaddedBox m n -> Size m n
B.max = Size Length
Min b
_} =
    Double -> PaddedBox b Length -> [PaddedBox Any Double] -> Double
forall a b.
Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowMinWidth (Size a Double -> Double
forall m n. Size m n -> n
inline (Size a Double -> Double) -> Size a Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox a Double -> Size a Double
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox a Double
parent) PaddedBox b Length
self []
-- | Compute final block element width based on cached width computations &
-- parent size.
flowWidth :: PaddedBox a Double -> PaddedBox b Length -> Double
flowWidth :: forall a b. PaddedBox a Double -> PaddedBox b Length -> Double
flowWidth PaddedBox a Double
parent PaddedBox b Length
self
    | Double
small Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
large = Double
small
    | Double
natural Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
large = Double
large
    | Size b Length -> Length
forall m n. Size m n -> n
inline (PaddedBox b Length -> Size b Length
forall m n. PaddedBox m n -> Size m n
size PaddedBox b Length
self) Length -> Length -> Bool
forall a. Eq a => a -> a -> Bool
== Length
Auto = Double
large -- specialcase
    | Double
natural Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
small = Double
natural
    | Bool
otherwise = Double
small
  where
    small :: Double
small = Double -> PaddedBox b Length -> [PaddedBox Any Double] -> Double
forall a b.
Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowMinWidth (Size a Double -> Double
forall m n. Size m n -> n
inline (Size a Double -> Double) -> Size a Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox a Double -> Size a Double
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox a Double
parent) PaddedBox b Length
self []
    natural :: Double
natural = Double -> PaddedBox b Length -> [PaddedBox Any Double] -> Double
forall a b.
Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowNatWidth (Size a Double -> Double
forall m n. Size m n -> n
inline (Size a Double -> Double) -> Size a Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox a Double -> Size a Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox a Double
parent) PaddedBox b Length
self []
    large :: Double
large = PaddedBox a Double -> PaddedBox b Length -> Double
forall a b. PaddedBox a Double -> PaddedBox b Length -> Double
flowMaxWidth PaddedBox a Double
parent PaddedBox b Length
self

-- | Compute natural block element height at cached width.
flowNatHeight :: Double -> PaddedBox Length Double -> [PaddedBox Double Double] -> Double
flowNatHeight :: Double
-> PaddedBox Length Double -> [PaddedBox Double Double] -> Double
flowNatHeight Double
_ PaddedBox {size :: forall m n. PaddedBox m n -> Size m n
size = Size Double
_ (Pixels Double
y)} [PaddedBox Double Double]
_ = Double
y
flowNatHeight Double
parent PaddedBox {size :: forall m n. PaddedBox m n -> Size m n
size = Size Double
_ (Percent Double
y)} [PaddedBox Double Double]
_ = Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
parent
flowNatHeight Double
_ PaddedBox {size :: forall m n. PaddedBox m n -> Size m n
size = Size Double
_ Length
Min} [PaddedBox Double Double]
childs =
    [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (PaddedBox Double Double -> Double)
-> [PaddedBox Double Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map PaddedBox Double Double -> Double
forall {a} {n}. Num a => PaddedBox a n -> a
minHeight ([PaddedBox Double Double] -> [Double])
-> [PaddedBox Double Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ [PaddedBox Double Double] -> [PaddedBox Double Double]
forall n. [PaddedBox Double n] -> [PaddedBox Double n]
marginCollapse [PaddedBox Double Double]
childs
flowNatHeight Double
_ PaddedBox {size :: forall m n. PaddedBox m n -> Size m n
size = Size Double
owidth Length
_} [PaddedBox Double Double]
childs =
    [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (PaddedBox Double Double -> Double)
-> [PaddedBox Double Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map PaddedBox Double Double -> Double
forall {a} {n}. Num a => PaddedBox a n -> a
height ([PaddedBox Double Double] -> [Double])
-> [PaddedBox Double Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ [PaddedBox Double Double] -> [PaddedBox Double Double]
forall n. [PaddedBox Double n] -> [PaddedBox Double n]
marginCollapse [PaddedBox Double Double]
childs
-- | Compute minimum block height at cached width.
flowMinHeight :: Double -> PaddedBox Length Double -> Double
flowMinHeight :: Double -> PaddedBox Length Double -> Double
flowMinHeight Double
_ PaddedBox {min :: forall m n. PaddedBox m n -> Size m n
B.min = Size Double
_ (Pixels Double
y)} = Double
y
flowMinHeight Double
parent PaddedBox {min :: forall m n. PaddedBox m n -> Size m n
B.min = Size Double
_ (Percent Double
y)} = Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
parent
flowMinHeight Double
parent PaddedBox Length Double
self = Double
-> PaddedBox Length Double -> [PaddedBox Double Double] -> Double
flowNatHeight Double
parent PaddedBox Length Double
self []
-- | Compute maximum block height at cached width.
flowMaxHeight :: Double -> PaddedBox Length Double -> Double
flowMaxHeight :: Double -> PaddedBox Length Double -> Double
flowMaxHeight Double
_ PaddedBox {max :: forall m n. PaddedBox m n -> Size m n
B.max = Size Double
_ (Pixels Double
y)} = Double
y
flowMaxHeight Double
parent PaddedBox {max :: forall m n. PaddedBox m n -> Size m n
B.max = Size Double
_ (Percent Double
y)} = Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
parent
flowMaxHeight Double
parent PaddedBox {max :: forall m n. PaddedBox m n -> Size m n
B.max = Size Double
_ Length
Auto} = Double
parent
flowMaxHeight Double
parent self :: PaddedBox Length Double
self@PaddedBox {max :: forall m n. PaddedBox m n -> Size m n
B.max = Size Double
_ Length
Preferred} = Double
-> PaddedBox Length Double -> [PaddedBox Double Double] -> Double
flowNatHeight Double
parent PaddedBox Length Double
self []
flowMaxHeight Double
parent self :: PaddedBox Length Double
self@PaddedBox {max :: forall m n. PaddedBox m n -> Size m n
B.max = Size Double
_ Length
Min} = Double -> PaddedBox Length Double -> Double
flowMinHeight Double
parent PaddedBox Length Double
self
-- | Compute final block height at cached width.
flowHeight :: PaddedBox Double Double -> PaddedBox Length Double -> Double
flowHeight :: PaddedBox Double Double -> PaddedBox Length Double -> Double
flowHeight PaddedBox Double Double
parent PaddedBox Length Double
self
    | Double
small Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
large = Double
small
    | Double
natural Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
large = Double
large
    | Double
natural Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
small = Double
natural
    | Bool
otherwise = Double
small
  where
    small :: Double
small = Double -> PaddedBox Length Double -> Double
flowMinHeight (Size Double Double -> Double
forall m n. Size m n -> m
block (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox Double Double
parent) PaddedBox Length Double
self
    natural :: Double
natural = Double
-> PaddedBox Length Double -> [PaddedBox Double Double] -> Double
flowNatHeight (Size Double Double -> Double
forall m n. Size m n -> m
block (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size Double Double
B.nat PaddedBox Double Double
parent) PaddedBox Length Double
self []
    large :: Double
large = Double -> PaddedBox Length Double -> Double
flowMaxHeight (Size Double Double -> Double
forall m n. Size m n -> m
block (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
B.max PaddedBox Double Double
parent) PaddedBox Length Double
self

-- | Compute position of all children relative to this block element.
positionFlow :: [PaddedBox Double Double] -> [Size Double Double]
positionFlow :: [PaddedBox Double Double] -> [Size Double Double]
positionFlow [PaddedBox Double Double]
childs = (Size Double Double
 -> PaddedBox Double Double -> Size Double Double)
-> Size Double Double
-> [PaddedBox Double Double]
-> [Size Double Double]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Size Double Double -> PaddedBox Double Double -> Size Double Double
forall {m} {m} {n} {n}.
Num m =>
Size m n -> PaddedBox m n -> Size m n
inner (Double -> Double -> Size Double Double
forall m n. n -> m -> Size m n
Size Double
0 Double
0) ([PaddedBox Double Double] -> [Size Double Double])
-> [PaddedBox Double Double] -> [Size Double Double]
forall a b. (a -> b) -> a -> b
$ [PaddedBox Double Double] -> [PaddedBox Double Double]
forall n. [PaddedBox Double n] -> [PaddedBox Double n]
marginCollapse [PaddedBox Double Double]
childs
  where inner :: Size m n -> PaddedBox m n -> Size m n
inner (Size n
x m
y) PaddedBox m n
self = n -> m -> Size m n
forall m n. n -> m -> Size m n
Size n
x (m -> Size m n) -> m -> Size m n
forall a b. (a -> b) -> a -> b
$ PaddedBox m n -> m
forall {a} {n}. Num a => PaddedBox a n -> a
height PaddedBox m n
self
-- | Compute size given block element in given parent,
-- & position of given children.
layoutFlow :: PaddedBox Double Double -> PaddedBox Length Length ->
        [PaddedBox Length Double] ->
        (PaddedBox Double Double, [(Size Double Double, PaddedBox Double Double)])
layoutFlow :: PaddedBox Double Double
-> PaddedBox Length Length
-> [PaddedBox Length Double]
-> (PaddedBox Double Double,
    [(Size Double Double, PaddedBox Double Double)])
layoutFlow PaddedBox Double Double
parent PaddedBox Length Length
self [PaddedBox Length Double]
childs = (PaddedBox Double Double
self', [Size Double Double]
-> [PaddedBox Double Double]
-> [(Size Double Double, PaddedBox Double Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Size Double Double]
positions' [PaddedBox Double Double]
childs')
  where
    positions' :: [Size Double Double]
positions' = [PaddedBox Double Double] -> [Size Double Double]
positionFlow [PaddedBox Double Double]
childs'
    childs' :: [PaddedBox Double Double]
childs' = (PaddedBox Length Double -> PaddedBox Double Double)
-> [PaddedBox Length Double] -> [PaddedBox Double Double]
forall a b. (a -> b) -> [a] -> [b]
map PaddedBox Length Double -> PaddedBox Double Double
layoutZooko [PaddedBox Length Double]
childs
    self' :: PaddedBox Double Double
self' = PaddedBox Length Double
self0 {
        min :: Size Double Double
B.min = (PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox Length Double
self0) { block :: Double
block = Double -> PaddedBox Length Double -> Double
flowMinHeight (Size Double Double -> Double
forall m n. Size m n -> m
block (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox Double Double
parent) PaddedBox Length Double
self0 },
        size :: Size Double Double
size = (PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
self0) { block :: Double
block = PaddedBox Double Double -> PaddedBox Length Double -> Double
flowHeight PaddedBox Double Double
parent PaddedBox Length Double
self0 },
        max :: Size Double Double
B.max = (PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
B.max PaddedBox Length Double
self0) { block :: Double
block = Double -> PaddedBox Length Double -> Double
flowMaxHeight (Size Double Double -> Double
forall m n. Size m n -> m
block (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
B.max PaddedBox Double Double
parent) PaddedBox Length Double
self0 },
        padding :: Border Double Double
padding = (Length -> Double) -> Border Length Double -> Border Double Double
forall m mm n. (m -> mm) -> Border m n -> Border mm n
mapY (Double -> Length -> Double
lowerLength Double
owidth) (Border Length Double -> Border Double Double)
-> Border Length Double -> Border Double Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Border Length Double
forall m n. PaddedBox m n -> Border m n
padding PaddedBox Length Double
self0,
        border :: Border Double Double
border = (Length -> Double) -> Border Length Double -> Border Double Double
forall m mm n. (m -> mm) -> Border m n -> Border mm n
mapY (Double -> Length -> Double
lowerLength Double
owidth) (Border Length Double -> Border Double Double)
-> Border Length Double -> Border Double Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Border Length Double
forall m n. PaddedBox m n -> Border m n
border PaddedBox Length Double
self0,
        margin :: Border Double Double
margin = (Length -> Double) -> Border Length Double -> Border Double Double
forall m mm n. (m -> mm) -> Border m n -> Border mm n
mapY (Double -> Length -> Double
lowerLength Double
owidth) (Border Length Double -> Border Double Double)
-> Border Length Double -> Border Double Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Border Length Double
forall m n. PaddedBox m n -> Border m n
margin PaddedBox Length Double
self0
      }
    self0 :: PaddedBox Length Double
self0 = PaddedBox Length Double
self1 {
        size :: Size Length Double
size = (PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
self1) { block :: Length
block = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
-> PaddedBox Length Double -> [PaddedBox Double Double] -> Double
flowNatHeight Double
oheight PaddedBox Length Double
self1 [PaddedBox Double Double]
childs'}
      }
    self1 :: PaddedBox Length Double
self1 = PaddedBox Length Length
self2 {
        size :: Size Length Double
size = (PaddedBox Length Length -> Size Length Length
forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Length
self2) { inline :: Double
inline = Double
width' },
        max :: Size Length Double
B.max = (PaddedBox Length Length -> Size Length Length
forall m n. PaddedBox m n -> Size m n
B.max PaddedBox Length Length
self2) { inline :: Double
inline = PaddedBox Double Double -> PaddedBox Length Length -> Double
forall a b. PaddedBox a Double -> PaddedBox b Length -> Double
flowMaxWidth PaddedBox Double Double
parent PaddedBox Length Length
self2 },
        min :: Size Length Double
B.min = (PaddedBox Length Length -> Size Length Length
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox Length Length
self2) { inline :: Double
inline = Double
-> PaddedBox Length Length -> [PaddedBox Any Double] -> Double
forall a b.
Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowMinWidth Double
owidth PaddedBox Length Length
self2 [] },
        padding :: Border Length Double
padding = (Length -> Double) -> Border Length Length -> Border Length Double
forall n nn m. (n -> nn) -> Border m n -> Border m nn
mapX (Double -> Length -> Double
lowerLength Double
owidth) (Border Length Length -> Border Length Double)
-> Border Length Length -> Border Length Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Length -> Border Length Length
forall m n. PaddedBox m n -> Border m n
padding PaddedBox Length Length
self2,
        border :: Border Length Double
border = (Length -> Double) -> Border Length Length -> Border Length Double
forall n nn m. (n -> nn) -> Border m n -> Border m nn
mapX (Double -> Length -> Double
lowerLength Double
owidth) (Border Length Length -> Border Length Double)
-> Border Length Length -> Border Length Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Length -> Border Length Length
forall m n. PaddedBox m n -> Border m n
border PaddedBox Length Length
self2,
        margin :: Border Length Double
margin = Double -> Double -> Border Length Length -> Border Length Double
forall m. Double -> Double -> Border m Length -> Border m Double
lowerMargin Double
owidth (Double
owidth Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
width') (Border Length Length -> Border Length Double)
-> Border Length Length -> Border Length Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Length -> Border Length Length
forall m n. PaddedBox m n -> Border m n
margin PaddedBox Length Length
self2
      }
    width' :: Double
width' = PaddedBox Double Double -> PaddedBox Length Length -> Double
forall a b. PaddedBox a Double -> PaddedBox b Length -> Double
flowWidth PaddedBox Double Double
parent PaddedBox Length Length
self
    self2 :: PaddedBox Length Length
self2 = PaddedBox Length Length
self {
        size :: Size Length Length
size = (PaddedBox Length Length -> Size Length Length
forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Length
self) { inline :: Length
inline = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
-> PaddedBox Length Length -> [PaddedBox Length Double] -> Double
forall a b.
Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowNatWidth Double
owidth PaddedBox Length Length
self [PaddedBox Length Double]
childs },
        min :: Size Length Length
B.min = (PaddedBox Length Length -> Size Length Length
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox Length Length
self) { inline :: Length
inline = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
-> PaddedBox Length Length -> [PaddedBox Length Double] -> Double
forall a b.
Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowMinWidth Double
owidth PaddedBox Length Length
self [PaddedBox Length Double]
childs }
      }
    owidth :: Double
owidth = Size Double Double -> Double
forall m n. Size m n -> n
inline (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent
    oheight :: Double
oheight = Size Double Double -> Double
forall m n. Size m n -> m
block (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent
    layoutZooko :: PaddedBox Length Double -> PaddedBox Double Double
layoutZooko PaddedBox Length Double
child = PaddedBox Length Double
child {
        min :: Size Double Double
B.min = Double -> Double -> Size Double Double
forall m n. n -> m -> Size m n
Size (Size Length Double -> Double
forall m n. Size m n -> n
inline (Size Length Double -> Double) -> Size Length Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox Length Double
child) (Double -> PaddedBox Length Double -> Double
flowMinHeight (Size Double Double -> Double
forall m n. Size m n -> m
block (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox Double Double
self') PaddedBox Length Double
child),
        size :: Size Double Double
size = Double -> Double -> Size Double Double
forall m n. n -> m -> Size m n
Size (Size Length Double -> Double
forall m n. Size m n -> n
inline (Size Length Double -> Double) -> Size Length Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
child) (PaddedBox Double Double -> PaddedBox Length Double -> Double
flowHeight PaddedBox Double Double
self' PaddedBox Length Double
child),
        max :: Size Double Double
B.max = Double -> Double -> Size Double Double
forall m n. n -> m -> Size m n
Size (Size Length Double -> Double
forall m n. Size m n -> n
inline (Size Length Double -> Double) -> Size Length Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
B.max PaddedBox Length Double
child) (Double -> PaddedBox Length Double -> Double
flowMaxHeight (Size Double Double -> Double
forall m n. Size m n -> m
block (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
self') PaddedBox Length Double
child),
        padding :: Border Double Double
padding = (Length -> Double) -> Border Length Double -> Border Double Double
forall m mm n. (m -> mm) -> Border m n -> Border mm n
mapY (Double -> Length -> Double
lowerLength Double
owidth) (Border Length Double -> Border Double Double)
-> Border Length Double -> Border Double Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Border Length Double
forall m n. PaddedBox m n -> Border m n
padding PaddedBox Length Double
child,
        border :: Border Double Double
border = (Length -> Double) -> Border Length Double -> Border Double Double
forall m mm n. (m -> mm) -> Border m n -> Border mm n
mapY (Double -> Length -> Double
lowerLength Double
owidth) (Border Length Double -> Border Double Double)
-> Border Length Double -> Border Double Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Border Length Double
forall m n. PaddedBox m n -> Border m n
border PaddedBox Length Double
child,
        margin :: Border Double Double
margin = (Length -> Double) -> Border Length Double -> Border Double Double
forall m mm n. (m -> mm) -> Border m n -> Border mm n
mapY (Double -> Length -> Double
lowerLength Double
owidth) (Border Length Double -> Border Double Double)
-> Border Length Double -> Border Double Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Border Length Double
forall m n. PaddedBox m n -> Border m n
margin PaddedBox Length Double
child
      }

-- | Removes overlapping margins.
marginCollapse :: [PaddedBox Double n] -> [PaddedBox Double n]
marginCollapse :: forall n. [PaddedBox Double n] -> [PaddedBox Double n]
marginCollapse (x' :: PaddedBox Double n
x'@PaddedBox {margin :: forall m n. PaddedBox m n -> Border m n
margin = xm :: Border Double n
xm@Border { bottom :: forall m n. Border m n -> m
bottom = Double
x }}:
        y' :: PaddedBox Double n
y'@PaddedBox {margin :: forall m n. PaddedBox m n -> Border m n
margin = ym :: Border Double n
ym@Border { top :: forall m n. Border m n -> m
top = Double
y}}:[PaddedBox Double n]
rest)
    | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
y = PaddedBox Double n
x'PaddedBox Double n -> [PaddedBox Double n] -> [PaddedBox Double n]
forall a. a -> [a] -> [a]
:[PaddedBox Double n] -> [PaddedBox Double n]
forall n. [PaddedBox Double n] -> [PaddedBox Double n]
marginCollapse (PaddedBox Double n
y' {margin :: Border Double n
margin = Border Double n
ym { top :: Double
top = Double
0 }}PaddedBox Double n -> [PaddedBox Double n] -> [PaddedBox Double n]
forall a. a -> [a] -> [a]
:[PaddedBox Double n]
rest)
    | Bool
otherwise = PaddedBox Double n
x' { margin :: Border Double n
margin = Border Double n
xm { bottom :: Double
bottom = Double
0 }}PaddedBox Double n -> [PaddedBox Double n] -> [PaddedBox Double n]
forall a. a -> [a] -> [a]
:[PaddedBox Double n] -> [PaddedBox Double n]
forall n. [PaddedBox Double n] -> [PaddedBox Double n]
marginCollapse (PaddedBox Double n
y'PaddedBox Double n -> [PaddedBox Double n] -> [PaddedBox Double n]
forall a. a -> [a] -> [a]
:[PaddedBox Double n]
rest)
marginCollapse [PaddedBox Double n]
rest = [PaddedBox Double n]
rest

-- | Resolves auto paddings or margins to fill given width.
lowerMargin :: Double -> Double -> Border m Length -> Border m Double
lowerMargin :: forall m. Double -> Double -> Border m Length -> Border m Double
lowerMargin Double
_ Double
available (Border m
top' m
bottom' Length
Auto Length
Auto) =
    m -> m -> Double -> Double -> Border m Double
forall m n. m -> m -> n -> n -> Border m n
Border m
top' m
bottom' (Double
availableDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (Double
availableDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
lowerMargin Double
outerwidth Double
available (Border m
top' m
bottom' Length
Auto Length
right') =
    m -> m -> Double -> Double -> Border m Double
forall m n. m -> m -> n -> n -> Border m n
Border m
top' m
bottom' Double
available (Double -> Border m Double) -> Double -> Border m Double
forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength Double
outerwidth Length
right'
lowerMargin Double
outerwidth Double
available (Border m
top' m
bottom' Length
left' Length
Auto) =
    m -> m -> Double -> Double -> Border m Double
forall m n. m -> m -> n -> n -> Border m n
Border m
top' m
bottom' (Double -> Length -> Double
lowerLength Double
outerwidth Length
left') Double
available
lowerMargin Double
outerwidth Double
_ (Border m
top' m
bottom' Length
left' Length
right') =
    m -> m -> Double -> Double -> Border m Double
forall m n. m -> m -> n -> n -> Border m n
Border m
top' m
bottom' (Double -> Length -> Double
lowerLength Double
outerwidth Length
left') (Double -> Length -> Double
lowerLength Double
outerwidth Length
right')