{-# LANGUAGE TupleSections #-}
-- | Sizes inline text & extracts positioned children,
-- wraps Balkón for the actual logic.
module Graphics.Layout.Inline(paragraphMap, layoutMap, treeMap,
    inlineMin, inlineSize, inlineChildren, layoutSize, layoutChildren,
    treeBox, positionTree, treeInner, treeInner', glyphs, codepoints,
    FragmentTree(..)) where

import Data.Text.ParagraphLayout.Rich (Paragraph(..), ParagraphOptions(..),
                                Fragment(..), ParagraphLayout(..), AncestorBox(..),
                                InnerNode(..), Box(..), RootNode(..),
                                layoutRich, boxSpacing, BoxSpacing(..),
                                activateBoxSpacing, paragraphSafeWidth)
import Data.Text.ParagraphLayout.Rect (Rect(..),
                                width, height, x_max, x_min, y_min, y_max)
import qualified Data.Text.Glyphize as HB
import Data.Int (Int32)
import Data.Word (Word32)
import Debug.Trace (trace) -- To warn about unexpected branches!

import Graphics.Layout.Box hiding (min, max, width, height)
import qualified Graphics.Layout.Box as Box
import Graphics.Layout.CSS.Font (hbUnit)

-- | Convert from Harfbuzz units to device pixels as a Double
hbScale :: Int32 -> Double
hbScale :: Int32 -> Double
hbScale = (forall a. Fractional a => a -> a -> a
/Double
hbUnit) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
-- | Convert from Harfbuzz units to device pixels as a Double or Length.
c :: CastDouble a => Int32 -> a
c :: forall a. CastDouble a => Int32 -> a
c = forall a. CastDouble a => Double -> a
fromDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Double
hbScale
-- | Convert from a CastDouble in device pixels to Harfbuzz units.
unscale :: CastDouble x => x -> Int32
unscale :: forall x. CastDouble x => x -> Int32
unscale = forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*Double
hbUnit) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CastDouble a => a -> Double
toDouble

-- | Compute minimum width & height for some richtext.
inlineMin :: (CastDouble x, CastDouble y) =>
        Paragraph (a, PaddedBox x y, c) -> Size x y
inlineMin :: forall x y a c.
(CastDouble x, CastDouble y) =>
Paragraph (a, PaddedBox x y, c) -> Size x y
inlineMin = forall {n} {m}.
(CastDouble n, CastDouble m) =>
Rect Int32 -> Size m n
layoutSize' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall m n a c.
(CastDouble m, CastDouble n) =>
Paragraph (a, PaddedBox m n, c) -> Int32 -> Rect Int32
layoutRich' Int32
0
-- | Compute width & height of some richtext at configured width.
inlineSize :: (CastDouble x, CastDouble y) =>
        Paragraph (a, PaddedBox x y, c) -> Size x y
inlineSize :: forall x y a c.
(CastDouble x, CastDouble y) =>
Paragraph (a, PaddedBox x y, c) -> Size x y
inlineSize self :: Paragraph (a, PaddedBox x y, c)
self@(Paragraph Array
_ Int
_ RootNode Int (a, PaddedBox x y, c)
_ ParagraphOptions
opts) =
    forall {n} {m}.
(CastDouble n, CastDouble m) =>
Rect Int32 -> Size m n
layoutSize' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m n a c.
(CastDouble m, CastDouble n) =>
Paragraph (a, PaddedBox m n, c) -> Int32 -> Rect Int32
layoutRich' Paragraph (a, PaddedBox x y, c)
self forall a b. (a -> b) -> a -> b
$ ParagraphOptions -> Int32
paragraphMaxWidth ParagraphOptions
opts
-- | Retrieve children out of some richtext,
-- associating given userdata with them.
inlineChildren :: (CastDouble x, CastDouble y, Eq x, Eq y, Eq a, Eq c) =>
        Paragraph (a, PaddedBox x y, c) -> [FragmentTree (a, PaddedBox x y, c)]
inlineChildren :: forall x y a c.
(CastDouble x, CastDouble y, Eq x, Eq y, Eq a, Eq c) =>
Paragraph (a, PaddedBox x y, c)
-> [FragmentTree (a, PaddedBox x y, c)]
inlineChildren Paragraph (a, PaddedBox x y, c)
self = forall a. Eq a => ParagraphLayout a -> [FragmentTree a]
layoutChildren forall a b. (a -> b) -> a -> b
$ forall d. Paragraph d -> ParagraphLayout d
layoutRich forall a b. (a -> b) -> a -> b
$ forall m n a c.
(CastDouble m, CastDouble n) =>
Paragraph (a, PaddedBox m n, c) -> Paragraph (a, PaddedBox m n, c)
lowerSpacing Paragraph (a, PaddedBox x y, c)
self

