{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
-- | 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(..),
        layoutGetBox, layoutGetChilds, layoutGetInner,
        boxMinWidth, boxMaxWidth, boxNatWidth, boxWidth,
        boxNatHeight, boxMinHeight, boxMaxHeight, boxHeight,
        boxSplit, boxPaginate, boxPosition, boxLayout, glyphsPerFont) where

import Data.Text.ParagraphLayout (Paragraph(..), ParagraphOptions(..), Fragment(..),
        ParagraphLayout(..), PageOptions(..), PageContinuity(..), paginate, layoutPlain)
import Stylist (PropertyParser(..))

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)

-- | 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.
    | LayoutInline x Font' Paragraph PageOptions [x] -- Balkon holds children.
    -- | Results laying out richtext, has fixed width.
    -- Generated from `LayoutInline` for the sake of pagination.
    | LayoutInline' x Font' ParagraphLayout PageOptions [x]
    -- | Children of a `LayoutInline` or `LayoutInline'`.
    | LayoutSpan x Font' Fragment
-- | An empty box.
nullLayout :: (PropertyParser x, Zero m, Zero n) => LayoutItem m n x
nullLayout :: LayoutItem m n x
nullLayout = x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
forall a. PropertyParser a => a
temp PaddedBox m n
forall a. Zero a => a
zero []

--- | 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 :: LayoutItem m n x -> PaddedBox m n
layoutGetBox (LayoutFlow _ ret :: PaddedBox m n
ret _) = PaddedBox m n
ret
layoutGetBox (LayoutGrid _ self :: Grid m n
self _ _) = PaddedBox m n
forall a. Zero a => a
zero {
    min :: Size m n
B.min = n -> m -> Size m n
forall m n. n -> m -> Size m n
Size (Double -> n
forall a. CastDouble a => Double -> a
fromDouble (Double -> n) -> Double -> n
forall a b. (a -> b) -> a -> b
$ (n -> Double) -> Track n -> Double
forall n. (n -> Double) -> Track n -> Double
trackMin n -> Double
forall a. CastDouble a => a -> Double
toDouble (Track n -> Double) -> Track n -> Double
forall a b. (a -> b) -> a -> b
$ Grid m n -> Track n
forall m n. Size m n -> n
inline Grid m n
self)
            (Double -> m
forall a. CastDouble a => Double -> a
fromDouble (Double -> m) -> Double -> m
forall a b. (a -> b) -> a -> b
$ (m -> Double) -> Track m -> Double
forall n. (n -> Double) -> Track n -> Double
trackMin m -> Double
forall a. CastDouble a => a -> Double
toDouble (Track m -> Double) -> Track m -> Double
forall a b. (a -> b) -> a -> b
$ Grid m n -> Track m
forall m n. Size m n -> m
block Grid m n
self),
    size :: Size m n
B.size = n -> m -> Size m n
forall m n. n -> m -> Size m n
Size (Double -> n
forall a. CastDouble a => Double -> a
fromDouble (Double -> n) -> Double -> n
forall a b. (a -> b) -> a -> b
$ (n -> Double) -> Track n -> Double
forall n. (n -> Double) -> Track n -> Double
trackNat n -> Double
forall a. CastDouble a => a -> Double
toDouble (Track n -> Double) -> Track n -> Double
forall a b. (a -> b) -> a -> b
$ Grid m n -> Track n
forall m n. Size m n -> n
inline Grid m n
self)
            (Double -> m
forall a. CastDouble a => Double -> a
fromDouble (Double -> m) -> Double -> m
forall a b. (a -> b) -> a -> b
$ (m -> Double) -> Track m -> Double
forall n. (n -> Double) -> Track n -> Double
trackNat m -> Double
forall a. CastDouble a => a -> Double
toDouble (Track m -> Double) -> Track m -> Double
forall a b. (a -> b) -> a -> b
$ Grid m n -> Track m
forall m n. Size m n -> m
block Grid m n
self),
    max :: Size m n
B.max = n -> m -> Size m n
forall m n. n -> m -> Size m n
Size (Double -> n
forall a. CastDouble a => Double -> a
fromDouble (Double -> n) -> Double -> n
forall a b. (a -> b) -> a -> b
$ (n -> Double) -> Track n -> Double
forall n. (n -> Double) -> Track n -> Double
trackNat n -> Double
forall a. CastDouble a => a -> Double
toDouble (Track n -> Double) -> Track n -> Double
forall a b. (a -> b) -> a -> b
$ Grid m n -> Track n
forall m n. Size m n -> n
inline Grid m n
self)
            (Double -> m
forall a. CastDouble a => Double -> a
fromDouble (Double -> m) -> Double -> m
forall a b. (a -> b) -> a -> b
$ (m -> Double) -> Track m -> Double
forall n. (n -> Double) -> Track n -> Double
trackNat m -> Double
forall a. CastDouble a => a -> Double
toDouble (Track m -> Double) -> Track m -> Double
forall a b. (a -> b) -> a -> b
$ Grid m n -> Track m
forall m n. Size m n -> m
block Grid m n
self)
}
layoutGetBox (LayoutInline _ f :: Font'
f self :: Paragraph
self _ _) = PaddedBox m n
forall a. Zero a => a
zero {
    min :: Size m n
B.min = Font' -> Paragraph -> Size m n
forall x y.
(CastDouble x, CastDouble y) =>
Font' -> Paragraph -> Size x y
inlineMin Font'
f Paragraph
self, size :: Size m n
B.size = Font' -> Paragraph -> Size m n
forall x y.
(CastDouble x, CastDouble y) =>
Font' -> Paragraph -> Size x y
inlineSize Font'
f Paragraph
self, max :: Size m n
B.max = Font' -> Paragraph -> Size m n
forall x y.
(CastDouble x, CastDouble y) =>
Font' -> Paragraph -> Size x y
inlineSize Font'
f Paragraph
self
}
layoutGetBox (LayoutInline' _ f :: Font'
f self :: ParagraphLayout
self _ _) = PaddedBox m n
forall a. Zero a => a
zero {
    min :: Size m n
B.min = Font' -> ParagraphLayout -> Size m n
forall x y.
(CastDouble x, CastDouble y) =>
Font' -> ParagraphLayout -> Size x y
layoutSize Font'
f ParagraphLayout
self, size :: Size m n
B.size = Font' -> ParagraphLayout -> Size m n
forall x y.
(CastDouble x, CastDouble y) =>
Font' -> ParagraphLayout -> Size x y
layoutSize Font'
f ParagraphLayout
self, max :: Size m n
B.max = Font' -> ParagraphLayout -> Size m n
forall x y.
(CastDouble x, CastDouble y) =>
Font' -> ParagraphLayout -> Size x y
layoutSize Font'
f ParagraphLayout
self
}
layoutGetBox (LayoutSpan _ f :: Font'
f self :: Fragment
self) = PaddedBox m n
forall a. Zero a => a
zero {
    min :: Size m n
B.min = Font' -> Fragment -> Size m n
forall x y.
(CastDouble x, CastDouble y) =>
Font' -> Fragment -> Size x y
fragmentSize Font'
f Fragment
self, size :: Size m n
B.size = Font' -> Fragment -> Size m n
forall x y.
(CastDouble x, CastDouble y) =>
Font' -> Fragment -> Size x y
fragmentSize Font'
f Fragment
self, max :: Size m n
B.max = Font' -> Fragment -> Size m n
forall x y.
(CastDouble x, CastDouble y) =>
Font' -> Fragment -> Size x y
fragmentSize Font'
f Fragment
self
}
-- | Retrieve the subtree under a node.
layoutGetChilds :: LayoutItem m n x -> [LayoutItem m n x]
layoutGetChilds (LayoutFlow _ _ ret :: [LayoutItem m n x]
ret) = [LayoutItem m n x]
ret
layoutGetChilds (LayoutGrid _ _ _ ret :: [LayoutItem m n x]
ret) = [LayoutItem m n x]
ret
layoutGetChilds (LayoutSpan _ _ _) = []
layoutGetChilds (LayoutInline _ font :: Font'
font self :: Paragraph
self _ vals :: [x]
vals) = ((x, Fragment) -> LayoutItem m n x)
-> [(x, Fragment)] -> [LayoutItem m n x]
forall a b. (a -> b) -> [a] -> [b]
map (x, Fragment) -> LayoutItem m n x
forall x m n. (x, Fragment) -> LayoutItem m n x
inner ([(x, Fragment)] -> [LayoutItem m n x])
-> [(x, Fragment)] -> [LayoutItem m n x]
forall a b. (a -> b) -> a -> b
$ [x] -> Paragraph -> [(x, Fragment)]
forall x. [x] -> Paragraph -> [(x, Fragment)]
inlineChildren [x]
vals Paragraph
self
  where inner :: (x, Fragment) -> LayoutItem m n x
inner (val :: x
val, fragment :: Fragment
fragment) = x -> Font' -> Fragment -> LayoutItem m n x
forall m n x. x -> Font' -> Fragment -> LayoutItem m n x
LayoutSpan x
val Font'
font Fragment
fragment
layoutGetChilds (LayoutInline' _ font :: Font'
font self :: ParagraphLayout
self _ vals :: [x]
vals) = ((x, Fragment) -> LayoutItem m n x)
-> [(x, Fragment)] -> [LayoutItem m n x]
forall a b. (a -> b) -> [a] -> [b]
map (x, Fragment) -> LayoutItem m n x
forall x m n. (x, Fragment) -> LayoutItem m n x
inner ([(x, Fragment)] -> [LayoutItem m n x])
-> [(x, Fragment)] -> [LayoutItem m n x]
forall a b. (a -> b) -> a -> b
$ [x] -> ParagraphLayout -> [(x, Fragment)]
forall x. [x] -> ParagraphLayout -> [(x, Fragment)]
layoutChildren [x]
vals ParagraphLayout
self
  where inner :: (x, Fragment) -> LayoutItem m n x
inner (val :: x
val, fragment :: Fragment
fragment) = x -> Font' -> Fragment -> LayoutItem m n x
forall m n x. x -> Font' -> Fragment -> LayoutItem m n x
LayoutSpan x
val Font'
font Fragment
fragment
-- | Retrieve the caller-specified data attached to a layout node.
layoutGetInner :: LayoutItem m n p -> p
layoutGetInner (LayoutFlow ret :: p
ret _ _) = p
ret
layoutGetInner (LayoutGrid ret :: p
ret _ _ _) = p
ret
layoutGetInner (LayoutInline ret :: p
ret _ _ _ _) = p
ret
layoutGetInner (LayoutInline' ret :: p
ret _ _ _ _) = p
ret
layoutGetInner (LayoutSpan ret :: p
ret _ _) = p
ret

