~jaro/balkon

balkon/src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs -rw-r--r-- 5.7 KiB
9e3b0ec7Jaro Set release date for v1.3.0.0. 1 year, 4 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
module Data.Text.ParagraphLayout.Internal.VerticalOffsets
    ( VerticalOffsets (..)
    , alignBaseline
    , fromText
    , strutted
    , underBox
    , underRoot
    )
where

import Data.Int (Int32)
import Data.List.NonEmpty (NonEmpty ((:|)), (<|))
import Data.Maybe (fromMaybe)
import Data.Text.Glyphize (ascender, descender, fontExtentsForDir)

import Data.Text.ParagraphLayout.Internal.BoxOptions
import Data.Text.ParagraphLayout.Internal.LineHeight
import Data.Text.ParagraphLayout.Internal.ResolvedBox
import Data.Text.ParagraphLayout.Internal.TextOptions

-- | Metrics used for vertical alignment of text fragments.
data VerticalOffsets = VerticalOffsets

    { layoutTop :: Int32
    -- ^ Y coordinate of the top edge of the fragment,
    -- including half-leading.

    , fontTop :: Int32
    -- ^ Y coordinate of the font's ascender.

    , baseline :: Int32
    -- ^ Y coordinate of the font's baseline.

    , fontBottom :: Int32
    -- ^ Y coordinate of the font's descender.

    , layoutBottom :: Int32
    -- ^ Y coordinate of the bottom edge of the fragment,
    -- including half-leading.

    }
    deriving (Eq, Show)

-- | Add a constant to each of the coordinates, effectively moving them
-- up by the given amount while preserving distances between them.
shift :: Int32 -> VerticalOffsets -> VerticalOffsets
shift d vo = vo
    { layoutTop = layoutTop vo + d
    , fontTop = fontTop vo + d
    , baseline = baseline vo + d
    , fontBottom = fontBottom vo + d
    , layoutBottom = layoutBottom vo + d
    }

-- | Set `baseline` to the given value and update all other coordinates
-- so that distances are preserved.
alignBaseline :: Int32 -> VerticalOffsets -> VerticalOffsets
alignBaseline x vo = shift (x - baseline vo) vo

-- | Metrics calculated for a single text box, as if it existed alone
-- with its baseline at @0@.
fromText :: TextOptions -> VerticalOffsets
fromText opts = VerticalOffsets
    { layoutTop = ascent + topHalfLeading
    , fontTop = ascent
    , baseline = 0
    , fontBottom = - descent
    , layoutBottom = - descent - bottomHalfLeading
    }
    where
        -- non-negative leading values iff `lineHeight` > `normalLineHeight`
        leading = lineHeight - normalLineHeight
        topHalfLeading = -((-leading) `div` 2)
        bottomHalfLeading = leading `div` 2
        -- `normalLineHeight` > 0 for horizontal fonts
        normalLineHeight = ascent + descent
        -- `ascent` >= 0 for horizontal fonts
        ascent = ascender extents `fromMaybe` textAscender opts
        -- `descent` >= 0 for horizontal fonts
        descent = - (descender extents `fromMaybe` textDescender opts)
        extents = fontExtentsForDir (textFont opts) (Just dir)
        -- Actual shaped text direction may differ from the direction set in
        -- `TextOptions` (for example RTL characters in a LTR box), but
        -- HarfBuzz only distinguished horizontal and vertical extents,
        -- so this should make no difference.
        dir = textDirection opts
        lineHeight = case textLineHeight opts of
            Normal -> normalLineHeight
            Absolute h -> h

-- | Metrics for a nested text fragment, with a defined relation either to
-- the root box or to a box with line-relative alignment.
type NestedVerticalOffsets d = (Maybe (ResolvedBox d), VerticalOffsets)

-- | Test whether the given `NestedVerticalOffsets` are defined relative to
-- the root box.
underRoot :: NestedVerticalOffsets d -> Bool
underRoot (Nothing, _) = True
underRoot (Just _, _) = False

-- | Test whether the given `NestedVerticalOffsets` are defined relative to
-- the given box.
--
-- (Note that boxes are compared internally using `boxIndex`, and should
-- therefore only be compared with boxes created from the same input.)
underBox :: ResolvedBox d -> NestedVerticalOffsets d -> Bool
underBox _ (Nothing, _) = False
underBox b (Just x, _) = b == x

-- | Metrics calculated for a text box nested within zero or more boxes.
--
-- Vertical offsets will be recursively adjusted using the ancestor boxes'
-- properties, stopping once a box with line-relative alignment is reached,
-- if there is one.
--
-- If recursion ends at the root, this function returns @(`Nothing`, vo)@,
-- where @vo@ is calculated such that the root baseline is at @0@.
--
-- If recursion ends at a box with line-relative alignment, this function
-- returns @(`Just` b, vo)@, where @b@ is the box where recursion stopped
-- (root of the /aligned subtree/ in CSS terminology), and @vo@ is calculated
-- such that the baseline of @b@ is at @0@.
--
-- Note: The font extents are calculated using the same direction for the whole
--       ancestry path regardless of the actual direction of these boxes, but
--       this should not matter for text that is only horizontal.
fromNestedText :: TextOptions -> [ResolvedBox d] -> NestedVerticalOffsets d
fromNestedText opts boxes = case boxes of
    [] -> -- Inline content directly in the root box.
        (Nothing, vo)
    (b : bs) -> case boxVerticalAlignment $ boxOptions b of
        AlignLineTop -> (Just b, vo)
        AlignLineBottom -> (Just b, vo)
        AlignBaseline offset ->
            let parentOpts = boxParentTextOptions b
                (anchor, parentVO) = fromNestedText parentOpts bs
            in (anchor, alignBaseline (baseline parentVO + offset) vo)
    where
        vo = fromText opts

-- | Metrics calculated for a text box nested within zero or more boxes,
-- plus metrics for each of its ancestor boxes, which can be used as struts
-- on lines where these boxes do not directly contain any text.
strutted :: TextOptions -> [ResolvedBox d] -> NonEmpty (NestedVerticalOffsets d)
strutted opts [] =
    fromNestedText opts [] :| []
strutted opts boxes@(b : bs) =
    fromNestedText opts boxes <| strutted (boxParentTextOptions b) bs