-- | Retrieve a laid-out paragraph's rect & convert to CatTrap types.
layoutSize :: (CastDouble x, CastDouble y) => ParagraphLayout a -> Size x y
layoutSize :: forall x y a.
(CastDouble x, CastDouble y) =>
ParagraphLayout a -> Size x y
layoutSize = forall {n} {m}.
(CastDouble n, CastDouble m) =>
Rect Int32 -> Size m n
layoutSize' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. ParagraphLayout d -> Rect Int32
paragraphRect
layoutSize' :: Rect Int32 -> Size m n
layoutSize' Rect Int32
r = forall m n. n -> m -> Size m n
Size (forall a. CastDouble a => Int32 -> a
c forall a b. (a -> b) -> a -> b
$ forall a. Num a => Rect a -> a
width Rect Int32
r) (forall a. CastDouble a => Int32 -> a
c forall a b. (a -> b) -> a -> b
$ forall a. Num a => Rect a -> a
height Rect Int32
r)
-- | Retrieve a laid-out paragraph's children & associate with given userdata.
layoutChildren :: Eq a => ParagraphLayout a -> [FragmentTree a]
layoutChildren :: forall a. Eq a => ParagraphLayout a -> [FragmentTree a]
layoutChildren ParagraphLayout a
self = forall a. Eq a => ParagraphLayout a -> [FragmentTree a]
reconstructTree ParagraphLayout a
self

-- | Layout a paragraph at given width & retrieve resulting rect.
-- LEGACY.
layoutRich' :: (CastDouble m, CastDouble n) =>
        Paragraph (a, PaddedBox m n, c) -> Int32 -> Rect Int32
layoutRich' :: forall m n a c.
(CastDouble m, CastDouble n) =>
Paragraph (a, PaddedBox m n, c) -> Int32 -> Rect Int32
layoutRich' (Paragraph Array
a Int
b RootNode Int (a, PaddedBox m n, c)
c ParagraphOptions
d) Int32
width =
    (forall d. ParagraphLayout d -> Rect Int32
paragraphRect ParagraphLayout (a, PaddedBox m n, c)
layout) { x_size :: Int32
x_size = forall d. ParagraphLayout d -> Int32
paragraphSafeWidth ParagraphLayout (a, PaddedBox m n, c)
layout}
  where
    layout :: ParagraphLayout (a, PaddedBox m n, c)
layout = forall d. Paragraph d -> ParagraphLayout d
layoutRichforall a b. (a -> b) -> a -> b
$forall m n a c.
(CastDouble m, CastDouble n) =>
Paragraph (a, PaddedBox m n, c) -> Paragraph (a, PaddedBox m n, c)
lowerSpacingforall a b. (a -> b) -> a -> b
$forall d.
Array -> Int -> RootNode Int d -> ParagraphOptions -> Paragraph d
Paragraph Array
a Int
b RootNode Int (a, PaddedBox m n, c)
c ParagraphOptions
d {paragraphMaxWidth :: Int32
paragraphMaxWidth=Int32
width}

-- | Copy surrounding whitespace into Balkon properties.
lowerSpacing :: (CastDouble m, CastDouble n) =>
    Paragraph (a, PaddedBox m n, c) -> Paragraph (a, PaddedBox m n, c)
lowerSpacing :: forall m n a c.
(CastDouble m, CastDouble n) =>
Paragraph (a, PaddedBox m n, c) -> Paragraph (a, PaddedBox m n, c)
lowerSpacing (Paragraph Array
a Int
b (RootBox Box Int (a, PaddedBox m n, c)
c) ParagraphOptions
d) = forall d.
Array -> Int -> RootNode Int d -> ParagraphOptions -> Paragraph d
Paragraph Array
a Int
b (forall t d. Box t d -> RootNode t d
RootBox forall a b. (a -> b) -> a -> b
$ forall {n} {m} {t} {a} {c}.
(CastDouble n, CastDouble m) =>
Box t (a, PaddedBox m n, c) -> Box t (a, PaddedBox m n, c)
inner Box Int (a, PaddedBox m n, c)
c) ParagraphOptions
d
  where
    inner :: Box t (a, PaddedBox m n, c) -> Box t (a, PaddedBox m n, c)
inner (Box [InnerNode t (a, PaddedBox m n, c)]
childs TextOptions
opts) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall t d. [InnerNode t d] -> TextOptions -> Box t d
Box TextOptions
opts forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map InnerNode t (a, PaddedBox m n, c)
-> InnerNode t (a, PaddedBox m n, c)
inner' [InnerNode t (a, PaddedBox m n, c)]
childs
    inner' :: InnerNode t (a, PaddedBox m n, c)