-- | map-ready wrapper around `setCellBox` sourcing from a child node.
setCellBox' :: (LayoutItem m n x, GridItem) -> GridItem
setCellBox' (child :: LayoutItem m n x
child, cell :: GridItem
cell) = GridItem -> PaddedBox m n -> GridItem
forall m n.
(CastDouble m, CastDouble n) =>
GridItem -> PaddedBox m n -> GridItem
setCellBox GridItem
cell (PaddedBox m n -> GridItem) -> PaddedBox m n -> GridItem
forall a b. (a -> b) -> a -> b
$ LayoutItem m n x -> PaddedBox m n
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) =>
        Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMinWidth :: Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMinWidth parent :: Maybe Double
parent (LayoutFlow val :: x
val self :: PaddedBox y Length
self childs :: [LayoutItem y Length x]
childs) = x
-> PaddedBox y Length
-> [LayoutItem y Length x]
-> LayoutItem y Length x
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 = (Length -> Length) -> Size y Length -> Size y Length
forall n nn m. (n -> nn) -> Size m n -> Size m nn
mapSizeX (Double -> Length -> Length
B.mapAuto Double
min') (PaddedBox y Length -> Size y Length
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox y Length
self) }
    min' :: Double
min' = Double -> PaddedBox y Length -> [PaddedBox y Double] -> Double
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'' = (PaddedBox y Length -> PaddedBox y Double)
-> [PaddedBox y Length] -> [PaddedBox y Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Length -> Double) -> PaddedBox y Length -> PaddedBox y Double
forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' ((Length -> Double) -> PaddedBox y Length -> PaddedBox y Double)
-> (Length -> Double) -> PaddedBox y Length -> PaddedBox y Double
forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength Double
selfWidth) ([PaddedBox y Length] -> [PaddedBox y Double])
-> [PaddedBox y Length] -> [PaddedBox y Double]
forall a b. (a -> b) -> a -> b
$ (LayoutItem y Length x -> PaddedBox y Length)
-> [LayoutItem y Length x] -> [PaddedBox y Length]
forall a b. (a -> b) -> [a] -> [b]
map LayoutItem y Length x -> PaddedBox y Length
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' = (LayoutItem y Length x -> LayoutItem y Length x)
-> [LayoutItem y Length x] -> [LayoutItem y Length x]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
forall y x.
(Zero y, CastDouble y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMinWidth (Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x)
-> Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
selfWidth) [LayoutItem y Length x]
childs
    selfWidth :: Double
selfWidth = PaddedBox y Double -> Double
forall n m. Num n => PaddedBox m n -> n
width (PaddedBox y Double -> Double) -> PaddedBox y Double -> Double
forall a b. (a -> b) -> a -> b
$ (Length -> Double) -> PaddedBox y Length -> PaddedBox y Double
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' = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe 0 Maybe Double
parent
boxMinWidth parent :: Maybe Double
parent (LayoutGrid val :: x
val self :: Grid y Length
self cells0 :: [GridItem]
cells0 childs :: [LayoutItem y Length x]
childs) = x
-> Grid y Length
-> [GridItem]
-> [LayoutItem y Length x]
-> LayoutItem y Length x
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' = Track Length -> Track y -> Grid y Length
forall m n. n -> m -> Size m n
Size (Grid y Length -> Track Length
forall m n. Size m n -> n
inline Grid y Length
self) { trackMins :: [Double]
trackMins = [Double]
cells } (Grid y Length -> Track y
forall m n. Size m n -> m
block Grid y Length
self)
    cells :: [Double]
