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
module Data.Text.ParagraphLayout.Internal.ParagraphLayout
(ParagraphLayout(..)
,appendFragments
,emptyParagraphLayout
,filterFragments
,mapFragments
,paragraphFragments
,paragraphLayout
,paragraphOriginX
,paragraphOriginY
,paragraphSpanBounds
,shapedRuns
)
where
import Data.Int (Int32)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Text.ParagraphLayout.Internal.Fragment
import Data.Text.ParagraphLayout.Internal.Paragraph
import Data.Text.ParagraphLayout.Internal.Rect
import Data.Text.ParagraphLayout.Internal.Span
-- | The resulting layout of the whole paragraph.
data ParagraphLayout = ParagraphLayout
{ paragraphRect :: Rect Int32
-- ^ The containing block (CSS3).
, spanLayouts :: [SpanLayout]
}
deriving (Eq, Read, Show)
-- | Calculate the offsets into the `Paragraph`'s underlying `Data.Text.Array`
-- where each span starts and ends, in ascending order. The resulting list
-- will be one larger than the list of input spans.
paragraphSpanBounds :: Paragraph -> NonEmpty Int
paragraphSpanBounds (Paragraph _ initialOffset spans _) =
NonEmpty.scanl (+) initialOffset (map spanLength spans)
paragraphOriginX :: (Num a) => a
paragraphOriginX = 0
paragraphOriginY :: (Num a) => a
paragraphOriginY = 0
empty :: (Num a) => Rect a
empty = Rect
{ x_origin = paragraphOriginX
, y_origin = paragraphOriginY
, x_size = 0
, y_size = 0
}
containRects :: (Ord a, Num a) => [Rect a] -> Rect a
containRects = foldr union empty
-- | Wrap the given `SpanLayout`s and compute their containing rectangle.
paragraphLayout :: [SpanLayout] -> ParagraphLayout
paragraphLayout sls = ParagraphLayout pRect sls
where pRect = containRects $ concat $ map spanRects sls
-- | A `ParagraphLayout` with an infinite number of empty spans.
-- Useful as an identity element for `appendFragments`.
emptyParagraphLayout :: ParagraphLayout
emptyParagraphLayout = ParagraphLayout empty $ repeat (SpanLayout [])
-- | Remove fragments that do not match the given predicate.
--
-- The containing rectangle will be recalculated.
filterFragments :: (Fragment -> Bool) -> ParagraphLayout -> ParagraphLayout
filterFragments fragPred (ParagraphLayout _ sls) = paragraphLayout sls'
where
sls' = map slMapFunc sls
slMapFunc (SpanLayout frags) = SpanLayout (filter fragPred frags)
-- | Run a mapping function over each fragment inside a `ParagraphLayout`.
--
-- The containing rectangle will be recalculated.
mapFragments :: (Fragment -> Fragment) -> ParagraphLayout -> ParagraphLayout
mapFragments fragMapFunc (ParagraphLayout _ sls) = paragraphLayout sls'
where
sls' = map slMapFunc sls
slMapFunc (SpanLayout frags) = SpanLayout (map fragMapFunc frags)
-- | Combine fragments from two `ParagraphLayout`s.
--
-- The containing rectangle will be recalculated.
appendFragments :: ParagraphLayout -> ParagraphLayout -> ParagraphLayout
appendFragments pla plb = paragraphLayout sls'
where
sls' = zipWith zipFunc slsa slsb
slsa = spanLayouts pla
slsb = spanLayouts plb
zipFunc (SpanLayout fa) (SpanLayout fb) = SpanLayout (fa ++ fb)
-- | Return all fragments of shaped text in one flat list,
-- discarding information about their associated spans.
paragraphFragments :: ParagraphLayout -> [Fragment]
paragraphFragments pl = concat $ map spanFragments $ spanLayouts pl
-- | Return all shaped runs in the paragraph.
shapedRuns :: ParagraphLayout -> [ShapedRun]
shapedRuns pl = map shapedRun $ paragraphFragments pl