-> InnerNode t (a, PaddedBox m n, c)
inner' (InlineBox e :: (a, PaddedBox m n, c)
e@(a
_, PaddedBox m n
f, c
_) Box t (a, PaddedBox m n, c)
child BoxOptions
opts) = forall t d. d -> Box t d -> BoxOptions -> InnerNode t d
InlineBox (a, PaddedBox m n, c)
e (Box t (a, PaddedBox m n, c) -> Box t (a, PaddedBox m n, c)
inner Box t (a, PaddedBox m n, c)
child) forall a b. (a -> b) -> a -> b
$
        forall a b c. (a -> b -> c) -> b -> a -> c
flip BoxSpacing -> BoxOptions -> BoxOptions
activateBoxSpacing BoxOptions
opts forall a b. (a -> b) -> a -> b
$
            Int32 -> Int32 -> BoxSpacing
BoxSpacingLeftRight (forall {a} {m}. Num a => PaddedBox m a -> a
leftSpace PaddedBox Int32 Int32
box) (forall {a} {m}. Num a => PaddedBox m a -> a
rightSpace PaddedBox Int32 Int32
box)
      where box :: PaddedBox Int32 Int32
box = forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' forall x. CastDouble x => x -> Int32
unscale forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' forall x. CastDouble x => x -> Int32
unscale PaddedBox m n
f
    inner' self :: InnerNode t (a, PaddedBox m n, c)
self@(TextSequence (a, PaddedBox m n, c)
_ t
_) = InnerNode t (a, PaddedBox m n, c)
self


-- | A tree extracted from Balkón's inline layout.
data FragmentTree x = Branch (AncestorBox x) [FragmentTree x]
    | Leaf (Fragment x)
    deriving (Int -> FragmentTree x -> ShowS
forall x. Show x => Int -> FragmentTree x -> ShowS
forall x. Show x => [FragmentTree x] -> ShowS
forall x. Show x => FragmentTree x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FragmentTree x] -> ShowS
$cshowList :: forall x. Show x => [FragmentTree x] -> ShowS
show :: FragmentTree x -> String
$cshow :: forall x. Show x => FragmentTree x -> String
showsPrec :: Int -> FragmentTree x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> FragmentTree x -> ShowS
Show, FragmentTree x -> FragmentTree x -> Bool
forall x. Eq x => FragmentTree x -> FragmentTree x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FragmentTree x -> FragmentTree x -> Bool
$c/= :: forall x. Eq x => FragmentTree x -> FragmentTree x -> Bool
== :: FragmentTree x -> FragmentTree x -> Bool
$c== :: forall x. Eq x => FragmentTree x -> FragmentTree x -> Bool
Eq)

-- | Apply an operation to the 2nd field of the paragraph's userdata,
-- for it's entire subtree.
paragraphMap :: (b -> b') -> Paragraph (a, b, c) -> Paragraph (a, b', c)
paragraphMap :: forall b b' a c.
(b -> b') -> Paragraph (a, b, c) -> Paragraph (a, b', c)
paragraphMap b -> b'
cb (Paragraph Array
a Int
b (RootBox Box Int (a, b, c)
c) ParagraphOptions
d) =
    forall d.
Array -> Int -> RootNode Int d -> ParagraphOptions -> Paragraph d
Paragraph Array
a Int
b (forall t d. Box t d -> RootNode t d
RootBox forall a b. (a -> b) -> a -> b
$ forall {t} {a} {c}. Box t (a, b, c) -> Box t (a, b', c)
inner Box Int (a, b, c)
c) ParagraphOptions
d
  where
    inner :: Box t (a, b, c) -> Box t (a, b', c)
inner (Box [InnerNode t (a, b, c)]
childs TextOptions
opts) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall t d. [InnerNode t d] -> TextOptions -> Box t d
Box TextOptions
opts forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map InnerNode t (a, b, c) -> InnerNode t (a, b', c)
inner' [InnerNode t (a, b, c)]
childs
    inner' :: InnerNode t (a, b, c) -> InnerNode t (a, b', c)
inner' (InlineBox (a
e, b
f, c
g) Box t (a, b, c)
child BoxOptions
opts) =
        forall t d. d -> Box t d -> BoxOptions -> InnerNode t d
InlineBox (a
e, b -> b'
cb b
f, c
g) (Box t (a, b, c) -> Box t (a, b', c)
inner Box t (a, b, c)
child) BoxOptions
opts
    inner' (TextSequence (a
e, b
f, c
g) t
leaf) = forall t d. d -> t -> InnerNode t d
TextSequence (a
e, b -> b'
cb b
f, c
g) t
leaf

