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
module Data.Text.ParagraphLayout.Internal.Rich (layoutRich)
where
import Control.Applicative (ZipList (ZipList), getZipList)
import Data.List.NonEmpty (nonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.ICU (Breaker, LocaleName, breakCharacter, breakLine)
import Data.Text.ParagraphLayout.Internal.BiDiLevels
import Data.Text.ParagraphLayout.Internal.Break
import Data.Text.ParagraphLayout.Internal.Fragment
import Data.Text.ParagraphLayout.Internal.Layout
import Data.Text.ParagraphLayout.Internal.Line
import Data.Text.ParagraphLayout.Internal.ParagraphExtents
import Data.Text.ParagraphLayout.Internal.ParagraphOptions
import Data.Text.ParagraphLayout.Internal.Rect
import qualified Data.Text.ParagraphLayout.Internal.ResolvedSpan as RS
import Data.Text.ParagraphLayout.Internal.Rich.Paragraph
import Data.Text.ParagraphLayout.Internal.Rich.ParagraphLayout
import Data.Text.ParagraphLayout.Internal.Run
import Data.Text.ParagraphLayout.Internal.TextOptions
import Data.Text.ParagraphLayout.Internal.Tree
import Data.Text.ParagraphLayout.Internal.WithSpan
-- | Lay out a rich text paragraph.
layoutRich :: Paragraph d -> ParagraphLayout d
layoutRich p = ParagraphLayout pRect stretchedLines unwrappedFrags
where
Paragraph _ _ root opts = p
RootBox (Box _ rootTextOpts) = root
pRect = containRects $ map lineRect stretchedLines
stretchedLines = map stretchLine ls
stretchLine l = l { lineRect = stretchRect (lineRect l) }
stretchRect r = r
{ x_origin = x_origin containingRect
, x_size = x_size containingRect
}
containingRect = containRects $ map fragmentSpacedRect unwrappedFrags
unwrappedFrags = map unwrap frags
unwrap (WithSpan rs frag) =
frag { fragmentUserData = RS.spanUserData rs }
(frags, ls) = case nonEmpty wrappedRuns of
Just xs -> layoutAndAlignLines dir align maxWidth xs
Nothing -> ([], [])
wrappedRuns = spansToRunsWrapped spans
-- TODO: To support @unicode-bidi: plaintext@ as in CSS, allow ignoring
-- the text direction of the root box, and instead use the BiDi
-- rules P2 and P3 to determine the base directionality, which
-- may differ between lines.
dir = textDirection rootTextOpts
align = paragraphAlignment opts
maxWidth = paragraphMaxWidth opts
spans = resolveSpans p
-- | Split a number of spans into a flat array of runs and add a wrapper
-- so that each run can be traced back to its originating span.
spansToRunsWrapped :: [RS.ResolvedSpan d] -> [WithSpan d Run]
spansToRunsWrapped ss = concat $ map spanToRunsWrapped ss
-- | Split a span into runs and add a wrapper
-- so that each run can be traced back to its originating span.
spanToRunsWrapped :: RS.ResolvedSpan d -> [WithSpan d Run]
spanToRunsWrapped s = map (WithSpan s) (spanToRuns s)
resolveSpans :: Paragraph d -> [RS.ResolvedSpan d]
resolveSpans p = do
let Paragraph _ pStart root _ = p
let RootBox (Box _ rootTextOpts) = root
let leaves = flatten root
let sTexts = paragraphSpanTexts p
let sBounds = paragraphSpanBounds p
let sStarts = NonEmpty.init sBounds
let pText = paragraphText p
(i, leaf, sStart, sText) <- getZipList $ (,,,)
<$> ZipList [0 ..]
<*> ZipList leaves
<*> ZipList sStarts
<*> ZipList sTexts
let (TextLeaf userData _ textOpts boxes) = leaf
let lang = textLanguage textOpts
-- TODO: Allow BiDi embedding/isolation for inner nodes.
let pLevels = textLevels (textDirection rootTextOpts) pText
let lBreaks = paragraphBreaksDesc breakLine pText lang
let cBreaks = paragraphBreaksDesc breakCharacter pText lang
-- TODO: Optimise. This has time complexity O(n*s), where n is number of
-- characters and s is number of resolved spans.
-- Maybe include byte offsets in the TextLevels data structure?
let pPrefixLen = Text.length $ paragraphPrefix p sStart
return RS.ResolvedSpan
{ RS.spanUserData = userData
, RS.spanIndex = i
, RS.spanOffsetInParagraph = sStart - pStart
-- TODO: Consider adding checks for array bounds.
, RS.spanText = sText
, RS.spanTextOptions = textOpts
, RS.spanBoxes = boxes
, RS.spanBiDiLevels = dropLevels pPrefixLen pLevels
, RS.spanLineBreaks = subOffsetsDesc (sStart - pStart) lBreaks
, RS.spanCharacterBreaks = subOffsetsDesc (sStart - pStart) cBreaks
}
paragraphBreaksDesc :: (LocaleName -> Breaker a) -> Text -> String -> [(Int, a)]
paragraphBreaksDesc breakFunc txt lang =
-- Workaround: We are interested in the type of the end-of-text break
-- (if it is hard, that line needs to be always visible),
-- but `breaksDesc` does not provide it.
--
-- TODO: Consider optimising by creating a custom reimplementation
-- of `Data.Text.ICU.breaksRight`.
reverse $ breaksAsc (breakFunc (locale lang LBAuto)) txt