{-# 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

-- | Retrieve the font associated with inline layout.
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