-- | Apply an operation to the 2nd field of a laid-out paragraph's userdata,
-- for it's entire subtree.
layoutMap :: (b -> b') -> ParagraphLayout (a, b, c) -> ParagraphLayout (a, b', c)
layoutMap :: forall b b' a c.
(b -> b')
-> ParagraphLayout (a, b, c) -> ParagraphLayout (a, b', c)
layoutMap b -> b'
cb (ParagraphLayout Rect Int32
a [Line]
b [Fragment (a, b, c)]
c) = forall d. Rect Int32 -> [Line] -> [Fragment d] -> ParagraphLayout d
ParagraphLayout Rect Int32
a [Line]
b forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {c}. Fragment (a, b, c) -> Fragment (a, b', c)
inner [Fragment (a, b, c)]
c
  where
    inner :: Fragment (a, b, c) -> Fragment (a, b', c)
inner self :: Fragment (a, b, c)
self@Fragment { fragmentUserData :: forall d. Fragment d -> d
fragmentUserData = (a
a, b
b, c
c) } = Fragment (a, b, c)
self {
        fragmentUserData :: (a, b', c)
fragmentUserData = (a
a, b -> b'
cb b
b, c
c),
        fragmentAncestorBoxes :: [AncestorBox (a, b', c)]
fragmentAncestorBoxes = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {c}. AncestorBox (a, b, c) -> AncestorBox (a, b', c)
inner' forall a b. (a -> b) -> a -> b
$ forall d. Fragment d -> [AncestorBox d]
fragmentAncestorBoxes Fragment (a, b, c)
self
      }
    inner' :: AncestorBox (a, b, c) -> AncestorBox (a, b', c)
inner' self :: AncestorBox (a, b, c)
self@AncestorBox { boxUserData :: forall d. AncestorBox d -> d
boxUserData = (a
a, b
b, c
c) } = AncestorBox (a, b, c)
self {
        boxUserData :: (a, b', c)
boxUserData = (a
a, b -> b'
cb b
b, c
c)
      }

-- | Apply an operation to the 2nd field of the tree extracted from a laid-out
-- paragraph, for all nodes.
treeMap :: (b -> b') -> FragmentTree (a, b, c) -> FragmentTree (a, b', c)
treeMap :: forall b b' a c.
(b -> b') -> FragmentTree (a, b, c) -> FragmentTree (a, b', c)
treeMap b -> b'
cb (Branch self :: AncestorBox (a, b, c)
self@AncestorBox { boxUserData :: forall d. AncestorBox d -> d
boxUserData = (a
a, b
b, c
c) } [FragmentTree (a, b, c)]
childs) =
    forall x. AncestorBox x -> [FragmentTree x] -> FragmentTree x
Branch AncestorBox (a, b, c)
self { boxUserData :: (a, b', c)
boxUserData = (a
a, b -> b'
cb b
b, c
c) } forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall b b' a c.
(b -> b') -> FragmentTree (a, b, c) -> FragmentTree (a, b', c)
treeMap b -> b'
cb) [FragmentTree (a, b, c)]
childs
treeMap b -> b'
cb (Leaf self :: Fragment (a, b, c)
self@Fragment { fragmentUserData :: forall d. Fragment d -> d
fragmentUserData = (a
a, b
b, c
c) }) =
    forall x. Fragment x -> FragmentTree x
Leaf Fragment (a, b, c)
self { fragmentUserData :: (a, b', c)
fragmentUserData = (a
a, b -> b'
cb b
b, c
c), fragmentAncestorBoxes :: [AncestorBox (a, b', c)]
fragmentAncestorBoxes = [] }

-- | Retrieve the rect for a fragment & convert to CatTrap types.
fragmentSize :: (CastDouble x, CastDouble y) =>
        FragmentTree (a, PaddedBox x y, c) -> Size x y
fragmentSize :: forall x y a c.
(CastDouble x, CastDouble y) =>
FragmentTree (a, PaddedBox x y, c) -> Size x y
fragmentSize FragmentTree (a, PaddedBox x y, c)
self = forall m n. n -> m -> Size m n
Size (forall a. CastDouble a => Int32 -> a
c forall a b. (a -> b) -> a -> b
$ forall a. Num a => Rect a -> a
width Rect Int32
r) (forall a. CastDouble a => Int32 -> a
c forall a b. (a -> b) -> a -> b
$ forall a. Num a => Rect a -> a
height Rect Int32
r)
    where r :: Rect Int32
r = forall m n a c.
(CastDouble m, CastDouble n) =>
FragmentTree (a, PaddedBox m n, c) -> Rect Int32
treeRect FragmentTree (a, PaddedBox x y, c)
self
-- | Compute the unioned rect for a subtree.
treeRect :: (CastDouble m, CastDouble n) =>
        FragmentTree (a, PaddedBox m n, c) -> Rect Int32
treeRect :: forall m n a c.
(CastDouble m, CastDouble n) =>
FragmentTree (a, PaddedBox m n, c) -> Rect Int32
treeRect (Branch AncestorBox { boxUserData :: forall d. AncestorBox d -> d
boxUserData = (a
_, PaddedBox m n
box', c
_)} [FragmentTree (a, PaddedBox m n, c)]
childs) =
        forall {a}. (Num a, Ord a) => [Rect a] -> Rect a
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall m n a c.
(CastDouble m, CastDouble n) =>
FragmentTree (a, PaddedBox m n, c) -> Rect Int32
treeRect [FragmentTree (a, PaddedBox m n, c)]
childs
    where
        box :: PaddedBox Int32 Int32
        box :: PaddedBox Int32 Int32
box = forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' forall x. CastDouble x => x -> Int32
unscale forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' forall x. CastDouble x => x -> Int32
unscale PaddedBox m n
box'
treeRect (Leaf Fragment (a, PaddedBox m n, c)
self) = forall d. Fragment d -> Rect Int32
fragmentRect Fragment (a, PaddedBox m n, c)
self

-- | Compute the paddedbox for a subtree.
treeBox :: (CastDouble m, CastDouble n) =>
    FragmentTree (a, PaddedBox m n, c) -> PaddedBox m n
treeBox :: forall m n a c.
(CastDouble m, CastDouble n) =>
FragmentTree (a, PaddedBox m n, c) -> PaddedBox m n
treeBox self :: FragmentTree (a, PaddedBox m n, c)
self@(Branch AncestorBox { boxUserData :: forall d. AncestorBox d -> d
boxUserData = (a
_, PaddedBox m n
box', c
_)} [FragmentTree (a, PaddedBox m n, c)]
_) = PaddedBox m n
box' {
    min :: Size m n
Box.min = Size m n
size', max :: Size m n
Box.max = Size m n
size', size :: Size m n
Box.size = Size m n
size', nat :: Size Double Double
Box.nat = Size Double Double
size
  } where
    size' :: Size m n
size' = forall n nn m. (n -> nn) -> Size m n -> Size m nn
mapSizeX forall a. CastDouble a => Double -> a
fromDouble forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> Size m n -> Size mm n
mapSizeY forall a. CastDouble a => Double -> a
fromDouble Size Double Double
size
    size :: Size Double Double
size = forall n nn m. (n -> nn) -> Size m n -> Size m nn
mapSizeX (forall a. Num a => a -> a -> a
subtract forall a b. (a -> b) -> a -> b
$ forall {a} {m}. Num a => PaddedBox m a -> a
hSpace PaddedBox Double Double
box) forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> Size m n -> Size mm n
mapSizeY (forall a. Num a => a -> a -> a
subtract forall a b. (a -> b) -> a -> b
$ forall {a} {n}. Num a => PaddedBox a n -> a
vSpace PaddedBox Double Double
box)forall a b. (a -> b) -> a -> b
$
         forall n nn m. (n -> nn) -> Size m n -> Size m nn
mapSizeX forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> Size m n -> Size mm n
mapSizeY forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall x y a c.
(CastDouble x, CastDouble y) =>
FragmentTree (a, PaddedBox x y, c) -> Size x y
fragmentSize FragmentTree (a, PaddedBox m n, c)
self
    box :: PaddedBox Double Double
box = forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' forall a. CastDouble a => a -> Double
toDouble PaddedBox m n
box'
treeBox self :: FragmentTree (a, PaddedBox m n, c)
self@(Leaf Fragment { fragmentUserData :: forall d. Fragment d -> d
fragmentUserData = (a
_, PaddedBox m n
box', c
_)}) = PaddedBox m n
box' {
    min :: Size m n
Box.min = Size m n
size', max :: Size m n
Box.max = Size m n
size', size :: Size m n
Box.size = Size m n
size', nat :: Size Double Double
Box.nat = Size Double Double
size
  } where
    size' :: Size m n
size' = forall n nn m. (n -> nn) -> Size m n -> Size m nn
mapSizeX forall a. CastDouble a => Double -> a
fromDouble forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> Size m n -> Size mm n
mapSizeY forall a. CastDouble a => Double -> a
fromDouble Size Double Double
size
    size :: Size Double Double
size = forall n nn m. (n -> nn) -> Size m n -> Size m nn
mapSizeX (forall a. Num a => a -> a -> a
subtract forall a b. (a -> b) -> a -> b
$ forall {a} {m}. Num a => PaddedBox m a -> a
hSpace PaddedBox Double Double
box) forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> Size m n -> Size mm n
mapSizeY (forall a. Num a => a -> a -> a
subtract forall a b. (a -> b) -> a -> b
$ forall {a} {n}. Num a => PaddedBox a n -> a
vSpace PaddedBox Double Double
box) forall a b. (a -> b) -> a -> b
$
        forall n nn m. (n -> nn) -> Size m n -> Size m nn
mapSizeX forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> Size m n -> Size mm n
mapSizeY forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall x y a c.
(CastDouble x, CastDouble y) =>
FragmentTree (a, PaddedBox x y, c) -> Size x y
fragmentSize FragmentTree (a, PaddedBox m n, c)
self
    box :: PaddedBox Double Double
box = forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' forall a. CastDouble a => a -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' forall a. CastDouble a => a -> Double
toDouble PaddedBox m n
box'

-- | Variant of `fragmentSize` asserting to the typesystem that both fields
-- of the resulting `Size` are of the same type.
fragmentSize' :: CastDouble x => FragmentTree (a, PaddedBox x x, c) -> Size x x
fragmentSize' :: forall x a c.
CastDouble x =>
FragmentTree (a, PaddedBox x x, c) -> Size x x
fragmentSize' = forall x y a c.
(CastDouble x, CastDouble y) =>
FragmentTree (a, PaddedBox x y, c) -> Size x y
fragmentSize -- Work around for typesystem.
-- | Retrieve the position of a fragment.
fragmentPos :: (Double, Double) -> Fragment a -> (Double, Double)
fragmentPos :: forall a. (Double, Double) -> Fragment a -> (Double, Double)
fragmentPos (Double
x, Double
y) Fragment a
self = (Double
x forall a. Num a => a -> a -> a
+ Int32 -> Double
hbScale (forall a. (Num a, Ord a) => Rect a -> a
x_min Rect Int32
r), Double
y forall a. Num a => a -> a -> a
+ Int32 -> Double
hbScale (forall a. (Num a, Ord a) => Rect a -> a
y_min Rect Int32
r))
    where r :: Rect Int32
r = forall d. Fragment d -> Rect Int32
fragmentRect Fragment a
self

-- | Extract the tree datastructure out of Balkón's ParagraphLayout
reconstructTree :: Eq x => ParagraphLayout x -> [FragmentTree x]
reconstructTree :: forall a. Eq a => ParagraphLayout a -> [FragmentTree a]
reconstructTree ParagraphLayout { paragraphFragments :: forall d. ParagraphLayout d -> [Fragment d]
paragraphFragments = [Fragment x]
frags } =
    forall x. Eq x => [Fragment x] -> [FragmentTree x]
reconstructTree' [Fragment x
frag {
            fragmentAncestorBoxes :: [AncestorBox x]
fragmentAncestorBoxes = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall d. Fragment d -> [AncestorBox d]
fragmentAncestorBoxes Fragment x
frag
        } | Fragment x
frag <- [Fragment x]
frags]
-- | Extract the tree datastructure out of Balkón's fragments.
reconstructTree' :: Eq x => [Fragment x] -> [FragmentTree x]
reconstructTree' :: forall x. Eq x => [Fragment x] -> [FragmentTree x]
reconstructTree' (self :: Fragment x
self@Fragment { fragmentAncestorBoxes :: forall d. Fragment d -> [AncestorBox d]
fragmentAncestorBoxes = [] }:[Fragment x]
frags) =
    forall x. Fragment x -> FragmentTree x
Leaf Fragment x
selfforall a. a -> [a] -> [a]
:forall x. Eq x => [Fragment x] -> [FragmentTree x]
reconstructTree' [Fragment x]
frags
reconstructTree' frags :: [Fragment x]
frags@(Fragment {
        fragmentAncestorBoxes :: forall d. Fragment d -> [AncestorBox d]
fragmentAncestorBoxes = AncestorBox x
branch:[AncestorBox x]
_, fragmentLine :: forall d. Fragment d -> Int
fragmentLine = Int
line
  }:[Fragment x]
_) =
    forall x. AncestorBox x -> [FragmentTree x] -> FragmentTree x
Branch AncestorBox x
branch (forall x. Eq x => [Fragment x] -> [FragmentTree x]
reconstructTree' [ Fragment x
child { fragmentAncestorBoxes :: [AncestorBox x]
fragmentAncestorBoxes = [AncestorBox x]
ancestors }
            | child :: Fragment x
child@Fragment { fragmentAncestorBoxes :: forall d. Fragment d -> [AncestorBox d]
fragmentAncestorBoxes = AncestorBox x
_:[AncestorBox x]
ancestors } <- [Fragment x]
childs])
        forall a. a -> [a] -> [a]
:forall x. Eq x => [Fragment x] -> [FragmentTree x]
reconstructTree' [Fragment x]
sibs
  where
    ([Fragment x]
childs, [Fragment x]
sibs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Fragment x -> Bool
sameBranch [Fragment x]
frags
    -- Cluster ancestor branches, breaking them per-line.
    sameBranch :: Fragment x -> Bool
sameBranch Fragment {fragmentAncestorBoxes :: forall d. Fragment d -> [AncestorBox d]
fragmentAncestorBoxes=AncestorBox x
branch':[AncestorBox x]
_, fragmentLine :: forall d. Fragment d -> Int
fragmentLine=Int
line'} =
        AncestorBox x
branch forall a. Eq a => a -> a -> Bool
== AncestorBox x
branch' Bool -> Bool -> Bool
&& Int
line forall a. Eq a => a -> a -> Bool
== Int
line'
    -- Leaves are always in their own branch.
    sameBranch Fragment { fragmentAncestorBoxes :: forall d. Fragment d -> [AncestorBox d]
fragmentAncestorBoxes = [] } = Bool
False
reconstructTree' [] = []

-- | Add an X,Y offset to all positions, annotating the userdata.
positionTree :: (CastDouble m, CastDouble n) => (Double, Double) ->
        FragmentTree (a, PaddedBox m n, c) ->
        FragmentTree (a, PaddedBox m n, ((Double, Double), c))
positionTree :: forall m n a c.
(CastDouble m, CastDouble n) =>
(Double, Double)
-> FragmentTree (a, PaddedBox m n, c)
-> FragmentTree (a, PaddedBox m n, ((Double, Double), c))
positionTree (Double
x, Double
y) self :: FragmentTree (a, PaddedBox m n, c)
self@(Branch (AncestorBox (a
a, PaddedBox m n
b, c
c) BoxEdge
d BoxEdge
e BoxEdge
f BoxEdge
g) [FragmentTree (a, PaddedBox m n, c)]
childs) =
    forall x. AncestorBox x -> [FragmentTree x] -> FragmentTree x
Branch (forall d.
d -> BoxEdge -> BoxEdge -> BoxEdge -> BoxEdge -> AncestorBox d
AncestorBox (a
a, PaddedBox m n
b, ((Double, Double)
pos, c
c)) BoxEdge
d BoxEdge
e BoxEdge
f BoxEdge
g) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall m n a c.
(CastDouble m, CastDouble n) =>
(Double, Double)
-> FragmentTree (a, PaddedBox m n, c)
-> FragmentTree (a, PaddedBox m n, ((Double, Double), c))
positionTree (Double, Double)
pos) [FragmentTree (a, PaddedBox m n, c)]
childs
  where
    pos :: (Double, Double)
pos = (Double
x forall a. Num a => a -> a -> a
+ Int32 -> Double
hbScale (forall a. (Num a, Ord a) => Rect a -> a
x_min Rect Int32
rect), Double
y forall a. Num a => a -> a -> a
+ Int32 -> Double
hbScale (forall a. (Num a, Ord a) => Rect a -> a
y_min Rect Int32
rect))
    rect :: Rect Int32
rect = forall m n a c.
(CastDouble m, CastDouble n) =>
FragmentTree (a, PaddedBox m n, c) -> Rect Int32
treeRect FragmentTree (a, PaddedBox m n, c)
self
positionTree (Double
x, Double
y) self :: FragmentTree (a, PaddedBox m n, c)
self@(Leaf (Fragment (a
a, PaddedBox m n
b, c
c) Int
d [AncestorBox (a, PaddedBox m n, c)]
_ Rect Int32
f Rect Int32
g (Int32, Int32)
h [(GlyphInfo, GlyphPos)]
i)) =
    forall x. Fragment x -> FragmentTree x
Leaf (forall d.
d
-> Int
-> [AncestorBox d]
-> Rect Int32
-> Rect Int32
-> (Int32, Int32)
-> [(GlyphInfo, GlyphPos)]
-> Fragment d
Fragment (a
a, PaddedBox m n
b, ((Double, Double)
pos, c
c)) Int
d [] Rect Int32
f Rect Int32
g (Int32, Int32)
h [(GlyphInfo, GlyphPos)]
i)
  where
    pos :: (Double, Double)
pos = (Double
x forall a. Num a => a -> a -> a
+ Int32 -> Double
hbScale (forall a. (Num a, Ord a) => Rect a -> a
x_min Rect Int32
rect), Double
y forall a. Num a => a -> a -> a
+ Int32 -> Double
hbScale (forall a. (Num a, Ord a) => Rect a -> a
y_min Rect Int32
rect))
    rect :: Rect Int32
rect = forall m n a c.
(CastDouble m, CastDouble n) =>
FragmentTree (a, PaddedBox m n, c) -> Rect Int32
treeRect FragmentTree (a, PaddedBox m n, c)
self
-- | Retrieve 3rd userdata field.
treeInner :: FragmentTree (a, b, c) -> c
treeInner :: forall a b c. FragmentTree (a, b, c) -> c
treeInner (Branch AncestorBox { boxUserData :: forall d. AncestorBox d -> d
boxUserData = (a
_, b
_, c
ret) } [FragmentTree (a, b, c)]
_) = c
ret
treeInner (Leaf Fragment { fragmentUserData :: forall d. Fragment d -> d
fragmentUserData = (a
_, b
_, c
ret) }) = c
ret
-- | Retrieve userdata field.
treeInner' :: FragmentTree a -> a
treeInner' :: forall a. FragmentTree a -> a
treeInner' (Branch AncestorBox a
self [FragmentTree a]
_) = forall d. AncestorBox d -> d
boxUserData AncestorBox a
self
treeInner' (Leaf Fragment a
self) = forall d. Fragment d -> d
fragmentUserData Fragment a
self

-- | Retrieve Harfbuzz data out of the tree extracted from Balkón.
glyphs :: FragmentTree x -> [(HB.GlyphInfo, HB.GlyphPos)]
glyphs :: forall x. FragmentTree x -> [(GlyphInfo, GlyphPos)]
glyphs (Branch AncestorBox x
_ [FragmentTree x]
_) = []
glyphs (Leaf Fragment x
self) = forall d. Fragment d -> [(GlyphInfo, GlyphPos)]
fragmentGlyphs Fragment x
self
-- | Retrieve the Unicode codepoints out of the tree extracted from Balkón.
codepoints :: FragmentTree x -> [Word32]
codepoints :: forall x. FragmentTree x -> [Word32]
codepoints FragmentTree x
self = forall a b. (a -> b) -> [a] -> [b]
map GlyphInfo -> Word32
HB.codepoint forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall x. FragmentTree x -> [(GlyphInfo, GlyphPos)]
glyphs FragmentTree x
self

------
--- Taken from Balkón
------
-- | Calculate the smallest rectangle that completely contains all the given
-- rectangles.
unions :: [Rect a] -> Rect a
unions [] = forall a. String -> a -> a
trace String
"No rects to union!" forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Rect a
Rect a
0 a
0 a
0 a
0
unions [Rect a]
rects = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall a. (Num a, Ord a) => Rect a -> Rect a -> Rect a
union [Rect a]
rects

-- | Calculate the smallest rectangle that completely contains the given two
-- rectangles.
--
-- The origin of the resulting rectangle will be the corner with the lowest
-- X coordinate and the highest Y coordinate, regardless of the origin of the
-- input rectangles.
union :: (Num a, Ord a) => Rect a -> Rect a -> Rect a
union :: forall a. (Num a, Ord a) => Rect a -> Rect a -> Rect a
union Rect a
a Rect a
b = forall a. a -> a -> a -> a -> Rect a
Rect a
x_low a
y_high a
dx (-a
dy) where
    x_low :: a
x_low = forall a. (Num a, Ord a) => Rect a -> a
x_min Rect a
a forall a. Ord a => a -> a -> a
`min` forall a. (Num a, Ord a) => Rect a -> a
x_min Rect a
b
    y_low :: a
y_low = forall a. (Num a, Ord a) => Rect a -> a
y_min Rect a
a forall a. Ord a => a -> a -> a
`min` forall a. (Num a, Ord a) => Rect a -> a
y_min Rect a
b
    x_high :: a
x_high = forall a. (Num a, Ord a) => Rect a -> a
x_max Rect a
a forall a. Ord a => a -> a -> a
`max` forall a. (Num a, Ord a) => Rect a -> a
x_max Rect a
b
    y_high :: a
y_high = forall a. (Num a, Ord a) => Rect a -> a
y_max Rect a
a forall a. Ord a => a -> a -> a
`max` forall a. (Num a, Ord a) => Rect a -> a
y_max Rect a
b
    dx :: a
dx = a
x_high forall a. Num a => a -> a -> a
- a
x_low
    dy :: a
dy = a
y_high forall a. Num a => a -> a -> a
- a
y_low