~jaro/balkon

ref: 4bd95db2a46001cccd030584d3de570b5e9366fa balkon/src/Data/Text/ParagraphLayout/Plain.hs -rw-r--r-- 7.5 KiB
4bd95db2Jaro Clean up ParagraphConstruction. 1 year, 8 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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
-- | Shaping for a paragraph of plain, unidirectional text using a single font.
--
-- The input text must be encoded as UTF-8 in a contiguous byte array.
--
-- Positions and distances are represented as 32-bit integers. Their unit must
-- be defined by the caller, who must calculate the desired dimensions of the
-- EM square of the input font and set them using @hb_font_set_scale()@. For
-- example, if @1em = 20px@, if the output pixels are square, and if the output
-- coordinates are in 1/64ths of a pixel, you should set both the @x_scale@ and
-- the @y_scale@ to @1280@.
module Data.Text.ParagraphLayout.Plain
    (LineHeight(..)
    ,Paragraph(..)
    ,ParagraphLayout(..)
    ,ParagraphOptions(..)
    ,Rect(..)
    ,Span(..)
    ,SpanLayout(..)
    ,layoutPlain
    )
where

import Data.Int (Int32)
import Data.List (mapAccumL)
import Data.Text.Array (Array)
import Data.Text.Foreign (I8)
import Data.Text.Glyphize
    (Buffer(..)
    ,ContentType(ContentTypeUnicode)
    ,Font
    ,GlyphInfo
    ,GlyphPos(x_advance, y_advance)
    ,defaultBuffer
    ,shape
    )
import Data.Text.Internal (Text(Text))
import qualified Data.Text.Internal.Lazy as Lazy

import Data.Text.ParagraphLayout.Rect
import qualified Data.Text.ParagraphLayout.ResolvedSpan as RS
import Data.Text.ParagraphLayout.Run
import Data.Text.ParagraphLayout.Span

-- | Text to be laid out as a paragraph.
--
-- May be divided into any number of neighbouring spans, each of which will
-- have its own layout rectangle(s) calculated.
data Paragraph = Paragraph

    Array
    -- ^ A byte array containing the whole text to be laid out, in UTF-8.

    I8
    -- ^ Byte offset of the first span.
    -- Any characters preceding this offset will not be shaped, but may still
    -- be used to influence the shape of neighbouring characters.

    [Span]
    -- ^ Parts of the text to be laid out, in logical order.
    -- The offset plus total length of all spans must not exceed array bounds.
    -- Any characters following the last span will not be shaped, but may still
    -- be used to influence the shape of neighbouring characters.

    ParagraphOptions
    -- ^ Properties applying to the paragraph as a whole.

data ParagraphOptions = ParagraphOptions
    { paragraphFont :: Font
    , paragraphLineHeight :: LineHeight
    , paragraphMaxWidth :: Int32
    }

data LineHeight

    = Absolute Int32
    -- ^ Set line height independently of the font.

    | Relative Float
    -- ^ Set line height as a multiplier of the font's built-in value.

-- | The resulting layout of the whole paragraph.
data ParagraphLayout = ParagraphLayout
    { paragraphRect :: Rect Int32
    , spanLayouts :: [SpanLayout]
    }
    deriving (Eq, Read, Show)

-- | The resulting layout of each span, which may include multiple bounding
-- boxes if broken over multiple lines.
data SpanLayout = SpanLayout [Box]
    deriving (Eq, Read, Show)

type Box =
    ( Rect Int32
    -- ^ Rectangle containing all glyph advances in this box. This is the space
    -- that the glyphs "take up" and is probably what you want to use for
    -- detecting position-based events such as mouse clicks.
    --
    -- Beware that actual glyphs will not be drawn exactly to the borders of
    -- this rectangle -- they may be offset inwards and they can also extend
    -- outwards!
    --
    -- These are not the typographic bounding boxes that you use for determining
    -- the area to draw on -- you need FreeType or a similar library for that.
    --
    -- The origin coordinates are relative to the paragraph.
    --
    -- The sizes can be positive or negative, depending on the text direction.
    --
    -- X coordinates increase from left to right.
    -- Y coordinates increase from bottom to top.
    , [(GlyphInfo, GlyphPos)]
    )

boxRect :: Box -> Rect Int32
boxRect = fst

