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
-- | Splitting paragraph layouts between lines.
module Data.Text.ParagraphLayout.Internal.ParagraphLine
( GenericLayout
, cutLines
, mergeLines
)
where
import Data.Int (Int32)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Text.ParagraphLayout.Internal.Fragment
import qualified Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout as P
import qualified Data.Text.ParagraphLayout.Internal.Rich.ParagraphLayout as R
import Data.Text.ParagraphLayout.Internal.Rect
class GenericLayout pl where
-- | A layout with no content, to be used as an identity for appending.
empty :: pl
-- | Rectangle surrounding the layout, to be used for appending.
rect :: pl -> Rect Int32
-- | Actual distance between the paragraph origin and the nearest fragment.
topDistance :: pl -> Int32
-- | A list of all unique line numbers that have laid out content.
lineNumbers :: pl -> [Int]
-- | Keep only fragments with the given line number.
limitFragments :: Int -> pl -> pl
-- | Add @dy@ to each fragment's `y_origin`.
shiftFragments :: Int32 -> pl -> pl
-- | Combine fragments from two layouts into one,
-- without any adjustment of coordinates.
appendFragments :: pl -> pl -> pl
instance GenericLayout (P.ParagraphLayout d) where
empty = P.emptyParagraphLayout
rect = P.paragraphRect
topDistance pl = topFragmentOrigin $ P.paragraphFragments pl
lineNumbers pl = uniqueFragmentLines $ P.paragraphFragments pl
limitFragments n = P.filterFragments (fragmentIsOnLine n)
shiftFragments dy = P.mapFragments (shiftFragment dy)
appendFragments = P.appendFragments
instance GenericLayout (R.ParagraphLayout d) where
empty = R.emptyParagraphLayout
rect = R.paragraphRect
topDistance pl = topFragmentOrigin $ R.paragraphFragments pl
lineNumbers pl = uniqueFragmentLines $ R.paragraphFragments pl
limitFragments n = R.filterFragments (fragmentIsOnLine n)
shiftFragments dy = R.mapFragments (shiftFragment dy)
appendFragments = R.appendFragments
-- | Split the given paragraph layout into single-line layouts.
cutLines :: GenericLayout pl => pl -> [pl]
cutLines pl = map (\ n -> cutLine n pl) (lineNumbers pl)
-- | Reduce the given paragraph layout to fragments with the given line number.
cutLine :: GenericLayout pl => Int -> pl -> pl
cutLine n pl = trimTop $ limitFragments n pl
-- | Add a constant to each fragment's `y_origin` so that their maximum is zero.
trimTop :: GenericLayout pl => pl -> pl
trimTop pl = shiftFragments (-topDistance pl) pl
topFragmentOrigin :: [Fragment d] -> Int32
topFragmentOrigin frags = maximum $ map (y_origin . fragmentRect) frags
uniqueFragmentLines :: [Fragment d] -> [Int]
uniqueFragmentLines frags = dedupe $ map fragmentLine frags
-- | Remove duplicates from a sorted list.
dedupe :: Eq a => [a] -> [a]
dedupe xs = map NonEmpty.head $ NonEmpty.group xs
-- | Put the given paragraph layouts together as a vertically contiguous
-- sequence.
mergeLines :: GenericLayout pl => [pl] -> pl
mergeLines lls = foldl mergeLine empty lls
mergeLine :: GenericLayout pl => pl -> pl -> pl
mergeLine pl nextLine = pl'
where
-- Quadratic time complexity. TODO: Consider optimising.
pl' = appendFragments pl $ shiftFragments y nextLine
y = y_terminus $ rect pl
shiftFragment :: Int32 -> Fragment d -> Fragment d
shiftFragment dy f = f'
where
f' = f { fragmentRect = r' }
r' = r { y_origin = y_origin r + dy }
r = fragmentRect f
fragmentIsOnLine :: Int -> Fragment d -> Bool
fragmentIsOnLine n frag = n == fragmentLine frag