{-# LANGUAGE OverloadedStrings, RecordWildCards, StandaloneDeriving #-}
-- | Generic layout logic, handling a hierarchy of varying formulas.
-- Unless callers have more specific needs they probably wish to use this abstraction.
-- Attempts to follow the CSS specs.
-- See `boxLayout` for a main entrypoint,
-- & `Graphics.Layout.CSS` to receive CSS input.
module Graphics.Layout(LayoutItem(..), UserData,
        layoutGetBox, layoutGetChilds, layoutGetInner,
        boxMinWidth, boxMaxWidth, boxNatWidth, boxWidth,
        boxNatHeight, boxMinHeight, boxMaxHeight, boxHeight,
        boxSplit, boxPaginate, boxPosition, boxLayout,
        glyphs, codepoints, fragmentFont, {-, glyphsPerFont-}) where

import Data.Text.ParagraphLayout.Rich (Paragraph(..), ParagraphOptions(..),
                                ParagraphLayout(..), layoutRich)
import Data.Text.ParagraphLayout (paginate, PageContinuity(..), PageOptions(..))
import Stylist (PropertyParser(temp))
import Control.Parallel.Strategies
import Control.DeepSeq (NFData(..))

import Graphics.Layout.Box as B
import Graphics.Layout.Grid as G
import Graphics.Layout.Flow as F
import Graphics.Layout.Inline as I
import Graphics.Layout.CSS.Font (Font'(..))

import Data.Maybe (fromMaybe)

-- To gather glyphs for atlases.
import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import qualified Data.Text.Glyphize as Hb
import Graphics.Text.Font.Choose (Pattern)

-- For comparisons
import Data.Array.Byte (ByteArray(..))
import Data.Text.Array (Array(..))
import Unsafe.Coerce (unsafeCoerce)

-- | Additional data routed through Balkon.
type UserData m n x = ((Font', Int), PaddedBox m n, x)

-- | A tree of different layout algorithms.
-- More to come...
data LayoutItem m n x =
    -- | A block element. With margins, borders, & padding.
    LayoutFlow x (PaddedBox m n) [LayoutItem m n x]
    -- | A grid or table element.
    | LayoutGrid x (Grid m n) [GridItem] [LayoutItem m n x]
    -- | Some richtext. (Balkón holds children)
    | LayoutInline x (Paragraph (UserData m n x)) PageOptions
    -- | Results laying out richtext, has fixed width.
    -- Generated from `LayoutInline` for the sake of pagination.
    | LayoutInline' x (ParagraphLayout (UserData m n x)) PageOptions
    -- | A branch with constant bounding box.
    -- Generated from `LayoutInline` when attaching position info.
    | LayoutConst x (PaddedBox m n) [LayoutItem m n x]
    -- | Children of a `LayoutInline` or `LayoutInline'`.
    | LayoutSpan (FragmentTree (UserData m n x))
    deriving (Int -> LayoutItem m n x -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall m n x.
(Show x, Show n, Show m) =>
Int -> LayoutItem m n x -> ShowS
forall m n x.
(Show x, Show n, Show m) =>
[LayoutItem m n x] -> ShowS
forall m n x.
(Show x, Show n, Show m) =>
LayoutItem m n x -> String
showList :: [LayoutItem m n x] -> ShowS
$cshowList :: forall m n x.
(Show x, Show n, Show m) =>
[LayoutItem m n x] -> ShowS
show :: LayoutItem m n x -> String
$cshow :: forall m n x.
(Show x, Show n, Show m) =>
LayoutItem m n x -> String
showsPrec :: Int -> LayoutItem m n x -> ShowS
$cshowsPrec :: forall m n x.
(Show x, Show n, Show m) =>
Int -> LayoutItem m n x -> ShowS
Show, LayoutItem m n x -> LayoutItem m n x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall m n x.
(Eq x, Eq n, Eq m) =>
LayoutItem m n x -> LayoutItem m n x -> Bool
/= :: LayoutItem m n x -> LayoutItem m n x -> Bool
$c/= :: forall m n x.
(Eq x, Eq n, Eq m) =>
LayoutItem m n x -> LayoutItem m n x -> Bool
== :: LayoutItem m n x -> LayoutItem m n x -> Bool
$c== :: forall m n x.
(Eq x, Eq n, Eq m) =>
LayoutItem m n x -> LayoutItem m n x -> Bool
Eq)
-- | An empty box.
nullLayout :: (PropertyParser x, Zero m, Zero n) => LayoutItem m n x
nullLayout :: forall x m n.
(PropertyParser x, Zero m, Zero n) =>
LayoutItem m n x
nullLayout = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow forall a. PropertyParser a => a
temp forall a. Zero a => a
zero []

instance (Zero m, CastDouble m, NFData m, Zero n, CastDouble n, NFData n) =>
        NFData (LayoutItem m n x) where
    rnf :: LayoutItem m n x -> ()
rnf = forall a. NFData a => a -> ()
rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox -- Avoid auxiliary properties that don't cleanly `rnf`

--- | Retrieve the surrounding box for a layout item.
layoutGetBox :: (Zero m, Zero n, CastDouble m, CastDouble n) =>
        LayoutItem m n x -> PaddedBox m n
layoutGetBox :: forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox (LayoutFlow x
_ PaddedBox m n
ret [LayoutItem m n x]
_) = PaddedBox m n
ret
layoutGetBox (LayoutGrid x
_ Grid m n
self [GridItem]
_ [LayoutItem m n x]
_) = forall a. Zero a => a
zero {
    min :: Size m n
B.min = forall m n. n -> m -> Size m n
Size (forall a. CastDouble a => Double -> a
fromDouble forall a b. (a -> b) -> a -> b
$ forall n. (n -> Double) -> Track n -> Double
trackMin forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline Grid m n
self)
            (forall a. CastDouble a => Double -> a
fromDouble forall a b. (a -> b) -> a -> b
$ forall n. (n -> Double) -> Track n -> Double
trackMin forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> m
block Grid m n
self),
    size :: Size m n
B.size = forall m n. n -> m -> Size m n
Size (forall a. CastDouble a => Double -> a
fromDouble forall a b. (a -> b) -> a -> b
$ forall n. (n -> Double) -> Track n -> Double
trackNat forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline Grid m n
self)
            (forall a. CastDouble a => Double -> a
fromDouble forall a b. (a -> b) -> a -> b
$ forall n. (n -> Double) -> Track n -> Double
trackNat forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> m
block Grid m n
self),
    max :: Size m n
B.max = forall m n. n -> m -> Size m n
Size (forall a. CastDouble a => Double -> a
fromDouble forall a b. (a -> b) -> a -> b
$ forall n. (n -> Double) -> Track n -> Double
trackNat forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline Grid m n
self)
            (forall a. CastDouble a => Double -> a
fromDouble forall a b. (a -> b) -> a -> b
$ forall n. (n -> Double) -> Track n -> Double
trackNat forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> m
block Grid m n
self)
}
layoutGetBox (LayoutInline x
_ Paragraph (UserData m n x)
self PageOptions
_) = forall a. Zero a => a
zero {
    min :: Size m n
B.min = forall x y a c.
(CastDouble x, CastDouble y) =>
Paragraph (a, PaddedBox x y, c) -> Size x y
inlineMin Paragraph (UserData m n x)
self, size :: Size m n
B.size = forall x y a c.
(CastDouble x, CastDouble y) =>
Paragraph (a, PaddedBox x y, c) -> Size x y
inlineSize Paragraph (UserData m n x)
self, max :: Size m n
B.max = forall x y a c.
(CastDouble x, CastDouble y) =>
Paragraph (a, PaddedBox x y, c) -> Size x y
inlineSize Paragraph (UserData m n x)
self
}
layoutGetBox (LayoutInline' x
_ ParagraphLayout (UserData m n x)
self PageOptions
_) = forall a. Zero a => a
zero {
    min :: Size m n
B.min = forall x y a.
(CastDouble x, CastDouble y) =>
ParagraphLayout a -> Size x y
layoutSize ParagraphLayout (UserData m n x)
self, size :: Size m n
B.size = forall x y a.
(CastDouble x, CastDouble y) =>
ParagraphLayout a -> Size x y
layoutSize ParagraphLayout (UserData m n x)
self, max :: Size m n
B.max = forall x y a.
(CastDouble x, CastDouble y) =>
ParagraphLayout a -> Size x y
layoutSize ParagraphLayout (UserData m n x)
self
}
layoutGetBox (LayoutSpan FragmentTree (UserData m n x)
self) = forall m n a c.
(CastDouble m, CastDouble n) =>
FragmentTree (a, PaddedBox m n, c) -> PaddedBox m n
treeBox FragmentTree (UserData m n x)
self
layoutGetBox (LayoutConst x
_ PaddedBox m n
ret [LayoutItem m n x]
_) = PaddedBox m n
ret
-- | Retrieve the subtree under a node.
layoutGetChilds :: LayoutItem m n x -> [LayoutItem m n x]
layoutGetChilds (LayoutFlow x
_ PaddedBox m n
_ [LayoutItem m n x]
ret) = [LayoutItem m n x]
ret
layoutGetChilds (LayoutGrid x
_ Grid m n
_ [GridItem]
_ [LayoutItem m n x]
ret) = [LayoutItem m n x]
ret
layoutGetChilds (LayoutSpan FragmentTree (UserData m n x)
_) = []
layoutGetChilds (LayoutInline x
_ Paragraph (UserData m n x)
self PageOptions
_) = forall a b. (a -> b) -> [a] -> [b]
map forall m n x. FragmentTree (UserData m n x) -> LayoutItem m n x
LayoutSpan forall a b. (a -> b) -> a -> b
$ forall x y a c.
(CastDouble x, CastDouble y, Eq x, Eq y, Eq a, Eq c) =>
Paragraph (a, PaddedBox x y, c)
-> [FragmentTree (a, PaddedBox x y, c)]
inlineChildren Paragraph (UserData m n x)
self
layoutGetChilds (LayoutInline' x
_ ParagraphLayout (UserData m n x)
self PageOptions
_) = forall a b. (a -> b) -> [a] -> [b]
map forall m n x. FragmentTree (UserData m n x) -> LayoutItem m n x
LayoutSpan forall a b. (a -> b) -> a -> b
$ forall a. Eq a => ParagraphLayout a -> [FragmentTree a]
layoutChildren ParagraphLayout (UserData m n x)
self
layoutGetChilds (LayoutConst x
_ PaddedBox m n
_ [LayoutItem m n x]
childs) = [LayoutItem m n x]
childs
-- | Retrieve the caller-specified data attached to a layout node.
layoutGetInner :: LayoutItem m n x -> x
layoutGetInner (LayoutFlow x
ret PaddedBox m n
_ [LayoutItem m n x]
_) = x
ret
layoutGetInner (LayoutGrid x
ret Grid m n
_ [GridItem]
_ [LayoutItem m n x]
_) = x
ret
layoutGetInner (LayoutInline x
ret Paragraph (UserData m n x)
_ PageOptions
_) = x
ret
layoutGetInner (LayoutInline' x
ret ParagraphLayout (UserData m n x)
_ PageOptions
_) = x
ret
layoutGetInner (LayoutConst x
ret PaddedBox m n
_ [LayoutItem m n x]
_) = x
ret
layoutGetInner (LayoutSpan FragmentTree (UserData m n x)
x) = forall a b c. FragmentTree (a, b, c) -> c
treeInner FragmentTree (UserData m n x)
x

fragmentFont :: FragmentTree (a, b, c) -> a
fragmentFont FragmentTree (a, b, c)
x = let (a
ret, b
_, c
_) = forall a. FragmentTree a -> a
treeInner' FragmentTree (a, b, c)
x in a
ret

-- | map-ready wrapper around `setCellBox` sourcing from a child node.
setCellBox' :: (LayoutItem m n x, GridItem) -> GridItem
setCellBox' (LayoutItem m n x
child, GridItem
cell) = forall m n.
(CastDouble m, CastDouble n) =>
GridItem -> PaddedBox m n -> GridItem
setCellBox GridItem
cell forall a b. (a -> b) -> a -> b
$ forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox LayoutItem m n x
child

-- | Update a (sub)tree to compute & cache minimum legible sizes.
boxMinWidth :: (Zero y, CastDouble y, NFData y) =>
        Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMinWidth :: forall y x.
(Zero y, CastDouble y, NFData y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMinWidth Maybe Double
parent (LayoutFlow x
val PaddedBox y Length
self [LayoutItem y Length x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val PaddedBox y Length
self' [LayoutItem y Length x]
childs'
  where
    self' :: PaddedBox y Length
self' = PaddedBox y Length
self { min :: Size y Length
B.min = forall n nn m. (n -> nn) -> Size m n -> Size m nn
mapSizeX (Double -> Length -> Length
B.mapAuto Double
min') (forall m n. PaddedBox m n -> Size m n
B.min PaddedBox y Length
self) }
    min' :: Double
min' = forall a b.
Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowMinWidth Double
parent' PaddedBox y Length
self [PaddedBox y Double]
childs''
    childs'' :: [PaddedBox y Double]
childs'' = forall a b. (a -> b) -> [a] -> [b]
map (forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength Double
selfWidth) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox [LayoutItem y Length x]
childs'
    childs' :: [LayoutItem y Length x]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' (forall y x.
(Zero y, CastDouble y, NFData y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMinWidth forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Double
selfWidth) [LayoutItem y Length x]
childs
    selfWidth :: Double
selfWidth = forall {a} {m}. Num a => PaddedBox m a -> a
width forall a b. (a -> b) -> a -> b
$ forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' (Double -> Length -> Double
lowerLength Double
parent') PaddedBox y Length
self
    parent' :: Double
parent' = forall a. a -> Maybe a -> a
fromMaybe Double
0 Maybe Double
parent
boxMinWidth Maybe Double
parent (LayoutGrid x
val Grid y Length
self [GridItem]
cells0 [LayoutItem y Length x]
childs) = forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid x
val Grid y Length
self' [GridItem]
cells' [LayoutItem y Length x]
childs'
  where
    self' :: Grid y Length
self' = forall m n. n -> m -> Size m n
Size (forall m n. Size m n -> n
inline Grid y Length
self) { trackMins :: [Double]
trackMins = [Double]
cells } (forall m n. Size m n -> m
block Grid y Length
self)
    cells :: [Double]
cells = Double -> Track Length -> [GridItem'] -> [Double]
sizeTrackMins Double
parent' (forall m n. Size m n -> n
inline Grid y Length
self) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall m n. Size m n -> n
inline [GridItem]
cells'
    cells' :: [GridItem]
cells' = forall a b. (a -> b) -> [a] -> [b]
map forall {m} {n} {x}.
(CastDouble m, CastDouble n, Zero m, Zero n) =>
(LayoutItem m n x, GridItem) -> GridItem
setCellBox' forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [LayoutItem y Length x]
childs' [GridItem]
cells0 -- Flatten subgrids
    childs'' :: [PaddedBox y Double]
childs'' = forall a b. (a -> b) -> [a] -> [b]
map (forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength Double
selfWidth) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox [LayoutItem y Length x]
childs'
    childs' :: [LayoutItem y Length x]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' (forall y x.
(Zero y, CastDouble y, NFData y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMinWidth forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Double
selfWidth) [LayoutItem y Length x]
childs
    selfWidth :: Double
selfWidth = forall n. (n -> Double) -> Track n -> Double
trackNat (Double -> Length -> Double
lowerLength Double
parent') forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline Grid y Length
self
    parent' :: Double
parent' = forall a. a -> Maybe a -> a
fromMaybe (forall y. Grid y Length -> [GridItem] -> Double
gridEstWidth Grid y Length
self [GridItem]
cells0) Maybe Double
parent
    zeroBox :: PaddedBox Double Double
    zeroBox :: PaddedBox Double Double
zeroBox = forall a. Zero a => a
zero
boxMinWidth Maybe Double
_ self :: LayoutItem y Length x
self@(LayoutInline x
_ Paragraph (UserData y Length x)
_ PageOptions
_) = LayoutItem y Length x
self
boxMinWidth Maybe Double
_ self :: LayoutItem y Length x
self@(LayoutInline' x
_ ParagraphLayout (UserData y Length x)
_ PageOptions
_) = LayoutItem y Length x
self
boxMinWidth Maybe Double
_ (LayoutConst x
val PaddedBox y Length
self' [LayoutItem y Length x]
childs) =
    forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutConst x
val PaddedBox y Length
self' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall y x.
(Zero y, CastDouble y, NFData y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMinWidth forall a. Maybe a
Nothing) [LayoutItem y Length x]
childs
boxMinWidth Maybe Double
_ self :: LayoutItem y Length x
self@(LayoutSpan FragmentTree (UserData y Length x)
_) = LayoutItem y Length x
self
-- | Update a (sub)tree to compute & cache ideal width.
boxNatWidth :: (Zero y, CastDouble y, NFData y) =>
        Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxNatWidth :: forall y x.
(Zero y, CastDouble y, NFData y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxNatWidth Maybe Double
parent (LayoutFlow x
val PaddedBox y Length
self [LayoutItem y Length x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val PaddedBox y Length
self' [LayoutItem y Length x]
childs'
  where
    self' :: PaddedBox y Length
self' = PaddedBox y Length
self { nat :: Size Double Double
B.nat = forall m n. n -> m -> Size m n
Size Double
size' forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> m
block forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size Double Double
B.nat PaddedBox y Length
self }
    size' :: Double
size' = forall a b.
Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowNatWidth Double
parent' PaddedBox y Length
self [PaddedBox y Double]
childs''
    childs'' :: [PaddedBox y Double]
childs'' = forall a b. (a -> b) -> [a] -> [b]
map (forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength Double
selfWidth) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox [LayoutItem y Length x]
childs'
    childs' :: [LayoutItem y Length x]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' (forall y x.
(Zero y, CastDouble y, NFData y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxNatWidth forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Double
selfWidth) [LayoutItem y Length x]
childs
    selfWidth :: Double
selfWidth = forall {a} {m}. Num a => PaddedBox m a -> a
width forall a b. (a -> b) -> a -> b
$ forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' (Double -> Length -> Double
lowerLength Double
parent') PaddedBox y Length
self
    parent' :: Double
parent' = forall a. a -> Maybe a -> a
fromMaybe Double
0 Maybe Double
parent
boxNatWidth Maybe Double
parent (LayoutGrid x
val Grid y Length
self [GridItem]
cells0 [LayoutItem y Length x]
childs) = forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid x
val Grid y Length
self' [GridItem]
cells' [LayoutItem y Length x]
childs'
  where
    self' :: Grid y Length
self' = forall m n. n -> m -> Size m n
Size (forall m n. Size m n -> n
inline Grid y Length
self) { trackNats :: [Double]
trackNats = [Double]
cells } (forall m n. Size m n -> m
block Grid y Length
self)
    cells :: [Double]
cells = Double -> Track Length -> [GridItem'] -> [Double]
sizeTrackNats Double
parent' (forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ Grid y Length
self) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall m n. Size m n -> n
inline [GridItem]
cells'
    cells' :: [GridItem]
cells' = forall a b. (a -> b) -> [a] -> [b]
map forall {m} {n} {x}.
(CastDouble m, CastDouble n, Zero m, Zero n) =>
(LayoutItem m n x, GridItem) -> GridItem
setCellBox' forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [LayoutItem y Length x]
childs' [GridItem]
cells0 -- Flatten subgrids
    childs'' :: [PaddedBox y Double]
childs'' = forall a b. (a -> b) -> [a] -> [b]
map (forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength Double
selfWidth) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox [LayoutItem y Length x]
childs'
    childs' :: [LayoutItem y Length x]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' (forall y x.
(Zero y, CastDouble y, NFData y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxNatWidth forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Double
selfWidth) [LayoutItem y Length x]
childs
    selfWidth :: Double
selfWidth = forall n. (n -> Double) -> Track n -> Double
trackNat (Double -> Length -> Double
lowerLength Double
parent') forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline Grid y Length
self
    parent' :: Double
parent' = forall a. a -> Maybe a -> a
fromMaybe (forall y. Grid y Length -> [GridItem] -> Double
gridEstWidth Grid y Length
self [GridItem]
cells0) Maybe Double
parent
    zeroBox :: PaddedBox Double Double
    zeroBox :: PaddedBox Double Double
zeroBox = forall a. Zero a => a
zero
boxNatWidth Maybe Double
_ self :: LayoutItem y Length x
self@(LayoutInline x
_ Paragraph (UserData y Length x)
_ PageOptions
_) = LayoutItem y Length x
self
boxNatWidth Maybe Double
_ self :: LayoutItem y Length x
self@(LayoutInline' x
_ ParagraphLayout (UserData y Length x)
_ PageOptions
_) = LayoutItem y Length x
self
boxNatWidth Maybe Double
_ (LayoutConst x
val PaddedBox y Length
self' [LayoutItem y Length x]
childs) =
    forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutConst x
val PaddedBox y Length
self' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall y x.
(Zero y, CastDouble y, NFData y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxNatWidth forall a. Maybe a
Nothing) [LayoutItem y Length x]
childs
boxNatWidth Maybe Double
_ self :: LayoutItem y Length x
self@(LayoutSpan FragmentTree (UserData y Length x)
_) = LayoutItem y Length x
self
-- | Update a (sub)tree to compute & cache maximum legible width.
boxMaxWidth :: (CastDouble y, Zero y, NFData y) =>
        PaddedBox a Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMaxWidth :: forall y a x.
(CastDouble y, Zero y, NFData y) =>
PaddedBox a Double
-> LayoutItem y Length x -> LayoutItem y Length x
boxMaxWidth PaddedBox a Double
parent (LayoutFlow x
val PaddedBox y Length
self [LayoutItem y Length x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val PaddedBox y Length
self' [LayoutItem y Length x]
childs'
  where
    childs' :: [LayoutItem y Length x]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' (forall y a x.
(CastDouble y, Zero y, NFData y) =>
PaddedBox a Double
-> LayoutItem y Length x -> LayoutItem y Length x
boxMaxWidth PaddedBox y Double
self'') [LayoutItem y Length x]
childs
    self'' :: PaddedBox y Double
self'' = forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' (Double -> Length -> Double
lowerLength forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
B.size PaddedBox a Double
parent) PaddedBox y Length
self'
    self' :: PaddedBox y Length
self' = PaddedBox y Length
self { max :: Size y Length
B.max = forall m n. n -> m -> Size m n
Size (Double -> Length
Pixels Double
max') (forall m n. Size m n -> m
block forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
B.max PaddedBox y Length
self) }
    max' :: Double
max' = forall a b. PaddedBox a Double -> PaddedBox b Length -> Double
flowMaxWidth PaddedBox a Double
parent PaddedBox y Length
self
boxMaxWidth PaddedBox a Double
parent (LayoutGrid x
val Grid y Length
self [GridItem]
cells [LayoutItem y Length x]
childs) = forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid x
val Grid y Length
self [GridItem]
cells [LayoutItem y Length x]
childs'
  where -- Propagate parent track as default.
    childs' :: [LayoutItem y Length x]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' forall {y} {x}.
(Zero y, NFData y, CastDouble y) =>
(GridItem, LayoutItem y Length x) -> LayoutItem y Length x
inner forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [GridItem]
cells [LayoutItem y Length x]
childs
    inner :: (GridItem, LayoutItem y Length x) -> LayoutItem y Length x
inner (Size GridItem'
cellx GridItem'
celly, LayoutItem y Length x
child) =
        forall y a x.
(CastDouble y, Zero y, NFData y) =>
PaddedBox a Double
-> LayoutItem y Length x -> LayoutItem y Length x
boxMaxWidth (forall x. CastDouble x => Track x -> GridItem' -> Double
cellSize (forall m n. Size m n -> n
inline Grid y Length
self) GridItem'
cellx Double -> Double -> PaddedBox Double Double
`size2box` forall x. CastDouble x => Track x -> GridItem' -> Double
cellSize (forall m n. Size m n -> m
block Grid y Length
self) GridItem'
celly) LayoutItem y Length x
child
    size2box :: Double -> Double -> PaddedBox Double Double
size2box Double
x Double
y = PaddedBox Double Double
zeroBox { min :: Size Double Double
B.min = forall m n. n -> m -> Size m n
Size Double
x Double
y, max :: Size Double Double
B.max = forall m n. n -> m -> Size m n
Size Double
x Double
y, size :: Size Double Double
B.size = forall m n. n -> m -> Size m n
Size Double
x Double
y }
boxMaxWidth PaddedBox a Double
parent self :: LayoutItem y Length x
self@(LayoutInline x
_ Paragraph (UserData y Length x)
_ PageOptions
_) = LayoutItem y Length x
self
boxMaxWidth PaddedBox a Double
parent self :: LayoutItem y Length x
self@(LayoutInline' x
_ ParagraphLayout (UserData y Length x)
_ PageOptions
_) = LayoutItem y Length x
self
boxMaxWidth PaddedBox a Double
_ (LayoutConst x
val PaddedBox y Length
self' [LayoutItem y Length x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutConst x
val PaddedBox y Length
self' forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (forall y a x.
(CastDouble y, Zero y, NFData y) =>
PaddedBox a Double
-> LayoutItem y Length x -> LayoutItem y Length x
boxMaxWidth forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' forall a. CastDouble a => a -> Double
toDouble PaddedBox y Length
self') [LayoutItem y Length x]
childs
boxMaxWidth PaddedBox a Double
parent self :: LayoutItem y Length x
self@(LayoutSpan FragmentTree (UserData y Length x)
_) = LayoutItem y Length x
self
-- | Update a (sub)tree to compute & cache final width.
boxWidth :: (Zero y, CastDouble y, NFData y) =>
        PaddedBox b Double -> LayoutItem y Length x -> LayoutItem y Double x
boxWidth :: forall y b x.
(Zero y, CastDouble y, NFData y) =>
PaddedBox b Double
-> LayoutItem y Length x -> LayoutItem y Double x
boxWidth PaddedBox b Double
parent (LayoutFlow x
val PaddedBox y Length
self [LayoutItem y Length x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val PaddedBox y Double
self' [LayoutItem y Double x]
childs'
  where
    childs' :: [LayoutItem y Double x]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' (forall y b x.
(Zero y, CastDouble y, NFData y) =>
PaddedBox b Double
-> LayoutItem y Length x -> LayoutItem y Double x
boxWidth PaddedBox y Double
self') [LayoutItem y Length x]
childs
    self' :: PaddedBox y Double
self' = (forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' (Double -> Length -> Double
lowerLength forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox b Double
parent) PaddedBox y Length
self) {
        size :: Size y Double
size = forall m n. n -> m -> Size m n
Size Double
size' forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> m
block forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
B.max PaddedBox y Length
self
      }
    size' :: Double
size' = forall a b. PaddedBox a Double -> PaddedBox b Length -> Double
flowWidth PaddedBox b Double
parent PaddedBox y Length
self
boxWidth PaddedBox b Double
parent (LayoutGrid x
val Grid y Length
self [GridItem]
cells [LayoutItem y Length x]
childs) = forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid x
val Size (Track y) (Track Double)
self' [GridItem]
cells' [LayoutItem y Double x]
childs'
  where -- Propagate parent track as default
    ([GridItem]
cells', [LayoutItem y Double x]
childs') = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' forall {y} {x}.
(NFData y, CastDouble y, Zero y) =>
(GridItem, LayoutItem y Length x)
-> (GridItem, LayoutItem y Double x)
recurse forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [GridItem]
cells [LayoutItem y Length x]
childs
    recurse :: (GridItem, LayoutItem y Length x)
-> (GridItem, LayoutItem y Double x)
recurse (GridItem
cell, LayoutItem y Length x
child) = (GridItem
cell', LayoutItem y Double x
child')
      where
        cell' :: GridItem
cell' = forall m n.
(CastDouble m, CastDouble n) =>
GridItem -> PaddedBox m n -> GridItem
setCellBox GridItem
cell forall a b. (a -> b) -> a -> b
$ forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox LayoutItem y Double x
child'
        child' :: LayoutItem y Double x
child' = forall y b x.
(Zero y, CastDouble y, NFData y) =>
PaddedBox b Double
-> LayoutItem y Length x -> LayoutItem y Double x
boxWidth (forall x y.
(CastDouble x, CastDouble y) =>
Grid y x -> GridItem -> PaddedBox Double Double
gridItemBox Grid y Length
self GridItem
cell) LayoutItem y Length x
child
    self' :: Size (Track y) (Track Double)
self' = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall m n. n -> m -> Size m n
Size (forall m n. Size m n -> m
block Grid y Length
self) Track {
        cells :: [Either Double Double]
cells = forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left [Double]
widths,
        trackMins :: [Double]
trackMins = forall x. Track x -> [Double]
trackMins forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline Grid y Length
self, trackNats :: [Double]
trackNats = forall x. Track x -> [Double]
trackNats forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline Grid y Length
self,
        gap :: Double
gap = Double -> Length -> Double
lowerLength Double
outerwidth forall a b. (a -> b) -> a -> b
$ forall x. Track x -> x
gap forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline Grid y Length
self
    }
    outerwidth :: Double
outerwidth = forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox b Double
parent
    widths :: [Double]
widths = Double -> Track Length -> [Double]
sizeTrackMaxs (forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox b Double
parent) forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline Grid y Length
self
boxWidth PaddedBox b Double
parent (LayoutInline x
val (Paragraph Array
a Int
b RootNode Int (UserData y Length x)
c ParagraphOptions
d) PageOptions
paging) =
    forall m n x.
x -> Paragraph (UserData m n x) -> PageOptions -> LayoutItem m n x
LayoutInline x
val (forall b b' a c.
(b -> b') -> Paragraph (a, b, c) -> Paragraph (a, b', c)
paragraphMap (forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength Double
width) forall a b. (a -> b) -> a -> b
$
        forall d.
Array -> Int -> RootNode Int d -> ParagraphOptions -> Paragraph d
Paragraph Array
a Int
b RootNode Int (UserData y Length x)
c ParagraphOptions
d { paragraphMaxWidth :: Int32
paragraphMaxWidth = forall a b. (RealFrac a, Integral b) => a -> b
round Double
width }) PageOptions
paging
  where width :: Double
width = forall m n. Size m n -> n
B.inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
B.size PaddedBox b Double
parent
boxWidth PaddedBox b Double
p (LayoutInline' x
a ParagraphLayout (UserData y Length x)
b PageOptions
c) =
    forall m n x.
x
-> ParagraphLayout (UserData m n x)
-> PageOptions
-> LayoutItem m n x
LayoutInline' x
a (forall b b' a c.
(b -> b')
-> ParagraphLayout (a, b, c) -> ParagraphLayout (a, b', c)
layoutMap (forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
B.inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
B.size PaddedBox b Double
p) ParagraphLayout (UserData y Length x)
b) PageOptions
c
boxWidth PaddedBox b Double
p (LayoutConst x
val PaddedBox y Length
self [LayoutItem y Length x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutConst x
val (forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' Length -> Double
cb PaddedBox y Length
self) forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (forall y b x.
(Zero y, CastDouble y, NFData y) =>
PaddedBox b Double
-> LayoutItem y Length x -> LayoutItem y Double x
boxWidth forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' Length -> Double
cb PaddedBox y Length
self) [LayoutItem y Length x]
childs
  where cb :: Length -> Double
cb = Double -> Length -> Double
lowerLength forall a b. (a -> b) -> a -> b
$ forall {a} {m}. Num a => PaddedBox m a -> a
width PaddedBox b Double
p
boxWidth PaddedBox b Double
parent (LayoutSpan FragmentTree (UserData y Length x)
self') =
    forall m n x. FragmentTree (UserData m n x) -> LayoutItem m n x
LayoutSpan forall a b. (a -> b) -> a -> b
$ forall b b' a c.
(b -> b') -> FragmentTree (a, b, c) -> FragmentTree (a, b', c)
treeMap (forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength forall a b. (a -> b) -> a -> b
$ forall {a} {m}. Num a => PaddedBox m a -> a
width PaddedBox b Double
parent) FragmentTree (UserData y Length x)
self'

-- | Update a (sub)tree to compute & cache ideal legible height.
boxNatHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxNatHeight :: forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxNatHeight Double
parent (LayoutFlow x
val PaddedBox Length Double
self [LayoutItem Length Double x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val PaddedBox Length Double
self' [LayoutItem Length Double x]
childs'
  where
    self' :: PaddedBox Length Double
self' = PaddedBox Length Double
self { size :: Size Length Double
size = forall m mm n. (m -> mm) -> Size m n -> Size mm n
mapSizeY (Double -> Length -> Length
mapAuto Double
size') (forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
self) }
    size' :: Double
size' = Double
-> PaddedBox Length Double -> [PaddedBox Double Double] -> Double
flowNatHeight Double
parent PaddedBox Length Double
self [PaddedBox Double Double]
childs''
    childs'' :: [PaddedBox Double Double]
childs'' = forall a b. (a -> b) -> [a] -> [b]
map (forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' (Double -> Length -> Double
lowerLength Double
parent)) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox [LayoutItem Length Double x]
childs'
    childs' :: [LayoutItem Length Double x]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' (forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxNatHeight forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
self) [LayoutItem Length Double x]
childs
boxNatHeight Double
parent (LayoutGrid x
val Grid Length Double
self [GridItem]
cells [LayoutItem Length Double x]
childs) = forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid x
val Grid Length Double
self' [GridItem]
cells [LayoutItem Length Double x]
childs'
  where
    self' :: Grid Length Double
self' = forall m n. n -> m -> Size m n
Size (forall m n. Size m n -> n
inline Grid Length Double
self) (forall m n. Size m n -> m
block Grid Length Double
self) { trackNats :: [Double]
trackNats = [Double]
heights }
    heights :: [Double]
heights = Double -> Track Length -> [GridItem'] -> [Double]
sizeTrackNats Double
parent (forall m n. Size m n -> m
block Grid Length Double
self) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall m n. Size m n -> m
block [GridItem]
cells'
    cells' :: [GridItem]
cells' = forall a b. (a -> b) -> [a] -> [b]
map forall {m} {n} {x}.
(CastDouble m, CastDouble n, Zero m, Zero n) =>
(LayoutItem m n x, GridItem) -> GridItem
setCellBox' forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [LayoutItem Length Double x]
childs' [GridItem]
cells -- Flatten subgrids
    childs' :: [LayoutItem Length Double x]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' (forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxNatHeight Double
width) [LayoutItem Length Double x]
childs
    width :: Double
width = forall n. (n -> Double) -> Track n -> Double
trackNat forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline Grid Length Double
self
boxNatHeight Double
parent self :: LayoutItem Length Double x
self@(LayoutInline x
_ Paragraph (UserData Length Double x)
_ PageOptions
_) = LayoutItem Length Double x
self
boxNatHeight Double
parent self :: LayoutItem Length Double x
self@(LayoutInline' x
_ ParagraphLayout (UserData Length Double x)
_ PageOptions
_) = LayoutItem Length Double x
self
boxNatHeight Double
p (LayoutConst x
val PaddedBox Length Double
self' [LayoutItem Length Double x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutConst x
val PaddedBox Length Double
self' forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxNatHeight forall a b. (a -> b) -> a -> b
$ forall {a} {m}. Num a => PaddedBox m a -> a
width forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' (Double -> Length -> Double
lowerLength Double
p) PaddedBox Length Double
self') [LayoutItem Length Double x]
childs
boxNatHeight Double
parent self :: LayoutItem Length Double x
self@(LayoutSpan FragmentTree (UserData Length Double x)
_) = LayoutItem Length Double x
self
-- | Update a (sub)tree to compute & cache minimum legible height.
boxMinHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxMinHeight :: forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxMinHeight Double
parent (LayoutFlow x
val PaddedBox Length Double
self [LayoutItem Length Double x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val PaddedBox Length Double
self' [LayoutItem Length Double x]
childs'
  where
    childs' :: [LayoutItem Length Double x]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' (forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxMinHeight forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
self) [LayoutItem Length Double x]
childs
    self' :: PaddedBox Length Double
self' = PaddedBox Length Double
self { min :: Size Length Double
B.min = forall m n. n -> m -> Size m n
Size (forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
B.min PaddedBox Length Double
self) (Double -> Length
Pixels Double
min') }
    min' :: Double
min' = Double -> PaddedBox Length Double -> Double
flowMinHeight Double
parent PaddedBox Length Double
self
boxMinHeight Double
parent (LayoutGrid x
val Grid Length Double
self [GridItem]
cells [LayoutItem Length Double x]
childs) = forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid x
val Grid Length Double
self' [GridItem]
cells' [LayoutItem Length Double x]
childs'
  where
    ([GridItem]
cells', [LayoutItem Length Double x]
childs') = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' forall {x}.
(GridItem, LayoutItem Length Double x)
-> (GridItem, LayoutItem Length Double x)
recurse forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [GridItem]
cells [LayoutItem Length Double x]
childs
    recurse :: (GridItem, LayoutItem Length Double x)
-> (GridItem, LayoutItem Length Double x)
recurse (GridItem
cell, LayoutItem Length Double x
child) = (GridItem
cell', LayoutItem Length Double x
child') -- Propagate track into subgrids.
      where
        cell' :: GridItem
cell' = forall m n.
(CastDouble m, CastDouble n) =>
GridItem -> PaddedBox m n -> GridItem
setCellBox GridItem
cell (forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox LayoutItem Length Double x
child')
        child' :: LayoutItem Length Double x
child' = forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxMinHeight Double
width LayoutItem Length Double x
child
    self' :: Grid Length Double
self' = forall m n. n -> m -> Size m n
Size (forall m n. Size m n -> n
inline Grid Length Double
self) (forall m n. Size m n -> m
block Grid Length Double
self) { trackMins :: [Double]
trackMins = [Double]
heights }
    heights :: [Double]
heights = Double -> Track Length -> [GridItem'] -> [Double]
sizeTrackMins Double
width (forall m n. Size m n -> m
block Grid Length Double
self) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall m n. Size m n -> m
block [GridItem]
cells
    width :: Double
width = forall n. (n -> Double) -> Track n -> Double
trackNat forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline Grid Length Double
self
boxMinHeight Double
parent self :: LayoutItem Length Double x
self@(LayoutInline x
_ Paragraph (UserData Length Double x)
_ PageOptions
_) = LayoutItem Length Double x
self
boxMinHeight Double
_ self :: LayoutItem Length Double x
self@(LayoutInline' x
_ ParagraphLayout (UserData Length Double x)
_ PageOptions
_) = LayoutItem Length Double x
self
boxMinHeight Double
p (LayoutConst x
val PaddedBox Length Double
self' [LayoutItem Length Double x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutConst x
val PaddedBox Length Double
self' forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxMinHeight forall a b. (a -> b) -> a -> b
$ forall {a} {m}. Num a => PaddedBox m a -> a
width forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' (Double -> Length -> Double
lowerLength Double
p) PaddedBox Length Double
self') [LayoutItem Length Double x]
childs
boxMinHeight Double
parent self :: LayoutItem Length Double x
self@(LayoutSpan FragmentTree (UserData Length Double x)
_) = LayoutItem Length Double x
self
-- | Update a subtree to compute & cache maximum legible height.
boxMaxHeight :: PaddedBox Double Double -> LayoutItem Length Double x ->
        LayoutItem Length Double x
boxMaxHeight :: forall x.
PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Length Double x
boxMaxHeight PaddedBox Double Double
parent (LayoutFlow x
val PaddedBox Length Double
self [LayoutItem Length Double x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val PaddedBox Length Double
self' [LayoutItem Length Double x]
childs'
  where
    childs' :: [LayoutItem Length Double x]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' (forall x.
PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Length Double x
boxMaxHeight forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' (Double -> Length -> Double
lowerLength Double
width) PaddedBox Length Double
self') [LayoutItem Length Double x]
childs
    self' :: PaddedBox Length Double
self' = PaddedBox Length Double
self { max :: Size Length Double
B.max = forall m n. n -> m -> Size m n
Size (forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
B.max PaddedBox Length Double
self) (Double -> Length
Pixels Double
max') }
    max' :: Double
max' = Double -> PaddedBox Length Double -> Double
flowMaxHeight (forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) PaddedBox Length Double
self
    width :: Double
width = forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
self
boxMaxHeight PaddedBox Double Double
parent (LayoutGrid x
val Grid Length Double
self [GridItem]
cells [LayoutItem Length Double x]
childs) = forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid x
val Grid Length Double
self [GridItem]
cells' [LayoutItem Length Double x]
childs'
  where
    ([GridItem]
cells', [LayoutItem Length Double x]
childs') = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' forall {x}.
(GridItem, LayoutItem Length Double x)
-> (GridItem, LayoutItem Length Double x)
recurse forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [GridItem]
cells [LayoutItem Length Double x]
childs
    recurse :: (GridItem, LayoutItem Length Double x)
-> (GridItem, LayoutItem Length Double x)
recurse (GridItem
cell, LayoutItem Length Double x
child) = (GridItem
cell', LayoutItem Length Double x
child') -- Propagate track into subgrids
      where
        cell' :: GridItem
cell' = forall m n.
(CastDouble m, CastDouble n) =>
GridItem -> PaddedBox m n -> GridItem
setCellBox GridItem
cell (forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox LayoutItem Length Double x
child')
        child' :: LayoutItem Length Double x
child' = forall x.
PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Length Double x
boxMaxHeight (forall x y.
(CastDouble x, CastDouble y) =>
Grid y x -> GridItem -> PaddedBox Double Double
gridItemBox Grid Length Double
self GridItem
cell) LayoutItem Length Double x
child
    heights :: [Double]
heights = Double -> Track Length -> [Double]
sizeTrackMaxs (forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) (forall m n. Size m n -> m
block Grid Length Double
self)
    width :: Double
width = forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent
boxMaxHeight PaddedBox Double Double
_ (LayoutInline x
val Paragraph (UserData Length Double x)
self' PageOptions
paging) = forall m n x.
x -> Paragraph (UserData m n x) -> PageOptions -> LayoutItem m n x
LayoutInline x
val Paragraph (UserData Length Double x)
self' PageOptions
paging
boxMaxHeight PaddedBox Double Double
_ (LayoutInline' x
val ParagraphLayout (UserData Length Double x)
self' PageOptions
paging) = forall m n x.
x
-> ParagraphLayout (UserData m n x)
-> PageOptions
-> LayoutItem m n x
LayoutInline' x
val ParagraphLayout (UserData Length Double x)
self' PageOptions
paging
boxMaxHeight PaddedBox Double Double
p (LayoutConst x
val PaddedBox Length Double
self' [LayoutItem Length Double x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutConst x
val PaddedBox Length Double
self' forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (forall x.
PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Length Double x
boxMaxHeight forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' (Double -> Length -> Double
lowerLength forall a b. (a -> b) -> a -> b
$ forall {a} {m}. Num a => PaddedBox m a -> a
width PaddedBox Double Double
p) PaddedBox Length Double
self') [LayoutItem Length Double x]
childs
boxMaxHeight PaddedBox Double Double
parent (LayoutSpan FragmentTree (UserData Length Double x)
self') = forall m n x. FragmentTree (UserData m n x) -> LayoutItem m n x
LayoutSpan FragmentTree (UserData Length Double x)
self'
-- | Update a (sub)tree to compute & cache final height.
boxHeight :: PaddedBox Double Double -> LayoutItem Length Double x -> LayoutItem Double Double x
boxHeight :: forall x.
PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Double Double x
boxHeight PaddedBox Double Double
parent (LayoutFlow x
val PaddedBox Length Double
self [LayoutItem Length Double x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val PaddedBox Double Double
self' [LayoutItem Double Double x]
childs'
  where
    childs' :: [LayoutItem Double Double x]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' (forall x.
PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Double Double x
boxHeight PaddedBox Double Double
self') [LayoutItem Length Double x]
childs
    self' :: PaddedBox Double Double
self' = (forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' (Double -> Length -> Double
lowerLength forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) PaddedBox Length Double
self) {
        size :: Size Double Double
size = forall m n. n -> m -> Size m n
Size (forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
self) Double
size'
      }
    size' :: Double
size' = PaddedBox Double Double -> PaddedBox Length Double -> Double
flowHeight PaddedBox Double Double
parent PaddedBox Length Double
self
    width :: Double
width = forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
self
boxHeight PaddedBox Double Double
parent (LayoutGrid x
val Grid Length Double
self [GridItem]
cells0 [LayoutItem Length Double x]
childs) = forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid x
val Size (Track Double) (Track Double)
self' [GridItem]
cells' [LayoutItem Double Double x]
childs'
  where
    ([GridItem]
cells', [LayoutItem Double Double x]
childs') = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' forall {x}.
(GridItem, LayoutItem Length Double x)
-> (GridItem, LayoutItem Double Double x)
recurse forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [GridItem]
cells0 [LayoutItem Length Double x]
childs
    recurse :: (GridItem, LayoutItem Length Double x)
-> (GridItem, LayoutItem Double Double x)
recurse (GridItem
cell, LayoutItem Length Double x
child) = (GridItem
cell', LayoutItem Double Double x
child') -- Propagate track into subgrids.
      where
        cell' :: GridItem
cell' = forall m n.
(CastDouble m, CastDouble n) =>
GridItem -> PaddedBox m n -> GridItem
setCellBox GridItem
cell (forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox LayoutItem Double Double x
child')
        child' :: LayoutItem Double Double x
child' = forall x.
PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Double Double x
boxHeight (forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox forall a b. (a -> b) -> a -> b
$ forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid x
val Size (Track Double) (Track Double)
self' [] []) LayoutItem Length Double x
child
    self' :: Size (Track Double) (Track Double)
self' = forall m n. n -> m -> Size m n
Size (forall m n. Size m n -> n
inline Grid Length Double
self) Track {
        gap :: Double
gap = Double -> Length -> Double
lowerLength Double
width forall a b. (a -> b) -> a -> b
$ forall x. Track x -> x
gap forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> m
block Grid Length Double
self,
        cells :: [Either Double Double]
cells = forall a b. (a -> b) -> [a] -> [b]
map forall {b}. Either Length b -> Either Double b
lowerSize forall a b. (a -> b) -> a -> b
$ forall x. Track x -> [Either x Double]
cells forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> m
block Grid Length Double
self,
        trackMins :: [Double]
trackMins = forall x. Track x -> [Double]
trackMins forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> m
block Grid Length Double
self, trackNats :: [Double]
trackNats = forall x. Track x -> [Double]
trackNats forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> m
block Grid Length Double
self
      }
    heights :: [Double]
heights = Double -> Track Length -> [Double]
sizeTrackMaxs (forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) forall a b. (a -> b) -> a -> b
$ forall m n. Size m n -> m
block Grid Length Double
self
    lowerSize :: Either Length b -> Either Double b
lowerSize (Left Length
x) = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength Double
width Length
x
    lowerSize (Right b
x) = forall a b. b -> Either a b
Right b
x
    width :: Double
width = forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent
boxHeight PaddedBox Double Double
p (LayoutInline x
val Paragraph (UserData Length Double x)
self' PageOptions
paging) =
    forall m n x.
x -> Paragraph (UserData m n x) -> PageOptions -> LayoutItem m n x
LayoutInline x
val (forall b b' a c.
(b -> b') -> Paragraph (a, b, c) -> Paragraph (a, b', c)
paragraphMap (forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength forall a b. (a -> b) -> a -> b
$ forall {a} {m}. Num a => PaddedBox m a -> a
width PaddedBox Double Double
p) Paragraph (UserData Length Double x)
self') PageOptions
paging
boxHeight PaddedBox Double Double
p (LayoutInline' x
val ParagraphLayout (UserData Length Double x)
self' PageOptions
paging) =
    forall m n x.
x
-> ParagraphLayout (UserData m n x)
-> PageOptions
-> LayoutItem m n x
LayoutInline' x
val (forall b b' a c.
(b -> b')
-> ParagraphLayout (a, b, c) -> ParagraphLayout (a, b', c)
layoutMap (forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength forall a b. (a -> b) -> a -> b
$ forall {a} {m}. Num a => PaddedBox m a -> a
width PaddedBox Double Double
p) ParagraphLayout (UserData Length Double x)
self') PageOptions
paging
boxHeight PaddedBox Double Double
p (LayoutConst x
val PaddedBox Length Double
self [LayoutItem Length Double x]
childs) =
    let self' :: PaddedBox Double Double
self' = forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' (Double -> Length -> Double
lowerLength forall a b. (a -> b) -> a -> b
$ forall {a} {m}. Num a => PaddedBox m a -> a
width PaddedBox Double Double
p) PaddedBox Length Double
self
    in forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutConst x
val PaddedBox Double Double
self' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall x.
PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Double Double x
boxHeight PaddedBox Double Double
self') [LayoutItem Length Double x]
childs
boxHeight PaddedBox Double Double
p (LayoutSpan FragmentTree (UserData Length Double x)
self') =
    forall m n x. FragmentTree (UserData m n x) -> LayoutItem m n x
LayoutSpan forall a b. (a -> b) -> a -> b
$ forall b b' a c.
(b -> b') -> FragmentTree (a, b, c) -> FragmentTree (a, b', c)
treeMap (forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength forall a b. (a -> b) -> a -> b
$ forall {a} {m}. Num a => PaddedBox m a -> a
width PaddedBox Double Double
p) FragmentTree (UserData Length Double x)
self'

-- | Split a (sub)tree to fit within max-height.
-- May take full page height into account.
boxSplit :: PropertyParser x => Double -> Double -> LayoutItem Double Double x ->
    (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
boxSplit :: forall x.
PropertyParser x =>
Double
-> Double
-> LayoutItem Double Double x
-> (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
boxSplit Double
maxheight Double
_ LayoutItem Double Double x
node | forall {a} {n}. Num a => PaddedBox a n -> a
height (forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox LayoutItem Double Double x
node) forall a. Ord a => a -> a -> Bool
<= Double
maxheight = (LayoutItem Double Double x
node, forall a. Maybe a
Nothing)
boxSplit Double
maxheight Double
pageheight (LayoutFlow x
val PaddedBox Double Double
self [LayoutItem Double Double x]
childs)
    | (LayoutItem Double Double x
next:[LayoutItem Double Double x]
_) <- [LayoutItem Double Double x]
childs1, ((Double
y,LayoutItem Double Double x
_):[(Double, LayoutItem Double Double x)]
_) <- [(Double, LayoutItem Double Double x)]
childs0',
        (LayoutItem Double Double x
tail,Just LayoutItem Double Double x
nextpage) <- forall x.
PropertyParser x =>
Double
-> Double
-> LayoutItem Double Double x
-> (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
boxSplit (Double
maxheight forall a. Num a => a -> a -> a
- Double
y) Double
pageheight LayoutItem Double Double x
next =
            (forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val PaddedBox Double Double
self {
                size :: Size Double Double
size = (forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
self) { block :: Double
B.block = Double
y }
            } ([LayoutItem Double Double x]
childs0 forall a. [a] -> [a] -> [a]
++ [LayoutItem Double Double x
tail]),
             forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val PaddedBox Double Double
self {
                size :: Size Double Double
size = (forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
self) { block :: Double
B.block = forall m n. Size m n -> m
B.block (forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
self) forall a. Num a => a -> a -> a
- Double
y }
             } (LayoutItem Double Double x
nextpageforall a. a -> [a] -> [a]
:[LayoutItem Double Double x]
childs1))
    | Bool
otherwise =
        (forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val PaddedBox Double Double
self { size :: Size Double Double
size = (forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
self) { block :: Double
B.block = Double
maxheight } } [LayoutItem Double Double x]
childs0,
         forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val PaddedBox Double Double
self [LayoutItem Double Double x]
childs1) -- TODO recompute height
  where
    childs0 :: [LayoutItem Double Double x]
childs0 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Double, LayoutItem Double Double x)]
childs0'
    childs1 :: [LayoutItem Double Double x]
childs1 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Double, LayoutItem Double Double x)]
childs1'
    ([(Double, LayoutItem Double Double x)]
childs0', [(Double, LayoutItem Double Double x)]
childs1') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break forall {b}. (Double, b) -> Bool
overflowed forall a b. (a -> b) -> a -> b
$ forall {t} {n} {x}.
(Num t, Zero t, Zero n, CastDouble t, CastDouble n) =>
t -> [LayoutItem t n x] -> [(t, LayoutItem t n x)]
inner Double
0 [LayoutItem Double Double x]
childs
    overflowed :: (Double, b) -> Bool
overflowed (Double
y, b
_) = Double
y forall a. Ord a => a -> a -> Bool
>= Double
maxheight
    inner :: t -> [LayoutItem t n x] -> [(t, LayoutItem t n x)]
inner t
start (LayoutItem t n x
child:[LayoutItem t n x]
childs) = (t
start', LayoutItem t n x
child)forall a. a -> [a] -> [a]
:t -> [LayoutItem t n x] -> [(t, LayoutItem t n x)]
inner t
start' [LayoutItem t n x]
childs -- TODO margin collapse?
        where start' :: t
start' = t
start forall a. Num a => a -> a -> a
+ forall {a} {n}. Num a => PaddedBox a n -> a
height (forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox LayoutItem t n x
child)
    inner t
_ [] = []
boxSplit Double
_ Double
_ self :: LayoutItem Double Double x
self@(LayoutConst x
_ PaddedBox Double Double
_ [LayoutItem Double Double x]
_) = (LayoutItem Double Double x
self, forall a. Maybe a
Nothing) -- Doesn't split.
boxSplit Double
_ Double
_ self :: LayoutItem Double Double x
self@(LayoutGrid x
_ Size (Track Double) (Track Double)
_ [GridItem]
_ [LayoutItem Double Double x]
_) = (LayoutItem Double Double x
self, forall a. Maybe a
Nothing) -- TODO
boxSplit Double
maxheight Double
pageheight (LayoutInline x
a Paragraph (UserData Double Double x)
self PageOptions
b) =
    forall x.
PropertyParser x =>
Double
-> Double
-> LayoutItem Double Double x
-> (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
boxSplit Double
maxheight Double
pageheight forall a b. (a -> b) -> a -> b
$ forall m n x.
x
-> ParagraphLayout (UserData m n x)
-> PageOptions
-> LayoutItem m n x
LayoutInline' x
a (forall d. Paragraph d -> ParagraphLayout d
layoutRich Paragraph (UserData Double Double x)
self) PageOptions
b
boxSplit Double
maxheight Double
pageheight (LayoutInline' x
a ParagraphLayout (UserData Double Double x)
self PageOptions
paging) =
    case forall pl.
Paginable pl =>
PageOptions -> pl -> (PageContinuity, pl, Maybe pl)
paginate PageOptions
paging {
            pageCurrentHeight :: Int32
pageCurrentHeight = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Double
maxheight,
            pageNextHeight :: Int32
pageNextHeight = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Double
pageheight
      } ParagraphLayout (UserData Double Double x)
self of
        (PageContinuity
Continue, ParagraphLayout (UserData Double Double x)
self', Maybe (ParagraphLayout (UserData Double Double x))
next) -> (forall {m} {n}.
ParagraphLayout (UserData m n x) -> LayoutItem m n x
wrap ParagraphLayout (UserData Double Double x)
self', forall {m} {n}.
ParagraphLayout (UserData m n x) -> LayoutItem m n x
wrap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ParagraphLayout (UserData Double Double x))
next)
        (PageContinuity
Break, ParagraphLayout (UserData Double Double x)
_, Maybe (ParagraphLayout (UserData Double Double x))
_) -> (forall x m n.
(PropertyParser x, Zero m, Zero n) =>
LayoutItem m n x
nullLayout, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {m} {n}.
ParagraphLayout (UserData m n x) -> LayoutItem m n x
wrap ParagraphLayout (UserData Double Double x)
self)
  where
    wrap :: ParagraphLayout (UserData m n x) -> LayoutItem m n x
wrap ParagraphLayout (UserData m n x)
self' = forall m n x.
x
-> ParagraphLayout (UserData m n x)
-> PageOptions
-> LayoutItem m n x
LayoutInline' x
a ParagraphLayout (UserData m n x)
self' PageOptions
paging
boxSplit Double
_ Double
_ self :: LayoutItem Double Double x
self@(LayoutSpan FragmentTree (UserData Double Double x)
_) = (LayoutItem Double Double x
self, forall a. Maybe a
Nothing) -- Can't split!
-- | Generate a list of pages from a node, splitting subtrees where necessary.
boxPaginate :: Double
-> LayoutItem Double Double x -> [LayoutItem Double Double x]
boxPaginate Double
pageheight LayoutItem Double Double x
node
    | (LayoutItem Double Double x
page, Just LayoutItem Double Double x
overflow) <- forall x.
PropertyParser x =>
Double
-> Double
-> LayoutItem Double Double x
-> (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
boxSplit Double
pageheight Double
pageheight LayoutItem Double Double x
node =
        LayoutItem Double Double x
pageforall a. a -> [a] -> [a]
:Double
-> LayoutItem Double Double x -> [LayoutItem Double Double x]
boxPaginate Double
pageheight LayoutItem Double Double x
overflow
    | Bool
otherwise = [LayoutItem Double Double x
node]

-- | Compute position of all nodes in the (sub)tree relative to a base coordinate.
boxPosition :: (PropertyParser x, Eq x) => (Double, Double) ->
    LayoutItem Double Double x -> LayoutItem Double Double ((Double, Double), x)
boxPosition :: forall x.
(PropertyParser x, Eq x) =>
(Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
boxPosition pos :: (Double, Double)
pos@(Double
x, Double
y) (LayoutFlow x
val PaddedBox Double Double
self [LayoutItem Double Double x]
childs) = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow ((Double, Double)
pos, x
val) PaddedBox Double Double
self [LayoutItem Double Double ((Double, Double), x)]
childs'
  where
    childs' :: [LayoutItem Double Double ((Double, Double), x)]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' forall {x}.
(PropertyParser x, Eq x) =>
(Size Double Double, LayoutItem Double Double x)
-> LayoutItem Double Double ((Double, Double), x)
recurse forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Size Double Double]
pos' [LayoutItem Double Double x]
childs
    recurse :: (Size Double Double, LayoutItem Double Double x)
-> LayoutItem Double Double ((Double, Double), x)
recurse ((Size Double
x' Double
y'), LayoutItem Double Double x
child) = forall x.
(PropertyParser x, Eq x) =>
(Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
boxPosition (Double
x forall a. Num a => a -> a -> a
+ Double
x', Double
y forall a. Num a => a -> a -> a
+ Double
y') LayoutItem Double Double x
child
    pos' :: [Size Double Double]
pos' = [PaddedBox Double Double] -> [Size Double Double]
positionFlow forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox [LayoutItem Double Double x]
childs
boxPosition pos :: (Double, Double)
pos@(Double
x, Double
y) (LayoutGrid x
val Size (Track Double) (Track Double)
self [GridItem]
cells [LayoutItem Double Double x]
childs) = forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid ((Double, Double)
pos, x
val) Size (Track Double) (Track Double)
self [GridItem]
cells [LayoutItem Double Double ((Double, Double), x)]
childs'
  where
    childs' :: [LayoutItem Double Double ((Double, Double), x)]
childs' = forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' forall {x}.
(PropertyParser x, Eq x) =>
((Double, Double), LayoutItem Double Double x)
-> LayoutItem Double Double ((Double, Double), x)
recurse forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [(Double, Double)]
pos' [LayoutItem Double Double x]
childs
    recurse :: ((Double, Double), LayoutItem Double Double x)
-> LayoutItem Double Double ((Double, Double), x)
recurse ((Double
x', Double
y'), LayoutItem Double Double x
child) = forall x.
(PropertyParser x, Eq x) =>
(Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
boxPosition (Double
x forall a. Num a => a -> a -> a
+ Double
x', Double
y forall a. Num a => a -> a -> a
+ Double
y') LayoutItem Double Double x
child
    pos' :: [(Double, Double)]
pos' = Size (Track Double) (Track Double)
-> [GridItem] -> [(Double, Double)]
gridPosition Size (Track Double) (Track Double)
self [GridItem]
cells
boxPosition pos :: (Double, Double)
pos@(Double
x, Double
y) (LayoutInline x
val Paragraph (UserData Double Double x)
self PageOptions
paging) =
    forall x.
(PropertyParser x, Eq x) =>
(Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
boxPosition (Double, Double)
pos forall a b. (a -> b) -> a -> b
$ forall m n x.
x
-> ParagraphLayout (UserData m n x)
-> PageOptions
-> LayoutItem m n x
LayoutInline' x
val (forall d. Paragraph d -> ParagraphLayout d
layoutRich Paragraph (UserData Double Double x)
self) PageOptions
paging
boxPosition pos :: (Double, Double)
pos@(Double
x, Double
y) self :: LayoutItem Double Double x
self@(LayoutInline' x
val ParagraphLayout (UserData Double Double x)
_ PageOptions
_) =
    forall x.
(PropertyParser x, Eq x) =>
(Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
boxPosition (Double, Double)
pos forall a b. (a -> b) -> a -> b
$ forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutConst x
val (forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox LayoutItem Double Double x
self) forall a b. (a -> b) -> a -> b
$ forall {m} {n} {x}.
(CastDouble m, CastDouble n, Eq m, Eq n, Eq x) =>
LayoutItem m n x -> [LayoutItem m n x]
layoutGetChilds LayoutItem Double Double x
self
boxPosition (Double, Double)
pos (LayoutConst x
val PaddedBox Double Double
self [LayoutItem Double Double x]
childs) =
    forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutConst ((Double, Double)
pos, x
val) PaddedBox Double Double
self forall a b. (a -> b) -> a -> b
$ forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' (forall x.
(PropertyParser x, Eq x) =>
(Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
boxPosition (Double, Double)
pos) [LayoutItem Double Double x]
childs
boxPosition (Double, Double)
pos (LayoutSpan FragmentTree (UserData Double Double x)
self) = forall m n x. FragmentTree (UserData m n x) -> LayoutItem m n x
LayoutSpan forall a b. (a -> b) -> a -> b
$ forall m n a c.
(CastDouble m, CastDouble n) =>
(Double, Double)
-> FragmentTree (a, PaddedBox m n, c)
-> FragmentTree (a, PaddedBox m n, ((Double, Double), c))
positionTree (Double, Double)
pos FragmentTree (UserData Double Double x)
self
-- | Compute sizes & position information for all nodes in the (sub)tree.
boxLayout :: (PropertyParser x, Eq x) => PaddedBox Double Double ->
        LayoutItem Length Length x -> Bool -> 
        [LayoutItem Double Double ((Double, Double), x)]
boxLayout :: forall x.
(PropertyParser x, Eq x) =>
PaddedBox Double Double
-> LayoutItem Length Length x
-> Bool
-> [LayoutItem Double Double ((Double, Double), x)]
boxLayout PaddedBox Double Double
parent LayoutItem Length Length x
self Bool
paginate = [LayoutItem Double Double ((Double, Double), x)]
self9
  where
    self0 :: LayoutItem Length Length x
self0 = forall y x.
(Zero y, CastDouble y, NFData y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMinWidth forall a. Maybe a
Nothing LayoutItem Length Length x
self
    self1 :: LayoutItem Length Length x
self1 = forall y x.
(Zero y, CastDouble y, NFData y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxNatWidth forall a. Maybe a
Nothing LayoutItem Length Length x
self0
    self2 :: LayoutItem Length Length x
self2 = forall y a x.
(CastDouble y, Zero y, NFData y) =>
PaddedBox a Double
-> LayoutItem y Length x -> LayoutItem y Length x
boxMaxWidth PaddedBox Double Double
parent LayoutItem Length Length x
self1
    self3 :: LayoutItem Length Double x
self3 = forall y b x.
(Zero y, CastDouble y, NFData y) =>
PaddedBox b Double
-> LayoutItem y Length x -> LayoutItem y Double x
boxWidth PaddedBox Double Double
parent LayoutItem Length Length x
self2
    self4 :: LayoutItem Length Double x
self4 = forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxNatHeight (forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) LayoutItem Length Double x
self3
    self5 :: LayoutItem Length Double x
self5 = forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxMinHeight (forall m n. Size m n -> n
inline forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) LayoutItem Length Double x
self4
    self6 :: LayoutItem Length Double x
self6 = forall x.
PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Length Double x
boxMaxHeight PaddedBox Double Double
parent LayoutItem Length Double x
self5
    self7 :: LayoutItem Double Double x
self7 = forall x.
PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Double Double x
boxHeight PaddedBox Double Double
parent LayoutItem Length Double x
self6
    self8 :: [LayoutItem Double Double x]
self8 | Bool
paginate = forall {x}.
PropertyParser x =>
Double
-> LayoutItem Double Double x -> [LayoutItem Double Double x]
boxPaginate (forall m n. Size m n -> m
block forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) LayoutItem Double Double x
self7
        | Bool
otherwise = [LayoutItem Double Double x
self7]
    self9 :: [LayoutItem Double Double ((Double, Double), x)]
self9 = forall a b. (a -> b) -> [a] -> [b]
map (forall x.
(PropertyParser x, Eq x) =>
(Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
boxPosition (Double
0, Double
0)) [LayoutItem Double Double x]
self8

-- | Compute a mapping from a layout tree indicating which glyphs for which fonts
-- are required.
-- Useful for assembling glyph atlases.
glyphsPerFont :: (CastDouble x, CastDouble y, Eq x, Eq y, Eq z) =>
        LayoutItem x y z -> M.Map (Pattern, Double) IS.IntSet
glyphsPerFont :: forall x y z.
(CastDouble x, CastDouble y, Eq x, Eq y, Eq z) =>
LayoutItem x y z -> Map (Pattern, Double) IntSet
glyphsPerFont (LayoutSpan FragmentTree (UserData x y z)
self) | (Int
_:[Int]
_) <- [Int]
glyphs =
        (Font' -> Pattern
pattern Font'
font, Font' -> Double
fontSize Font'
font) forall k a. k -> a -> Map k a
`M.singleton` [Int] -> IntSet
IS.fromList [Int]
glyphs
    | Bool
otherwise = forall k a. Map k a
M.empty
  where
    glyphs :: [Int]
glyphs = forall a b. (a -> b) -> [a] -> [b]
map forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ forall x. FragmentTree x -> [Word32]
codepoints FragmentTree (UserData x y z)
self
    (Font'
font, Int
_) = forall {a} {b} {c}. FragmentTree (a, b, c) -> a
fragmentFont FragmentTree (UserData x y z)
self
glyphsPerFont LayoutItem x y z
node = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith IntSet -> IntSet -> IntSet
IS.union forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall x y z.
(CastDouble x, CastDouble y, Eq x, Eq y, Eq z) =>
LayoutItem x y z -> Map (Pattern, Double) IntSet
glyphsPerFont forall a b. (a -> b) -> a -> b
$ forall {m} {n} {x}.
(CastDouble m, CastDouble n, Eq m, Eq n, Eq x) =>
LayoutItem m n x -> [LayoutItem m n x]
layoutGetChilds LayoutItem x y z
node

parMap' :: NFData b => (a -> b) -> [a] -> [b]
parMap' :: forall b a. NFData b => (a -> b) -> [a] -> [b]
parMap' = forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap forall a. NFData a => Strategy a
rdeepseq

------
--- Orphan typeclass instances
------

instance Show (Paragraph x) where
    show :: Paragraph x -> String
show (Paragraph Array
arr Int
_ RootNode Int x
_ ParagraphOptions
_) = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Array -> ByteArray
asBA Array
arr
deriving instance Show PageOptions
instance Eq (Paragraph x) where
    Paragraph Array
a Int
_ RootNode Int x
_ ParagraphOptions
_ == :: Paragraph x -> Paragraph x -> Bool
== Paragraph Array
b Int
_ RootNode Int x
_ ParagraphOptions
_ = Array -> ByteArray
asBA Array
a  forall a. Eq a => a -> a -> Bool
== Array -> ByteArray
asBA Array
b
deriving instance Eq PageOptions

asBA :: Array -> ByteArray
asBA = forall a b. a -> b
unsafeCoerce :: Array -> ByteArray