spanRects :: SpanLayout -> [Rect Int32]
spanRects (SpanLayout boxes) = map boxRect boxes

base :: (Num a) => Rect a
base = Rect 0 0 0 0

containRects :: (Ord a, Num a) => [Rect a] -> Rect a
containRects = foldr union base

containGlyphs :: [GlyphPos] -> Rect Int32
containGlyphs ps = Rect
    { x_origin = 0
    , y_origin = 0
    , x_size = sum $ map x_advance ps
    , y_size = sum $ map y_advance ps -- TODO add line height
    }

-- | Interface for basic plain text layout.
--
-- The entire paragraph will be assumed to have the same text direction and
-- will be shaped using a single font, aligned to the left for LTR text or to
-- the right for RTL text.
layoutPlain :: Paragraph -> ParagraphLayout
layoutPlain paragraph = ParagraphLayout pRect arrangedLayouts
    where
        pRect = containRects allRects
        allRects = concat $ map spanRects arrangedLayouts
        arrangedLayouts = snd $ arrangeSpansH 0 $ layouts
        layouts = map layoutSpan spans
        spans = resolveSpans paragraph

-- TODO: Break lines.
-- TODO: Allow a run across multiple spans (e.g. if they only differ by colour).
layoutSpan :: RS.ResolvedSpan -> SpanLayout
layoutSpan rs = SpanLayout (map layoutRun $ spanToRuns rs)

layoutRun :: Run -> Box
layoutRun run = (rect, glyphs)
    where
        rs = runOriginalSpan run
        rect = containGlyphs $ map snd $ glyphs
        glyphs = shape font buffer features
        font = RS.spanFont rs
        -- TODO: Set beginsText / endsText.
        buffer = defaultBuffer
            { text = fromStrict $ runText run
            , contentType = Just ContentTypeUnicode
            , direction = runDirection run
            , script = runScript run
            , language = Just $ RS.spanLanguage rs
            }
        features = []

resolveSpans :: Paragraph -> [RS.ResolvedSpan]
resolveSpans (Paragraph arr off spans opts) = map resolve $ zip spans texts
    where
        resolve (s, t) = RS.ResolvedSpan
            { RS.spanText = t
            , RS.spanFont = paragraphFont opts
            , RS.spanLanguage = spanLanguage s
            }
        texts = cuts arr off spans

-- | Produce a list of `Text`s, defined by an initial offset and a list of
-- consecutive `Span`s, out of the underlying `Array`.
--
-- TODO: Consider adding checks for array bounds.
cuts :: Array -> I8 -> [Span] -> [Text]
cuts arr initialOffset spans = snd $ mapAccumL (cut arr) initialOffset spans

-- | Produce a `Text`, defined by an initial offset and a `Span`, out of the
-- underlying `Array`.
cut :: Array -> I8 -> Span -> (I8, Text)
cut arr off s = (end, t)
    where
        len = spanLength s
        end = off + len
        t = Text arr (fromIntegral off) (fromIntegral len)

-- | Arrange all boxes in multiple spans in one horizontal direction
-- and return the final x_offset for continuation.
arrangeSpansH :: Int32 -> [SpanLayout] -> (Int32, [SpanLayout])
arrangeSpansH currentX sls = mapAccumL arrangeSpanH currentX sls

-- | Arrange all boxes in one span in one horizontal direction
-- and return the final x_offset for continuation.
arrangeSpanH :: Int32 -> SpanLayout -> (Int32, SpanLayout)
arrangeSpanH currentX (SpanLayout boxes) = (nextX, SpanLayout newBoxes)
    where (nextX, newBoxes) = arrangeBoxesH currentX boxes

-- | Arrange boxes in one horizontal direction
-- and return the final x_offset for continuation.
arrangeBoxesH :: Int32 -> [Box] -> (Int32, [Box])
arrangeBoxesH currentX boxes = mapAccumL arrangeBoxH currentX boxes

-- | Set the horizontal offset of the given box
-- and return the x coordinate of its other side for continuation.
arrangeBoxH :: Int32 -> Box -> (Int32, Box)
arrangeBoxH currentX (rect, glyphs) = (nextX, (newRect, glyphs))
    where
        nextX = currentX + x_size rect
        newRect = rect { x_origin = currentX }

fromStrict :: Text -> Lazy.Text
fromStrict t = Lazy.Chunk t Lazy.Empty