cells = Double -> Track Length -> [GridItem'] -> [Double]
sizeTrackMins Double
parent' (Grid y Length -> Track Length
forall m n. Size m n -> n
inline Grid y Length
self) ([GridItem'] -> [Double]) -> [GridItem'] -> [Double]
forall a b. (a -> b) -> a -> b
$ (GridItem -> GridItem') -> [GridItem] -> [GridItem']
forall a b. (a -> b) -> [a] -> [b]
map GridItem -> GridItem'
forall m n. Size m n -> n
inline [GridItem]
cells'
    cells' :: [GridItem]
cells' = ((LayoutItem y Length x, GridItem) -> GridItem)
-> [(LayoutItem y Length x, GridItem)] -> [GridItem]
forall a b. (a -> b) -> [a] -> [b]
map (LayoutItem y Length x, GridItem) -> GridItem
forall m n x.
(CastDouble m, CastDouble n, Zero m, Zero n) =>
(LayoutItem m n x, GridItem) -> GridItem
setCellBox' ([(LayoutItem y Length x, GridItem)] -> [GridItem])
-> [(LayoutItem y Length x, GridItem)] -> [GridItem]
forall a b. (a -> b) -> a -> b
$ [LayoutItem y Length x]
-> [GridItem] -> [(LayoutItem y Length x, GridItem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LayoutItem y Length x]
childs' [GridItem]
cells0 -- Flatten subgrids
    childs'' :: [PaddedBox y Double]
childs'' = (PaddedBox y Length -> PaddedBox y Double)
-> [PaddedBox y Length] -> [PaddedBox y Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Length -> Double) -> PaddedBox y Length -> PaddedBox y Double
forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' ((Length -> Double) -> PaddedBox y Length -> PaddedBox y Double)
-> (Length -> Double) -> PaddedBox y Length -> PaddedBox y Double
forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength Double
selfWidth) ([PaddedBox y Length] -> [PaddedBox y Double])
-> [PaddedBox y Length] -> [PaddedBox y Double]
forall a b. (a -> b) -> a -> b
$ (LayoutItem y Length x -> PaddedBox y Length)
-> [LayoutItem y Length x] -> [PaddedBox y Length]
forall a b. (a -> b) -> [a] -> [b]
map LayoutItem y Length x -> PaddedBox y Length
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' = (LayoutItem y Length x -> LayoutItem y Length x)
-> [LayoutItem y Length x] -> [LayoutItem y Length x]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
forall y x.
(Zero y, CastDouble y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMinWidth (Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x)
-> Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
selfWidth) [LayoutItem y Length x]
childs
    selfWidth :: Double
selfWidth = (Length -> Double) -> Track Length -> Double
forall n. (n -> Double) -> Track n -> Double
trackNat (Double -> Length -> Double
lowerLength Double
parent') (Track Length -> Double) -> Track Length -> Double
forall a b. (a -> b) -> a -> b
$ Grid y Length -> Track Length
forall m n. Size m n -> n
inline Grid y Length
self
    parent' :: Double
parent' = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (Grid y Length -> [GridItem] -> Double
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 = PaddedBox Double Double
forall a. Zero a => a
zero
boxMinWidth _ self :: LayoutItem y Length x
self@(LayoutInline _ _ _ _ _) = LayoutItem y Length x
self
boxMinWidth _ self :: LayoutItem y Length x
self@(LayoutInline' _ _ _ _ _) = LayoutItem y Length x
self
boxMinWidth _ self :: LayoutItem y Length x
self@(LayoutSpan _ _ _) = LayoutItem y Length x
self
-- | Update a (sub)tree to compute & cache ideal width.
boxNatWidth :: (Zero y, CastDouble y) =>
        Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxNatWidth :: Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxNatWidth parent :: Maybe Double
parent (LayoutFlow val :: x
val self :: PaddedBox y Length
self childs :: [LayoutItem y Length x]
childs) = x
-> PaddedBox y Length
-> [LayoutItem y Length x]
-> LayoutItem y Length x
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 = Double -> Double -> Size Double Double
forall m n. n -> m -> Size m n
Size Double
size' (Double -> Size Double Double) -> Double -> Size Double Double
forall a b. (a -> b) -> a -> b
$ Size Double Double -> Double
forall m n. Size m n -> m
block (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox y Length -> Size Double Double
forall m n. PaddedBox m n -> Size Double Double
B.nat PaddedBox y Length
self }
    size' :: Double
size' = Double -> PaddedBox y Length -> [PaddedBox y Double] -> Double
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'' = (PaddedBox y Length -> PaddedBox y Double)
-> [PaddedBox y Length] -> [PaddedBox y Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Length -> Double) -> PaddedBox y Length -> PaddedBox y Double
forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' ((Length -> Double) -> PaddedBox y Length -> PaddedBox y Double)
-> (Length -> Double) -> PaddedBox y Length -> PaddedBox y Double
forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength Double
selfWidth) ([PaddedBox y Length] -> [PaddedBox y Double])
-> [PaddedBox y Length] -> [PaddedBox y Double]
forall a b. (a -> b) -> a -> b
$ (LayoutItem y Length x -> PaddedBox y Length)
-> [LayoutItem y Length x] -> [PaddedBox y Length]
forall a b. (a -> b) -> [a] -> [b]
map LayoutItem y Length x -> PaddedBox y Length
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' = (LayoutItem y Length x -> LayoutItem y Length x)
-> [LayoutItem y Length x] -> [LayoutItem y Length x]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
forall y x.
(Zero y, CastDouble y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxNatWidth (Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x)
-> Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
selfWidth) [LayoutItem y Length x]
childs
    selfWidth :: Double
selfWidth = PaddedBox y Double -> Double
forall n m. Num n => PaddedBox m n -> n
width (PaddedBox y Double -> Double) -> PaddedBox y Double -> Double
forall a b. (a -> b) -> a -> b
$ (Length -> Double) -> PaddedBox y Length -> PaddedBox y Double
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' = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe 0 Maybe Double
parent
boxNatWidth parent :: Maybe Double
parent (LayoutGrid val :: x
val self :: Grid y Length
self cells0 :: [GridItem]
cells0 childs :: [LayoutItem y Length x]
childs) = x
-> Grid y Length
-> [GridItem]
-> [LayoutItem y Length x]
-> LayoutItem y Length x
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' = Track Length -> Track y -> Grid y Length
forall m n. n -> m -> Size m n
Size (Grid y Length -> Track Length
forall m n. Size m n -> n
inline Grid y Length
self) { trackNats :: [Double]
trackNats = [Double]
cells } (Grid y Length -> Track y
forall m n. Size m n -> m
block Grid y Length
self)
    cells :: [Double]
cells = Double -> Track Length -> [GridItem'] -> [Double]
sizeTrackNats Double
parent' (Grid y Length -> Track Length
forall m n. Size m n -> n
inline (Grid y Length -> Track Length) -> Grid y Length -> Track Length
forall a b. (a -> b) -> a -> b
$ Grid y Length
self) ([GridItem'] -> [Double]) -> [GridItem'] -> [Double]
forall a b. (a -> b) -> a -> b
$ (GridItem -> GridItem') -> [GridItem] -> [GridItem']
forall a b. (a -> b) -> [a] -> [b]
map GridItem -> GridItem'
forall m n. Size m n -> n
inline [GridItem]
cells'
    cells' :: [GridItem]
cells' = ((LayoutItem y Length x, GridItem) -> GridItem)
-> [(LayoutItem y Length x, GridItem)] -> [GridItem]
forall a b. (a -> b) -> [a] -> [b]
map (LayoutItem y Length x, GridItem) -> GridItem
forall m n x.
(CastDouble m, CastDouble n, Zero m, Zero n) =>
(LayoutItem m n x, GridItem) -> GridItem
setCellBox' ([(LayoutItem y Length x, GridItem)] -> [GridItem])
-> [(LayoutItem y Length x, GridItem)] -> [GridItem]
forall a b. (a -> b) -> a -> b
$ [LayoutItem y Length x]
-> [GridItem] -> [(LayoutItem y Length x, GridItem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LayoutItem y Length x]
childs' [GridItem]
cells0 -- Flatten subgrids
    childs'' :: [PaddedBox y Double]
childs'' = (PaddedBox y Length -> PaddedBox y Double)
-> [PaddedBox y Length] -> [PaddedBox y Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Length -> Double) -> PaddedBox y Length -> PaddedBox y Double
forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' ((Length -> Double) -> PaddedBox y Length -> PaddedBox y Double)
-> (Length -> Double) -> PaddedBox y Length -> PaddedBox y Double
forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength Double
selfWidth) ([PaddedBox y Length] -> [PaddedBox y Double])
-> [PaddedBox y Length] -> [PaddedBox y Double]
forall a b. (a -> b) -> a -> b
$ (LayoutItem y Length x -> PaddedBox y Length)
-> [LayoutItem y Length x] -> [PaddedBox y Length]
forall a b. (a -> b) -> [a] -> [b]
map LayoutItem y Length x -> PaddedBox y Length
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' = (LayoutItem y Length x -> LayoutItem y Length x)
-> [LayoutItem y Length x] -> [LayoutItem y Length x]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
forall y x.
(Zero y, CastDouble y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxNatWidth (Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x)
-> Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
selfWidth) [LayoutItem y Length x]
childs
    selfWidth :: Double
selfWidth = (Length -> Double) -> Track Length -> Double
forall n. (n -> Double) -> Track n -> Double
trackNat (Double -> Length -> Double
lowerLength Double
parent') (Track Length -> Double) -> Track Length -> Double
forall a b. (a -> b) -> a -> b
$ Grid y Length -> Track Length
forall m n. Size m n -> n
inline Grid y Length
self
    parent' :: Double
parent' = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (Grid y Length -> [GridItem] -> Double
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 = PaddedBox Double Double
forall a. Zero a => a
zero
boxNatWidth _ self :: LayoutItem y Length x
self@(LayoutInline _ _ _ _ _) = LayoutItem y Length x
self
boxNatWidth _ self :: LayoutItem y Length x
self@(LayoutInline' _ _ _ _ _) = LayoutItem y Length x
self
boxNatWidth _ self :: LayoutItem y Length x
self@(LayoutSpan _ _ _) = LayoutItem y Length x
self
-- | Update a (sub)tree to compute & cache maximum legible width.
boxMaxWidth :: CastDouble y => PaddedBox a Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMaxWidth :: PaddedBox a Double
-> LayoutItem y Length x -> LayoutItem y Length x
boxMaxWidth parent :: PaddedBox a Double
parent (LayoutFlow val :: x
val self :: PaddedBox y Length
self childs :: [LayoutItem y Length x]
childs) = x
-> PaddedBox y Length
-> [LayoutItem y Length x]
-> LayoutItem y Length x
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' = (LayoutItem y Length x -> LayoutItem y Length x)
-> [LayoutItem y Length x] -> [LayoutItem y Length x]
forall a b. (a -> b) -> [a] -> [b]
map (PaddedBox y Double
-> LayoutItem y Length x -> LayoutItem y Length x
forall y a x.
CastDouble 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'' = (Length -> Double) -> PaddedBox y Length -> PaddedBox y Double
forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' (Double -> Length -> Double
lowerLength (Double -> Length -> Double) -> Double -> Length -> Double
forall a b. (a -> b) -> a -> b
$ Size a Double -> Double
forall m n. Size m n -> n
inline (Size a Double -> Double) -> Size a Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox a Double -> Size a Double
forall m n. PaddedBox m n -> Size m n
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 = Length -> y -> Size y Length
forall m n. n -> m -> Size m n
Size (Double -> Length
Pixels Double
max') (Size y Length -> y
forall m n. Size m n -> m
block (Size y Length -> y) -> Size y Length -> y
forall a b. (a -> b) -> a -> b
$ PaddedBox y Length -> Size y Length
forall m n. PaddedBox m n -> Size m n
B.max PaddedBox y Length
self) }
    max' :: Double
max' = PaddedBox a Double -> PaddedBox y Length -> Double
forall a b. PaddedBox a Double -> PaddedBox b Length -> Double
flowMaxWidth PaddedBox a Double
parent PaddedBox y Length
self
boxMaxWidth parent :: PaddedBox a Double
parent (LayoutGrid val :: x
val self :: Grid y Length
self cells :: [GridItem]
cells childs :: [LayoutItem y Length x]
childs) = x
-> Grid y Length
-> [GridItem]
-> [LayoutItem y Length x]
-> LayoutItem y Length x
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' = ((GridItem, LayoutItem y Length x) -> LayoutItem y Length x)
-> [(GridItem, LayoutItem y Length x)] -> [LayoutItem y Length x]
forall a b. (a -> b) -> [a] -> [b]
map (GridItem, LayoutItem y Length x) -> LayoutItem y Length x
forall y x.
CastDouble y =>
(GridItem, LayoutItem y Length x) -> LayoutItem y Length x
inner ([(GridItem, LayoutItem y Length x)] -> [LayoutItem y Length x])
-> [(GridItem, LayoutItem y Length x)] -> [LayoutItem y Length x]
forall a b. (a -> b) -> a -> b
$ [GridItem]
-> [LayoutItem y Length x] -> [(GridItem, LayoutItem y Length x)]
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 cellx :: GridItem'
cellx celly :: GridItem'
celly, child :: LayoutItem y Length x
child) =
        PaddedBox Double Double
-> LayoutItem y Length x -> LayoutItem y Length x
forall y a x.
CastDouble y =>
PaddedBox a Double
-> LayoutItem y Length x -> LayoutItem y Length x
boxMaxWidth (Track Length -> GridItem' -> Double
forall x. CastDouble x => Track x -> GridItem' -> Double
cellSize (Grid y Length -> Track Length
forall m n. Size m n -> n
inline Grid y Length
self) GridItem'
cellx Double -> Double -> PaddedBox Double Double
`size2box` Track y -> GridItem' -> Double
forall x. CastDouble x => Track x -> GridItem' -> Double
cellSize (Grid y Length -> Track y
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 x :: Double
x y :: Double
y = PaddedBox Double Double
zeroBox { min :: Size Double Double
B.min = Double -> Double -> Size Double Double
forall m n. n -> m -> Size m n
Size Double
x Double
y, max :: Size Double Double
B.max = Double -> Double -> Size Double Double
forall m n. n -> m -> Size m n
Size Double
x Double
y, size :: Size Double Double
B.size = Double -> Double -> Size Double Double
forall m n. n -> m -> Size m n
Size Double
x Double
y }
boxMaxWidth parent :: PaddedBox a Double
parent self :: LayoutItem y Length x
self@(LayoutInline _ _ _ _ _) = LayoutItem y Length x
self
boxMaxWidth parent :: PaddedBox a Double
parent self :: LayoutItem y Length x
self@(LayoutInline' _ _ _ _ _) = LayoutItem y Length x
self
boxMaxWidth parent :: PaddedBox a Double
parent self :: LayoutItem y Length x
self@(LayoutSpan _ f :: Font'
f self' :: Fragment
self') = LayoutItem y Length x
self
-- | Update a (sub)tree to compute & cache final width.
boxWidth :: (Zero y, CastDouble y) => PaddedBox b Double -> LayoutItem y Length x ->
        LayoutItem y Double x
boxWidth :: PaddedBox b Double
-> LayoutItem y Length x -> LayoutItem y Double x
boxWidth parent :: PaddedBox b Double
parent (LayoutFlow val :: x
val self :: PaddedBox y Length
self childs :: [LayoutItem y Length x]
childs) = x
-> PaddedBox y Double
-> [LayoutItem y Double x]
-> LayoutItem y Double x
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' = (LayoutItem y Length x -> LayoutItem y Double x)
-> [LayoutItem y Length x] -> [LayoutItem y Double x]
forall a b. (a -> b) -> [a] -> [b]
map (PaddedBox y Double
-> LayoutItem y Length x -> LayoutItem y Double x
forall y b x.
(Zero y, CastDouble 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' = ((Length -> Double) -> PaddedBox y Length -> PaddedBox y Double
forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' (Double -> Length -> Double
lowerLength (Double -> Length -> Double) -> Double -> Length -> Double
forall a b. (a -> b) -> a -> b
$ Size b Double -> Double
forall m n. Size m n -> n
inline (Size b Double -> Double) -> Size b Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox b Double -> Size b Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox b Double
parent) PaddedBox y Length
self) {
        size :: Size y Double
size = Double -> y -> Size y Double
forall m n. n -> m -> Size m n
Size Double
size' (y -> Size y Double) -> y -> Size y Double
forall a b. (a -> b) -> a -> b
$ Size y Length -> y
forall m n. Size m n -> m
block (Size y Length -> y) -> Size y Length -> y
forall a b. (a -> b) -> a -> b
$ PaddedBox y Length -> Size y Length
forall m n. PaddedBox m n -> Size m n
B.max PaddedBox y Length
self
      }
    size' :: Double
size' = PaddedBox b Double -> PaddedBox y Length -> Double
forall a b. PaddedBox a Double -> PaddedBox b Length -> Double
flowWidth PaddedBox b Double
parent PaddedBox y Length
self
boxWidth parent :: PaddedBox b Double
parent (LayoutGrid val :: x
val self :: Grid y Length
self cells :: [GridItem]
cells childs :: [LayoutItem y Length x]
childs) = x
-> Grid y Double
-> [GridItem]
-> [LayoutItem y Double x]
-> LayoutItem y Double x
forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid x
val Grid y Double
self' [GridItem]
cells' [LayoutItem y Double x]
childs'
  where -- Propagate parent track as default
    (cells' :: [GridItem]
cells', childs' :: [LayoutItem y Double x]
childs') = [(GridItem, LayoutItem y Double x)]
-> ([GridItem], [LayoutItem y Double x])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(GridItem, LayoutItem y Double x)]
 -> ([GridItem], [LayoutItem y Double x]))
-> [(GridItem, LayoutItem y Double x)]
-> ([GridItem], [LayoutItem y Double x])
forall a b. (a -> b) -> a -> b
$ ((GridItem, LayoutItem y Length x)
 -> (GridItem, LayoutItem y Double x))
-> [(GridItem, LayoutItem y Length x)]
-> [(GridItem, LayoutItem y Double x)]
forall a b. (a -> b) -> [a] -> [b]
map (GridItem, LayoutItem y Length x)
-> (GridItem, LayoutItem y Double x)
forall y x.
(CastDouble y, Zero y) =>
(GridItem, LayoutItem y Length x)
-> (GridItem, LayoutItem y Double x)
recurse ([(GridItem, LayoutItem y Length x)]
 -> [(GridItem, LayoutItem y Double x)])
-> [(GridItem, LayoutItem y Length x)]
-> [(GridItem, LayoutItem y Double x)]
forall a b. (a -> b) -> a -> b
$ [GridItem]
-> [LayoutItem y Length x] -> [(GridItem, LayoutItem y Length x)]
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 (cell :: GridItem
cell, child :: LayoutItem y Length x
child) = (GridItem
cell', LayoutItem y Double x
child')
      where
        cell' :: GridItem
cell' = GridItem -> PaddedBox y Double -> GridItem
forall m n.
(CastDouble m, CastDouble n) =>
GridItem -> PaddedBox m n -> GridItem
setCellBox GridItem
cell (PaddedBox y Double -> GridItem) -> PaddedBox y Double -> GridItem
forall a b. (a -> b) -> a -> b
$ LayoutItem y Double x -> PaddedBox y Double
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' = PaddedBox Double Double
-> LayoutItem y Length x -> LayoutItem y Double x
forall y b x.
(Zero y, CastDouble y) =>
PaddedBox b Double
-> LayoutItem y Length x -> LayoutItem y Double x
boxWidth (Grid y Length -> GridItem -> PaddedBox Double Double
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' :: Grid y Double
self' = (Track Double -> Track y -> Grid y Double)
-> Track y -> Track Double -> Grid y Double
forall a b c. (a -> b -> c) -> b -> a -> c
flip Track Double -> Track y -> Grid y Double
forall m n. n -> m -> Size m n
Size (Grid y Length -> Track y
forall m n. Size m n -> m
block Grid y Length
self) Track :: forall x. [Either x Double] -> [Double] -> [Double] -> x -> Track x
Track {
        cells :: [Either Double Double]
cells = (Double -> Either Double Double)
-> [Double] -> [Either Double Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Either Double Double
forall a b. a -> Either a b
Left [Double]
widths,
        trackMins :: [Double]
trackMins = Track Length -> [Double]
forall x. Track x -> [Double]
trackMins (Track Length -> [Double]) -> Track Length -> [Double]
forall a b. (a -> b) -> a -> b
$ Grid y Length -> Track Length
forall m n. Size m n -> n
inline Grid y Length
self, trackNats :: [Double]
trackNats = Track Length -> [Double]
forall x. Track x -> [Double]
trackNats (Track Length -> [Double]) -> Track Length -> [Double]
forall a b. (a -> b) -> a -> b
$ Grid y Length -> Track Length
forall m n. Size m n -> n
inline Grid y Length
self,
        gap :: Double
gap = Double -> Length -> Double
lowerLength Double
outerwidth (Length -> Double) -> Length -> Double
forall a b. (a -> b) -> a -> b
$ Track Length -> Length
forall x. Track x -> x
gap (Track Length -> Length) -> Track Length -> Length
forall a b. (a -> b) -> a -> b
$ Grid y Length -> Track Length
forall m n. Size m n -> n
inline Grid y Length
self
    }
    outerwidth :: Double
outerwidth = Size b Double -> Double
forall m n. Size m n -> n
inline (Size b Double -> Double) -> Size b Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox b Double -> Size b Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox b Double
parent
    widths :: [Double]
widths = Double -> Track Length -> [Double]
sizeTrackMaxs (Size b Double -> Double
forall m n. Size m n -> n
inline (Size b Double -> Double) -> Size b Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox b Double -> Size b Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox b Double
parent) (Track Length -> [Double]) -> Track Length -> [Double]
forall a b. (a -> b) -> a -> b
$ Grid y Length -> Track Length
forall m n. Size m n -> n
inline Grid y Length
self
boxWidth parent :: PaddedBox b Double
parent (LayoutInline val :: x
val font :: Font'
font (Paragraph a :: Array
a b :: Int
b c :: [Span]
c d :: ParagraphOptions
d) paging :: PageOptions
paging vals :: [x]
vals) =
    x
-> Font'
-> Paragraph
-> PageOptions
-> [x]
-> LayoutItem y Double x
forall m n x.
x -> Font' -> Paragraph -> PageOptions -> [x] -> LayoutItem m n x
LayoutInline x
val Font'
font (Array -> Int -> [Span] -> ParagraphOptions -> Paragraph
Paragraph Array
a Int
b [Span]
c ParagraphOptions
d { paragraphMaxWidth :: Int32
paragraphMaxWidth = Double -> Int32
forall a b. (RealFrac a, Integral b) => a -> b
round Double
width }) PageOptions
paging [x]
vals
  where width :: Double
width = Size b Double -> Double
forall m n. Size m n -> n
B.inline (Size b Double -> Double) -> Size b Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox b Double -> Size b Double
forall m n. PaddedBox m n -> Size m n
B.size PaddedBox b Double
parent
boxWidth _ (LayoutInline' a :: x
a b :: Font'
b c :: ParagraphLayout
c d :: PageOptions
d e :: [x]
e) = x
-> Font'
-> ParagraphLayout
-> PageOptions
-> [x]
-> LayoutItem y Double x
forall m n x.
x
-> Font'
-> ParagraphLayout
-> PageOptions
-> [x]
-> LayoutItem m n x
LayoutInline' x
a Font'
b ParagraphLayout
c PageOptions
d [x]
e
boxWidth parent :: PaddedBox b Double
parent (LayoutSpan val :: x
val font :: Font'
font self' :: Fragment
self') = x -> Font' -> Fragment -> LayoutItem y Double x
forall m n x. x -> Font' -> Fragment -> LayoutItem m n x
LayoutSpan x
val Font'
font Fragment
self'

-- | Update a (sub)tree to compute & cache ideal legible height.
boxNatHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxNatHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxNatHeight parent :: Double
parent (LayoutFlow val :: x
val self :: PaddedBox Length Double
self childs :: [LayoutItem Length Double x]
childs) = x
-> PaddedBox Length Double
-> [LayoutItem Length Double x]
-> LayoutItem Length Double x
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 = (Length -> Length) -> Size Length Double -> Size Length Double
forall m mm n. (m -> mm) -> Size m n -> Size mm n
mapSizeY (Double -> Length -> Length
mapAuto Double
size') (PaddedBox Length Double -> Size Length Double
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'' = (PaddedBox Length Double -> PaddedBox Double Double)
-> [PaddedBox Length Double] -> [PaddedBox Double Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Length -> Double)
-> PaddedBox Length Double -> PaddedBox Double Double
forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' (Double -> Length -> Double
lowerLength Double
parent)) ([PaddedBox Length Double] -> [PaddedBox Double Double])
-> [PaddedBox Length Double] -> [PaddedBox Double Double]
forall a b. (a -> b) -> a -> b
$ (LayoutItem Length Double x -> PaddedBox Length Double)
-> [LayoutItem Length Double x] -> [PaddedBox Length Double]
forall a b. (a -> b) -> [a] -> [b]
map LayoutItem Length Double x -> PaddedBox Length Double
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' = (LayoutItem Length Double x -> LayoutItem Length Double x)
-> [LayoutItem Length Double x] -> [LayoutItem Length Double x]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> LayoutItem Length Double x -> LayoutItem Length Double x
forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxNatHeight (Double
 -> LayoutItem Length Double x -> LayoutItem Length Double x)
-> Double
-> LayoutItem Length Double x
-> LayoutItem Length Double x
forall a b. (a -> b) -> a -> b
$ Size Length Double -> Double
forall m n. Size m n -> n
inline (Size Length Double -> Double) -> Size Length Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
self) [LayoutItem Length Double x]
childs
boxNatHeight parent :: Double
parent (LayoutGrid val :: x
val self :: Grid Length Double
self cells :: [GridItem]
cells childs :: [LayoutItem Length Double x]
childs) = x
-> Grid Length Double
-> [GridItem]
-> [LayoutItem Length Double x]
-> LayoutItem Length Double x
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' = Track Double -> Track Length -> Grid Length Double
forall m n. n -> m -> Size m n
Size (Grid Length Double -> Track Double
forall m n. Size m n -> n
inline Grid Length Double
self) (Grid Length Double -> Track Length
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 (Grid Length Double -> Track Length
forall m n. Size m n -> m
block Grid Length Double
self) ([GridItem'] -> [Double]) -> [GridItem'] -> [Double]
forall a b. (a -> b) -> a -> b
$ (GridItem -> GridItem') -> [GridItem] -> [GridItem']
forall a b. (a -> b) -> [a] -> [b]
map GridItem -> GridItem'
forall m n. Size m n -> m
block [GridItem]
cells'
    cells' :: [GridItem]
cells' = ((LayoutItem Length Double x, GridItem) -> GridItem)
-> [(LayoutItem Length Double x, GridItem)] -> [GridItem]
forall a b. (a -> b) -> [a] -> [b]
map (LayoutItem Length Double x, GridItem) -> GridItem
forall m n x.
(CastDouble m, CastDouble n, Zero m, Zero n) =>
(LayoutItem m n x, GridItem) -> GridItem
setCellBox' ([(LayoutItem Length Double x, GridItem)] -> [GridItem])
-> [(LayoutItem Length Double x, GridItem)] -> [GridItem]
forall a b. (a -> b) -> a -> b
$ [LayoutItem Length Double x]
-> [GridItem] -> [(LayoutItem Length Double x, GridItem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LayoutItem Length Double x]
childs' [GridItem]
cells -- Flatten subgrids
    childs' :: [LayoutItem Length Double x]
childs' = (LayoutItem Length Double x -> LayoutItem Length Double x)
-> [LayoutItem Length Double x] -> [LayoutItem Length Double x]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> LayoutItem Length Double x -> LayoutItem Length Double x
forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxNatHeight Double
width) [LayoutItem Length Double x]
childs
    width :: Double
width = (Double -> Double) -> Track Double -> Double
forall n. (n -> Double) -> Track n -> Double
trackNat Double -> Double
forall a. a -> a
id (Track Double -> Double) -> Track Double -> Double
forall a b. (a -> b) -> a -> b
$ Grid Length Double -> Track Double
forall m n. Size m n -> n
inline Grid Length Double
self
boxNatHeight parent :: Double
parent self :: LayoutItem Length Double x
self@(LayoutInline _ _ _ _ _) = LayoutItem Length Double x
self
boxNatHeight parent :: Double
parent self :: LayoutItem Length Double x
self@(LayoutInline' _ _ _ _ _) = LayoutItem Length Double x
self
boxNatHeight parent :: Double
parent self :: LayoutItem Length Double x
self@(LayoutSpan _ _ _) = 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 :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxMinHeight parent :: Double
parent (LayoutFlow val :: x
val self :: PaddedBox Length Double
self childs :: [LayoutItem Length Double x]
childs) = x
-> PaddedBox Length Double
-> [LayoutItem Length Double x]
-> LayoutItem Length Double x
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' = (LayoutItem Length Double x -> LayoutItem Length Double x)
-> [LayoutItem Length Double x] -> [LayoutItem Length Double x]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> LayoutItem Length Double x -> LayoutItem Length Double x
forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxMinHeight (Double
 -> LayoutItem Length Double x -> LayoutItem Length Double x)
-> Double
-> LayoutItem Length Double x
-> LayoutItem Length Double x
forall a b. (a -> b) -> a -> b
$ Size Length Double -> Double
forall m n. Size m n -> n
inline (Size Length Double -> Double) -> Size Length Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
self) [LayoutItem Length Double x]
childs
    self' :: PaddedBox Length Double
self' = PaddedBox Length Double
self { min :: Size Length Double
B.min = Double -> Length -> Size Length Double
forall m n. n -> m -> Size m n
Size (Size Length Double -> Double
forall m n. Size m n -> n
inline (Size Length Double -> Double) -> Size Length Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox Length Double
self) (Double -> Length
Pixels Double
min') }
    min' :: Double
min' = Double -> PaddedBox Length Double -> Double
flowMinHeight Double
parent PaddedBox Length Double
self
boxMinHeight parent :: Double
parent (LayoutGrid val :: x
val self :: Grid Length Double
self cells :: [GridItem]
cells childs :: [LayoutItem Length Double x]
childs) = x
-> Grid Length Double
-> [GridItem]
-> [LayoutItem Length Double x]
-> LayoutItem Length Double x
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
    (cells' :: [GridItem]
cells', childs' :: [LayoutItem Length Double x]
childs') = [(GridItem, LayoutItem Length Double x)]
-> ([GridItem], [LayoutItem Length Double x])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(GridItem, LayoutItem Length Double x)]
 -> ([GridItem], [LayoutItem Length Double x]))
-> [(GridItem, LayoutItem Length Double x)]
-> ([GridItem], [LayoutItem Length Double x])
forall a b. (a -> b) -> a -> b
$ ((GridItem, LayoutItem Length Double x)
 -> (GridItem, LayoutItem Length Double x))
-> [(GridItem, LayoutItem Length Double x)]
-> [(GridItem, LayoutItem Length Double x)]
forall a b. (a -> b) -> [a] -> [b]
map (GridItem, LayoutItem Length Double x)
-> (GridItem, LayoutItem Length Double x)
forall x.
(GridItem, LayoutItem Length Double x)
-> (GridItem, LayoutItem Length Double x)
recurse ([(GridItem, LayoutItem Length Double x)]
 -> [(GridItem, LayoutItem Length Double x)])
-> [(GridItem, LayoutItem Length Double x)]
-> [(GridItem, LayoutItem Length Double x)]
forall a b. (a -> b) -> a -> b
$ [GridItem]
-> [LayoutItem Length Double x]
-> [(GridItem, LayoutItem Length Double x)]
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 (cell :: GridItem
cell, child :: LayoutItem Length Double x
child) = (GridItem
cell', LayoutItem Length Double x
child') -- Propagate track into subgrids.
      where
        cell' :: GridItem
cell' = GridItem -> PaddedBox Length Double -> GridItem
forall m n.
(CastDouble m, CastDouble n) =>
GridItem -> PaddedBox m n -> GridItem
setCellBox GridItem
cell (LayoutItem Length Double x -> PaddedBox Length Double
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' = Double -> LayoutItem Length Double x -> LayoutItem Length Double x
forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxMinHeight Double
width LayoutItem Length Double x
child
    self' :: Grid Length Double
self' = Track Double -> Track Length -> Grid Length Double
forall m n. n -> m -> Size m n
Size (Grid Length Double -> Track Double
forall m n. Size m n -> n
inline Grid Length Double
self) (Grid Length Double -> Track Length
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 (Grid Length Double -> Track Length
forall m n. Size m n -> m
block Grid Length Double
self) ([GridItem'] -> [Double]) -> [GridItem'] -> [Double]
forall a b. (a -> b) -> a -> b
$ (GridItem -> GridItem') -> [GridItem] -> [GridItem']
forall a b. (a -> b) -> [a] -> [b]
map GridItem -> GridItem'
forall m n. Size m n -> m
block [GridItem]
cells
    width :: Double
width = (Double -> Double) -> Track Double -> Double
forall n. (n -> Double) -> Track n -> Double
trackNat Double -> Double
forall a. a -> a
id (Track Double -> Double) -> Track Double -> Double
forall a b. (a -> b) -> a -> b
$ Grid Length Double -> Track Double
forall m n. Size m n -> n
inline Grid Length Double
self
boxMinHeight parent :: Double
parent self :: LayoutItem Length Double x
self@(LayoutInline _ _ _ _ _) = LayoutItem Length Double x
self
boxMinHeight _ self :: LayoutItem Length Double x
self@(LayoutInline' _ _ _ _ _) = LayoutItem Length Double x
self
boxMinHeight parent :: Double
parent self :: LayoutItem Length Double x
self@(LayoutSpan _ font :: Font'
font self' :: Fragment
self') = 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 :: PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Length Double x
boxMaxHeight parent :: PaddedBox Double Double
parent (LayoutFlow val :: x
val self :: PaddedBox Length Double
self childs :: [LayoutItem Length Double x]
childs) = x
-> PaddedBox Length Double
-> [LayoutItem Length Double x]
-> LayoutItem Length Double x
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' = (LayoutItem Length Double x -> LayoutItem Length Double x)
-> [LayoutItem Length Double x] -> [LayoutItem Length Double x]
forall a b. (a -> b) -> [a] -> [b]
map (PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Length Double x
forall x.
PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Length Double x
boxMaxHeight (PaddedBox Double Double
 -> LayoutItem Length Double x -> LayoutItem Length Double x)
-> PaddedBox Double Double
-> LayoutItem Length Double x
-> LayoutItem Length Double x
forall a b. (a -> b) -> a -> b
$ (Length -> Double)
-> PaddedBox Length Double -> PaddedBox Double Double
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 = Double -> Length -> Size Length Double
forall m n. n -> m -> Size m n
Size (Size Length Double -> Double
forall m n. Size m n -> n
inline (Size Length Double -> Double) -> Size Length Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
B.max PaddedBox Length Double
self) (Double -> Length
Pixels Double
max') }
    max' :: Double
max' = Double -> PaddedBox Length Double -> Double
flowMaxHeight (Size Double Double -> Double
forall m n. Size m n -> n
inline (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) PaddedBox Length Double
self
    width :: Double
width = Size Length Double -> Double
forall m n. Size m n -> n
inline (Size Length Double -> Double) -> Size Length Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
self
boxMaxHeight parent :: PaddedBox Double Double
parent (LayoutGrid val :: x
val self :: Grid Length Double
self cells :: [GridItem]
cells childs :: [LayoutItem Length Double x]
childs) = x
-> Grid Length Double
-> [GridItem]
-> [LayoutItem Length Double x]
-> LayoutItem Length Double x
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
    (cells' :: [GridItem]
cells', childs' :: [LayoutItem Length Double x]
childs') = [(GridItem, LayoutItem Length Double x)]
-> ([GridItem], [LayoutItem Length Double x])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(GridItem, LayoutItem Length Double x)]
 -> ([GridItem], [LayoutItem Length Double x]))
-> [(GridItem, LayoutItem Length Double x)]
-> ([GridItem], [LayoutItem Length Double x])
forall a b. (a -> b) -> a -> b
$ ((GridItem, LayoutItem Length Double x)
 -> (GridItem, LayoutItem Length Double x))
-> [(GridItem, LayoutItem Length Double x)]
-> [(GridItem, LayoutItem Length Double x)]
forall a b. (a -> b) -> [a] -> [b]
map (GridItem, LayoutItem Length Double x)
-> (GridItem, LayoutItem Length Double x)
forall x.
(GridItem, LayoutItem Length Double x)
-> (GridItem, LayoutItem Length Double x)
recurse ([(GridItem, LayoutItem Length Double x)]
 -> [(GridItem, LayoutItem Length Double x)])
-> [(GridItem, LayoutItem Length Double x)]
-> [(GridItem, LayoutItem Length Double x)]
forall a b. (a -> b) -> a -> b
$ [GridItem]
-> [LayoutItem Length Double x]
-> [(GridItem, LayoutItem Length Double x)]
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 (cell :: GridItem
cell, child :: LayoutItem Length Double x
child) = (GridItem
cell', LayoutItem Length Double x
child') -- Propagate track into subgrids
      where
        cell' :: GridItem
cell' = GridItem -> PaddedBox Length Double -> GridItem
forall m n.
(CastDouble m, CastDouble n) =>
GridItem -> PaddedBox m n -> GridItem
setCellBox GridItem
cell (LayoutItem Length Double x -> PaddedBox Length Double
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' = PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Length Double x
forall x.
PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Length Double x
boxMaxHeight (Grid Length Double -> GridItem -> PaddedBox Double Double
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 (Size Double Double -> Double
forall m n. Size m n -> n
inline (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) (Grid Length Double -> Track Length
forall m n. Size m n -> m
block Grid Length Double
self)
    width :: Double
width = Size Double Double -> Double
forall m n. Size m n -> n
inline (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent
boxMaxHeight parent :: PaddedBox Double Double
parent (LayoutInline val :: x
val font :: Font'
font self' :: Paragraph
self' paging :: PageOptions
paging vals :: [x]
vals) =
    x
-> Font'
-> Paragraph
-> PageOptions
-> [x]
-> LayoutItem Length Double x
forall m n x.
x -> Font' -> Paragraph -> PageOptions -> [x] -> LayoutItem m n x
LayoutInline x
val Font'
font Paragraph
self' PageOptions
paging [x]
vals
boxMaxHeight parent :: PaddedBox Double Double
parent (LayoutInline' val :: x
val font :: Font'
font self' :: ParagraphLayout
self' paging :: PageOptions
paging vals :: [x]
vals) =
    x
-> Font'
-> ParagraphLayout
-> PageOptions
-> [x]
-> LayoutItem Length Double x
forall m n x.
x
-> Font'
-> ParagraphLayout
-> PageOptions
-> [x]
-> LayoutItem m n x
LayoutInline' x
val Font'
font ParagraphLayout
self' PageOptions
paging [x]
vals
boxMaxHeight parent :: PaddedBox Double Double
parent (LayoutSpan val :: x
val font :: Font'
font self' :: Fragment
self') = x -> Font' -> Fragment -> LayoutItem Length Double x
forall m n x. x -> Font' -> Fragment -> LayoutItem m n x
LayoutSpan x
val Font'
font Fragment
self'
-- | Update a (sub)tree to compute & cache final height.
boxHeight :: PaddedBox Double Double -> LayoutItem Length Double x -> LayoutItem Double Double x
boxHeight :: PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Double Double x
boxHeight parent :: PaddedBox Double Double
parent (LayoutFlow val :: x
val self :: PaddedBox Length Double
self childs :: [LayoutItem Length Double x]
childs) = x
-> PaddedBox Double Double
-> [LayoutItem Double Double x]
-> LayoutItem Double Double x
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' = (LayoutItem Length Double x -> LayoutItem Double Double x)
-> [LayoutItem Length Double x] -> [LayoutItem Double Double x]
forall a b. (a -> b) -> [a] -> [b]
map (PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Double Double x
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' = ((Length -> Double)
-> PaddedBox Length Double -> PaddedBox Double Double
forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' (Double -> Length -> Double
lowerLength (Double -> Length -> Double) -> Double -> Length -> Double
forall a b. (a -> b) -> a -> b
$ Size Double Double -> Double
forall m n. Size m n -> n
inline (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) PaddedBox Length Double
self) {
        size :: Size Double Double
size = Double -> Double -> Size Double Double
forall m n. n -> m -> Size m n
Size (Size Length Double -> Double
forall m n. Size m n -> n
inline (Size Length Double -> Double) -> Size Length Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
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 = Size Length Double -> Double
forall m n. Size m n -> n
inline (Size Length Double -> Double) -> Size Length Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Length Double -> Size Length Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Length Double
self
boxHeight parent :: PaddedBox Double Double
parent (LayoutGrid val :: x
val self :: Grid Length Double
self cells0 :: [GridItem]
cells0 childs :: [LayoutItem Length Double x]
childs) = x
-> Grid Double Double
-> [GridItem]
-> [LayoutItem Double Double x]
-> LayoutItem Double Double x
forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid x
val Grid Double Double
self' [GridItem]
cells' [LayoutItem Double Double x]
childs'
  where
    (cells' :: [GridItem]
cells', childs' :: [LayoutItem Double Double x]
childs') = [(GridItem, LayoutItem Double Double x)]
-> ([GridItem], [LayoutItem Double Double x])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(GridItem, LayoutItem Double Double x)]
 -> ([GridItem], [LayoutItem Double Double x]))
-> [(GridItem, LayoutItem Double Double x)]
-> ([GridItem], [LayoutItem Double Double x])
forall a b. (a -> b) -> a -> b
$ ((GridItem, LayoutItem Length Double x)
 -> (GridItem, LayoutItem Double Double x))
-> [(GridItem, LayoutItem Length Double x)]
-> [(GridItem, LayoutItem Double Double x)]
forall a b. (a -> b) -> [a] -> [b]
map (GridItem, LayoutItem Length Double x)
-> (GridItem, LayoutItem Double Double x)
forall x.
(GridItem, LayoutItem Length Double x)
-> (GridItem, LayoutItem Double Double x)
recurse ([(GridItem, LayoutItem Length Double x)]
 -> [(GridItem, LayoutItem Double Double x)])
-> [(GridItem, LayoutItem Length Double x)]
-> [(GridItem, LayoutItem Double Double x)]
forall a b. (a -> b) -> a -> b
$ [GridItem]
-> [LayoutItem Length Double x]
-> [(GridItem, LayoutItem Length Double x)]
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 (cell :: GridItem
cell, child :: LayoutItem Length Double x
child) = (GridItem
cell', LayoutItem Double Double x
child') -- Propagate track into subgrids.
      where
        cell' :: GridItem
cell' = GridItem -> PaddedBox Double Double -> GridItem
forall m n.
(CastDouble m, CastDouble n) =>
GridItem -> PaddedBox m n -> GridItem
setCellBox GridItem
cell (LayoutItem Double Double x -> PaddedBox Double Double
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' = PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Double Double x
forall x.
PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Double Double x
boxHeight (LayoutItem Double Double x -> PaddedBox Double Double
forall m n x.
(Zero m, Zero n, CastDouble m, CastDouble n) =>
LayoutItem m n x -> PaddedBox m n
layoutGetBox (LayoutItem Double Double x -> PaddedBox Double Double)
-> LayoutItem Double Double x -> PaddedBox Double Double
forall a b. (a -> b) -> a -> b
$ x
-> Grid Double Double
-> [GridItem]
-> [LayoutItem Double Double x]
-> LayoutItem Double Double x
forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid x
val Grid Double Double
self' [] []) LayoutItem Length Double x
child
    self' :: Grid Double Double
self' = Track Double -> Track Double -> Grid Double Double
forall m n. n -> m -> Size m n
Size (Grid Length Double -> Track Double
forall m n. Size m n -> n
inline Grid Length Double
self) Track :: forall x. [Either x Double] -> [Double] -> [Double] -> x -> Track x
Track {
        gap :: Double
gap = Double -> Length -> Double
lowerLength Double
width (Length -> Double) -> Length -> Double
forall a b. (a -> b) -> a -> b
$ Track Length -> Length
forall x. Track x -> x
gap (Track Length -> Length) -> Track Length -> Length
forall a b. (a -> b) -> a -> b
$ Grid Length Double -> Track Length
forall m n. Size m n -> m
block Grid Length Double
self,
        cells :: [Either Double Double]
cells = (Either Length Double -> Either Double Double)
-> [Either Length Double] -> [Either Double Double]
forall a b. (a -> b) -> [a] -> [b]
map Either Length Double -> Either Double Double
forall b. Either Length b -> Either Double b
lowerSize ([Either Length Double] -> [Either Double Double])
-> [Either Length Double] -> [Either Double Double]
forall a b. (a -> b) -> a -> b
$ Track Length -> [Either Length Double]
forall x. Track x -> [Either x Double]
cells (Track Length -> [Either Length Double])
-> Track Length -> [Either Length Double]
forall a b. (a -> b) -> a -> b
$ Grid Length Double -> Track Length
forall m n. Size m n -> m
block Grid Length Double
self,
        trackMins :: [Double]
trackMins = Track Length -> [Double]
forall x. Track x -> [Double]
trackMins (Track Length -> [Double]) -> Track Length -> [Double]
forall a b. (a -> b) -> a -> b
$ Grid Length Double -> Track Length
forall m n. Size m n -> m
block Grid Length Double
self, trackNats :: [Double]
trackNats = Track Length -> [Double]
forall x. Track x -> [Double]
trackNats (Track Length -> [Double]) -> Track Length -> [Double]
forall a b. (a -> b) -> a -> b
$ Grid Length Double -> Track Length
forall m n. Size m n -> m
block Grid Length Double
self
      }
    heights :: [Double]
heights = Double -> Track Length -> [Double]
sizeTrackMaxs (Size Double Double -> Double
forall m n. Size m n -> n
inline (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) (Track Length -> [Double]) -> Track Length -> [Double]
forall a b. (a -> b) -> a -> b
$ Grid Length Double -> Track Length
forall m n. Size m n -> m
block Grid Length Double
self
    lowerSize :: Either Length b -> Either Double b
lowerSize (Left x :: Length
x) = Double -> Either Double b
forall a b. a -> Either a b
Left (Double -> Either Double b) -> Double -> Either Double b
forall a b. (a -> b) -> a -> b
$ Double -> Length -> Double
lowerLength Double
width Length
x
    lowerSize (Right x :: b
x) = b -> Either Double b
forall a b. b -> Either a b
Right b
x
    width :: Double
width = Size Double Double -> Double
forall m n. Size m n -> n
inline (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent
boxHeight parent :: PaddedBox Double Double
parent (LayoutInline val :: x
val font :: Font'
font self' :: Paragraph
self' paging :: PageOptions
paging vals :: [x]
vals) =
    x
-> Font'
-> Paragraph
-> PageOptions
-> [x]
-> LayoutItem Double Double x
forall m n x.
x -> Font' -> Paragraph -> PageOptions -> [x] -> LayoutItem m n x
LayoutInline x
val Font'
font Paragraph
self' PageOptions
paging [x]
vals
boxHeight _ (LayoutInline' val :: x
val font :: Font'
font self' :: ParagraphLayout
self' paging :: PageOptions
paging vals :: [x]
vals) =
    x
-> Font'
-> ParagraphLayout
-> PageOptions
-> [x]
-> LayoutItem Double Double x
forall m n x.
x
-> Font'
-> ParagraphLayout
-> PageOptions
-> [x]
-> LayoutItem m n x
LayoutInline' x
val Font'
font ParagraphLayout
self' PageOptions
paging [x]
vals
boxHeight _ (LayoutSpan val :: x
val font :: Font'
font self' :: Fragment
self') = x -> Font' -> Fragment -> LayoutItem Double Double x
forall m n x. x -> Font' -> Fragment -> LayoutItem m n x
LayoutSpan x
val Font'
font Fragment
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 :: Double
-> Double
-> LayoutItem Double Double x
-> (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
boxSplit maxheight :: Double
maxheight _ node :: LayoutItem Double Double x
node | PaddedBox Double Double -> Double
forall m n. Num m => PaddedBox m n -> m
height (LayoutItem Double Double x -> PaddedBox Double Double
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) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
maxheight = (LayoutItem Double Double x
node, Maybe (LayoutItem Double Double x)
forall a. Maybe a
Nothing)
boxSplit maxheight :: Double
maxheight pageheight :: Double
pageheight (LayoutFlow val :: x
val self :: PaddedBox Double Double
self childs :: [LayoutItem Double Double x]
childs)
    | (next :: LayoutItem Double Double x
next:_) <- [LayoutItem Double Double x]
childs1, ((y :: Double
y,_):_) <- [(Double, LayoutItem Double Double x)]
childs0',
        (tail :: LayoutItem Double Double x
tail,Just nextpage :: LayoutItem Double Double x
nextpage) <- Double
-> Double
-> LayoutItem Double Double x
-> (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
forall x.
PropertyParser x =>
Double
-> Double
-> LayoutItem Double Double x
-> (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
boxSplit (Double
maxheight Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y) Double
pageheight LayoutItem Double Double x
next =
            (x
-> PaddedBox Double Double
-> [LayoutItem Double Double x]
-> LayoutItem Double Double x
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 = (PaddedBox Double Double -> Size Double Double
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 [LayoutItem Double Double x]
-> [LayoutItem Double Double x] -> [LayoutItem Double Double x]
forall a. [a] -> [a] -> [a]
++ [LayoutItem Double Double x
tail]),
             LayoutItem Double Double x -> Maybe (LayoutItem Double Double x)
forall a. a -> Maybe a
Just (LayoutItem Double Double x -> Maybe (LayoutItem Double Double x))
-> LayoutItem Double Double x -> Maybe (LayoutItem Double Double x)
forall a b. (a -> b) -> a -> b
$ x
-> PaddedBox Double Double
-> [LayoutItem Double Double x]
-> LayoutItem Double Double x
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 = (PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
self) { block :: Double
B.block = Size Double Double -> Double
forall m n. Size m n -> m
B.block (PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
self) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y }
             } (LayoutItem Double Double x
nextpageLayoutItem Double Double x
-> [LayoutItem Double Double x] -> [LayoutItem Double Double x]
forall a. a -> [a] -> [a]
:[LayoutItem Double Double x]
childs1))
    | Bool
otherwise =
        (x
-> PaddedBox Double Double
-> [LayoutItem Double Double x]
-> LayoutItem Double Double x
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 = (PaddedBox Double Double -> Size Double Double
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,
         LayoutItem Double Double x -> Maybe (LayoutItem Double Double x)
forall a. a -> Maybe a
Just (LayoutItem Double Double x -> Maybe (LayoutItem Double Double x))
-> LayoutItem Double Double x -> Maybe (LayoutItem Double Double x)
forall a b. (a -> b) -> a -> b
$ x
-> PaddedBox Double Double
-> [LayoutItem Double Double x]
-> LayoutItem Double Double x
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 = ((Double, LayoutItem Double Double x)
 -> LayoutItem Double Double x)
-> [(Double, LayoutItem Double Double x)]
-> [LayoutItem Double Double x]
forall a b. (a -> b) -> [a] -> [b]
map (Double, LayoutItem Double Double x) -> LayoutItem Double Double x
forall a b. (a, b) -> b
snd [(Double, LayoutItem Double Double x)]
childs0'
    childs1 :: [LayoutItem Double Double x]
childs1 = ((Double, LayoutItem Double Double x)
 -> LayoutItem Double Double x)
-> [(Double, LayoutItem Double Double x)]
-> [LayoutItem Double Double x]
forall a b. (a -> b) -> [a] -> [b]
map (Double, LayoutItem Double Double x) -> LayoutItem Double Double x
forall a b. (a, b) -> b
snd [(Double, LayoutItem Double Double x)]
childs1'
    (childs0' :: [(Double, LayoutItem Double Double x)]
childs0', childs1' :: [(Double, LayoutItem Double Double x)]
childs1') = ((Double, LayoutItem Double Double x) -> Bool)
-> [(Double, LayoutItem Double Double x)]
-> ([(Double, LayoutItem Double Double x)],
    [(Double, LayoutItem Double Double x)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Double, LayoutItem Double Double x) -> Bool
forall b. (Double, b) -> Bool
overflowed ([(Double, LayoutItem Double Double x)]
 -> ([(Double, LayoutItem Double Double x)],
     [(Double, LayoutItem Double Double x)]))
-> [(Double, LayoutItem Double Double x)]
-> ([(Double, LayoutItem Double Double x)],
    [(Double, LayoutItem Double Double x)])
forall a b. (a -> b) -> a -> b
$ Double
-> [LayoutItem Double Double x]
-> [(Double, LayoutItem Double Double x)]
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 0 [LayoutItem Double Double x]
childs
    overflowed :: (Double, b) -> Bool
overflowed (y :: Double
y, _) = Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
maxheight
    inner :: t -> [LayoutItem t n x] -> [(t, LayoutItem t n x)]
inner start :: t
start (child :: LayoutItem t n x
child:childs :: [LayoutItem t n x]
childs) = (t
start', LayoutItem t n x
child)(t, LayoutItem t n x)
-> [(t, LayoutItem t n x)] -> [(t, LayoutItem t n x)]
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 t -> t -> t
forall a. Num a => a -> a -> a
+ PaddedBox t n -> t
forall m n. Num m => PaddedBox m n -> m
height (LayoutItem t n x -> PaddedBox t n
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 _ [] = []
boxSplit _ _ self :: LayoutItem Double Double x
self@(LayoutGrid _ _ _ _) = (LayoutItem Double Double x
self, Maybe (LayoutItem Double Double x)
forall a. Maybe a
Nothing) -- TODO
boxSplit maxheight :: Double
maxheight pageheight :: Double
pageheight (LayoutInline a :: x
a b :: Font'
b self :: Paragraph
self c :: PageOptions
c d :: [x]
d) =
    Double
-> Double
-> LayoutItem Double Double x
-> (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
forall x.
PropertyParser x =>
Double
-> Double
-> LayoutItem Double Double x
-> (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
boxSplit Double
maxheight Double
pageheight (LayoutItem Double Double x
 -> (LayoutItem Double Double x,
     Maybe (LayoutItem Double Double x)))
-> LayoutItem Double Double x
-> (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
forall a b. (a -> b) -> a -> b
$ x
-> Font'
-> ParagraphLayout
-> PageOptions
-> [x]
-> LayoutItem Double Double x
forall m n x.
x
-> Font'
-> ParagraphLayout
-> PageOptions
-> [x]
-> LayoutItem m n x
LayoutInline' x
a Font'
b (Paragraph -> ParagraphLayout
layoutPlain Paragraph
self) PageOptions
c [x]
d
boxSplit maxheight :: Double
maxheight pageheight :: Double
pageheight (LayoutInline' a :: x
a b :: Font'
b self :: ParagraphLayout
self paging :: PageOptions
paging c :: [x]
c) =
    case PageOptions
-> ParagraphLayout
-> (PageContinuity, ParagraphLayout, Maybe ParagraphLayout)
forall pl.
Paginable pl =>
PageOptions -> pl -> (PageContinuity, pl, Maybe pl)
paginate PageOptions
paging {
            pageCurrentHeight :: Int32
pageCurrentHeight = Int -> Int32
forall a. Enum a => Int -> a
toEnum (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a. Enum a => a -> Int
fromEnum Double
maxheight,
            pageNextHeight :: Int32
pageNextHeight = Int -> Int32
forall a. Enum a => Int -> a
toEnum (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a. Enum a => a -> Int
fromEnum Double
pageheight
      } ParagraphLayout
self of
        (Continue, self' :: ParagraphLayout
self', next :: Maybe ParagraphLayout
next) -> (ParagraphLayout -> LayoutItem Double Double x
forall m n. ParagraphLayout -> LayoutItem m n x
wrap ParagraphLayout
self', ParagraphLayout -> LayoutItem Double Double x
forall m n. ParagraphLayout -> LayoutItem m n x
wrap (ParagraphLayout -> LayoutItem Double Double x)
-> Maybe ParagraphLayout -> Maybe (LayoutItem Double Double x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ParagraphLayout
next)
        (Break, _, _) -> (LayoutItem Double Double x
forall x m n.
(PropertyParser x, Zero m, Zero n) =>
LayoutItem m n x
nullLayout, LayoutItem Double Double x -> Maybe (LayoutItem Double Double x)
forall a. a -> Maybe a
Just (LayoutItem Double Double x -> Maybe (LayoutItem Double Double x))
-> LayoutItem Double Double x -> Maybe (LayoutItem Double Double x)
forall a b. (a -> b) -> a -> b
$ ParagraphLayout -> LayoutItem Double Double x
forall m n. ParagraphLayout -> LayoutItem m n x
wrap ParagraphLayout
self)
  where
    wrap :: ParagraphLayout -> LayoutItem m n x
wrap self' :: ParagraphLayout
self' = x
-> Font'
-> ParagraphLayout
-> PageOptions
-> [x]
-> LayoutItem m n x
forall m n x.
x
-> Font'
-> ParagraphLayout
-> PageOptions
-> [x]
-> LayoutItem m n x
LayoutInline' x
a Font'
b ParagraphLayout
self' PageOptions
paging [x]
c
boxSplit _ _ self :: LayoutItem Double Double x
self@(LayoutSpan _ _ _) = (LayoutItem Double Double x
self, Maybe (LayoutItem Double Double x)
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 pageheight :: Double
pageheight node :: LayoutItem Double Double x
node
    | (page :: LayoutItem Double Double x
page, Just overflow :: LayoutItem Double Double x
overflow) <- Double
-> Double
-> LayoutItem Double Double x
-> (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
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
pageLayoutItem Double Double x
-> [LayoutItem Double Double x] -> [LayoutItem Double Double x]
forall 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 => (Double, Double) -> LayoutItem Double Double x ->
    LayoutItem Double Double ((Double, Double), x)
boxPosition :: (Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
boxPosition pos :: (Double, Double)
pos@(x :: Double
x, y :: Double
y) (LayoutFlow val :: x
val self :: PaddedBox Double Double
self childs :: [LayoutItem Double Double x]
childs) = ((Double, Double), x)
-> PaddedBox Double Double
-> [LayoutItem Double Double ((Double, Double), x)]
-> LayoutItem Double Double ((Double, Double), x)
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' = ((Size Double Double, LayoutItem Double Double x)
 -> LayoutItem Double Double ((Double, Double), x))
-> [(Size Double Double, LayoutItem Double Double x)]
-> [LayoutItem Double Double ((Double, Double), x)]
forall a b. (a -> b) -> [a] -> [b]
map (Size Double Double, LayoutItem Double Double x)
-> LayoutItem Double Double ((Double, Double), x)
forall x.
PropertyParser x =>
(Size Double Double, LayoutItem Double Double x)
-> LayoutItem Double Double ((Double, Double), x)
recurse ([(Size Double Double, LayoutItem Double Double x)]
 -> [LayoutItem Double Double ((Double, Double), x)])
-> [(Size Double Double, LayoutItem Double Double x)]
-> [LayoutItem Double Double ((Double, Double), x)]
forall a b. (a -> b) -> a -> b
$ [Size Double Double]
-> [LayoutItem Double Double x]
-> [(Size Double Double, LayoutItem Double Double x)]
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 x' :: Double
x' y' :: Double
y'), child :: LayoutItem Double Double x
child) = (Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
forall x.
PropertyParser x =>
(Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
boxPosition (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x', Double
y Double -> Double -> Double
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 ([PaddedBox Double Double] -> [Size Double Double])
-> [PaddedBox Double Double] -> [Size Double Double]
forall a b. (a -> b) -> a -> b
$ (LayoutItem Double Double x -> PaddedBox Double Double)
-> [LayoutItem Double Double x] -> [PaddedBox Double Double]
forall a b. (a -> b) -> [a] -> [b]
map LayoutItem Double Double x -> PaddedBox Double Double
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@(x :: Double
x, y :: Double
y) (LayoutGrid val :: x
val self :: Grid Double Double
self cells :: [GridItem]
cells childs :: [LayoutItem Double Double x]
childs) = ((Double, Double), x)
-> Grid Double Double
-> [GridItem]
-> [LayoutItem Double Double ((Double, Double), x)]
-> LayoutItem Double Double ((Double, Double), x)
forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid ((Double, Double)
pos, x
val) Grid Double Double
self [GridItem]
cells [LayoutItem Double Double ((Double, Double), x)]
childs'
  where
    childs' :: [LayoutItem Double Double ((Double, Double), x)]
childs' = (((Double, Double), LayoutItem Double Double x)
 -> LayoutItem Double Double ((Double, Double), x))
-> [((Double, Double), LayoutItem Double Double x)]
-> [LayoutItem Double Double ((Double, Double), x)]
forall a b. (a -> b) -> [a] -> [b]
map ((Double, Double), LayoutItem Double Double x)
-> LayoutItem Double Double ((Double, Double), x)
forall x.
PropertyParser x =>
((Double, Double), LayoutItem Double Double x)
-> LayoutItem Double Double ((Double, Double), x)
recurse ([((Double, Double), LayoutItem Double Double x)]
 -> [LayoutItem Double Double ((Double, Double), x)])
-> [((Double, Double), LayoutItem Double Double x)]
-> [LayoutItem Double Double ((Double, Double), x)]
forall a b. (a -> b) -> a -> b
$ [(Double, Double)]
-> [LayoutItem Double Double x]
-> [((Double, Double), LayoutItem Double Double x)]
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 ((x' :: Double
x', y' :: Double
y'), child :: LayoutItem Double Double x
child) = (Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
forall x.
PropertyParser x =>
(Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
boxPosition (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x', Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y') LayoutItem Double Double x
child
    pos' :: [(Double, Double)]
pos' = Grid Double Double -> [GridItem] -> [(Double, Double)]
gridPosition Grid Double Double
self [GridItem]
cells
boxPosition pos :: (Double, Double)
pos@(x :: Double
x, y :: Double
y) (LayoutInline val :: x
val font :: Font'
font self :: Paragraph
self paging :: PageOptions
paging vals :: [x]
vals) =
    ((Double, Double), x)
-> Font'
-> Paragraph
-> PageOptions
-> [((Double, Double), x)]
-> LayoutItem Double Double ((Double, Double), x)
forall m n x.
x -> Font' -> Paragraph -> PageOptions -> [x] -> LayoutItem m n x
LayoutInline ((Double, Double)
pos, x
val) Font'
font Paragraph
self PageOptions
paging ([((Double, Double), x)]
 -> LayoutItem Double Double ((Double, Double), x))
-> [((Double, Double), x)]
-> LayoutItem Double Double ((Double, Double), x)
forall a b. (a -> b) -> a -> b
$ ((x, Fragment) -> ((Double, Double), x))
-> [(x, Fragment)] -> [((Double, Double), x)]
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: x
x, y :: Fragment
y) -> (Font' -> (Double, Double) -> Fragment -> (Double, Double)
fragmentPos Font'
font (Double, Double)
pos Fragment
y, x
x)) ([(x, Fragment)] -> [((Double, Double), x)])
-> [(x, Fragment)] -> [((Double, Double), x)]
forall a b. (a -> b) -> a -> b
$
            [x] -> Paragraph -> [(x, Fragment)]
forall x. [x] -> Paragraph -> [(x, Fragment)]
inlineChildren [x]
vals Paragraph
self
boxPosition pos :: (Double, Double)
pos@(x :: Double
x, y :: Double
y) (LayoutInline' val :: x
val font :: Font'
font self :: ParagraphLayout
self paging :: PageOptions
paging vals :: [x]
vals) =
    ((Double, Double), x)
-> Font'
-> ParagraphLayout
-> PageOptions
-> [((Double, Double), x)]
-> LayoutItem Double Double ((Double, Double), x)
forall m n x.
x
-> Font'
-> ParagraphLayout
-> PageOptions
-> [x]
-> LayoutItem m n x
LayoutInline' ((Double, Double)
pos, x
val) Font'
font ParagraphLayout
self PageOptions
paging ([((Double, Double), x)]
 -> LayoutItem Double Double ((Double, Double), x))
-> [((Double, Double), x)]
-> LayoutItem Double Double ((Double, Double), x)
forall a b. (a -> b) -> a -> b
$ ((x, Fragment) -> ((Double, Double), x))
-> [(x, Fragment)] -> [((Double, Double), x)]
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: x
x, y :: Fragment
y) -> (Font' -> (Double, Double) -> Fragment -> (Double, Double)
fragmentPos Font'
font (Double, Double)
pos Fragment
y, x
x)) ([(x, Fragment)] -> [((Double, Double), x)])
-> [(x, Fragment)] -> [((Double, Double), x)]
forall a b. (a -> b) -> a -> b
$
            [x] -> ParagraphLayout -> [(x, Fragment)]
forall x. [x] -> ParagraphLayout -> [(x, Fragment)]
layoutChildren [x]
vals ParagraphLayout
self
boxPosition pos :: (Double, Double)
pos (LayoutSpan val :: x
val f :: Font'
f self :: Fragment
self) = ((Double, Double), x)
-> Font'
-> Fragment
-> LayoutItem Double Double ((Double, Double), x)
forall m n x. x -> Font' -> Fragment -> LayoutItem m n x
LayoutSpan ((Double, Double)
pos, x
val) Font'
f Fragment
self -- No children...
-- | Compute sizes & position information for all nodes in the (sub)tree.
boxLayout :: PropertyParser x => PaddedBox Double Double -> LayoutItem Length Length x ->
        Bool -> [LayoutItem Double Double ((Double, Double), x)]
boxLayout :: PaddedBox Double Double
-> LayoutItem Length Length x
-> Bool
-> [LayoutItem Double Double ((Double, Double), x)]
boxLayout parent :: PaddedBox Double Double
parent self :: LayoutItem Length Length x
self paginate :: Bool
paginate = [LayoutItem Double Double ((Double, Double), x)]
self9
  where
    self0 :: LayoutItem Length Length x
self0 = Maybe Double
-> LayoutItem Length Length x -> LayoutItem Length Length x
forall y x.
(Zero y, CastDouble y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMinWidth Maybe Double
forall a. Maybe a
Nothing LayoutItem Length Length x
self
    self1 :: LayoutItem Length Length x
self1 = Maybe Double
-> LayoutItem Length Length x -> LayoutItem Length Length x
forall y x.
(Zero y, CastDouble y) =>
Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxNatWidth Maybe Double
forall a. Maybe a
Nothing LayoutItem Length Length x
self0
    self2 :: LayoutItem Length Length x
self2 = PaddedBox Double Double
-> LayoutItem Length Length x -> LayoutItem Length Length x
forall y a x.
CastDouble 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 = PaddedBox Double Double
-> LayoutItem Length Length x -> LayoutItem Length Double x
forall y b x.
(Zero y, CastDouble 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 = Double -> LayoutItem Length Double x -> LayoutItem Length Double x
forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxNatHeight (Size Double Double -> Double
forall m n. Size m n -> n
inline (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) LayoutItem Length Double x
self3
    self5 :: LayoutItem Length Double x
self5 = Double -> LayoutItem Length Double x -> LayoutItem Length Double x
forall x.
Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxMinHeight (Size Double Double -> Double
forall m n. Size m n -> n
inline (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) LayoutItem Length Double x
self4
    self6 :: LayoutItem Length Double x
self6 = PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Length Double x
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 = PaddedBox Double Double
-> LayoutItem Length Double x -> LayoutItem Double Double x
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 = Double
-> LayoutItem Double Double x -> [LayoutItem Double Double x]
forall x.
PropertyParser x =>
Double
-> LayoutItem Double Double x -> [LayoutItem Double Double x]
boxPaginate (Size Double Double -> Double
forall m n. Size m n -> m
block (Size Double Double -> Double) -> Size Double Double -> Double
forall a b. (a -> b) -> a -> b
$ PaddedBox Double Double -> Size Double Double
forall m n. PaddedBox m n -> Size m n
size PaddedBox Double Double
parent) LayoutItem Double Double x
self7
        | Bool
otherwise = [LayoutItem Double Double x
self7]
    self9 :: [LayoutItem Double Double ((Double, Double), x)]
self9 = (LayoutItem Double Double x
 -> LayoutItem Double Double ((Double, Double), x))
-> [LayoutItem Double Double x]
-> [LayoutItem Double Double ((Double, Double), x)]
forall a b. (a -> b) -> [a] -> [b]
map ((Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
forall x.
PropertyParser x =>
(Double, Double)
-> LayoutItem Double Double x
-> LayoutItem Double Double ((Double, Double), x)
boxPosition (0, 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 :: LayoutItem x y z -> M.Map (Pattern, Double) IS.IntSet
glyphsPerFont :: LayoutItem x y z -> Map (Pattern, Double) IntSet
glyphsPerFont (LayoutSpan _ font :: Font'
font self :: Fragment
self) =
    (Font' -> Pattern
pattern Font'
font, Font' -> Double
fontSize Font'
font) (Pattern, Double) -> IntSet -> Map (Pattern, Double) IntSet
forall k a. k -> a -> Map k a
`M.singleton` [Int] -> IntSet
IS.fromList [Int]
glyphs
  where glyphs :: [Int]
glyphs = (Word32 -> Int) -> [Word32] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> Int
forall a. Enum a => a -> Int
fromEnum ([Word32] -> [Int]) -> [Word32] -> [Int]
forall a b. (a -> b) -> a -> b
$ (GlyphInfo -> Word32) -> [GlyphInfo] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map GlyphInfo -> Word32
Hb.codepoint ([GlyphInfo] -> [Word32]) -> [GlyphInfo] -> [Word32]
forall a b. (a -> b) -> a -> b
$ ((GlyphInfo, GlyphPos) -> GlyphInfo)
-> [(GlyphInfo, GlyphPos)] -> [GlyphInfo]
forall a b. (a -> b) -> [a] -> [b]
map (GlyphInfo, GlyphPos) -> GlyphInfo
forall a b. (a, b) -> a
fst ([(GlyphInfo, GlyphPos)] -> [GlyphInfo])
-> [(GlyphInfo, GlyphPos)] -> [GlyphInfo]
forall a b. (a -> b) -> a -> b
$ Fragment -> [(GlyphInfo, GlyphPos)]
fragmentGlyphs Fragment
self
glyphsPerFont node :: LayoutItem x y z
node = (IntSet -> IntSet -> IntSet)
-> [Map (Pattern, Double) IntSet] -> Map (Pattern, Double) IntSet
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 ([Map (Pattern, Double) IntSet] -> Map (Pattern, Double) IntSet)
-> [Map (Pattern, Double) IntSet] -> Map (Pattern, Double) IntSet
forall a b. (a -> b) -> a -> b
$ (LayoutItem x y z -> Map (Pattern, Double) IntSet)
-> [LayoutItem x y z] -> [Map (Pattern, Double) IntSet]
forall a b. (a -> b) -> [a] -> [b]
map LayoutItem x y z -> Map (Pattern, Double) IntSet
forall x y z. LayoutItem x y z -> Map (Pattern, Double) IntSet
glyphsPerFont ([LayoutItem x y z] -> [Map (Pattern, Double) IntSet])
-> [LayoutItem x y z] -> [Map (Pattern, Double) IntSet]
forall a b. (a -> b) -> a -> b
$ LayoutItem x y z -> [LayoutItem x y z]
forall m n x. LayoutItem m n x -> [LayoutItem m n x]
layoutGetChilds LayoutItem x y z
node