~jaro/balkon

ref: f72b5805e6f857d963bf025d464a86a80b9374b1 balkon/src/Data/Text/ParagraphLayout/Internal/Plain/ParagraphLayout.hs -rw-r--r-- 2.9 KiB
f72b5805Jaro Add stress test for Heisenbug hunting. 1 year, 5 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
module Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout
    ( ParagraphLayout (..)
    , appendFragments
    , emptyParagraphLayout
    , filterFragments
    , mapFragments
    , paragraphFragments
    , paragraphLayout
    , shapedRuns
    )
where

import Data.Int (Int32)

import Data.Text.ParagraphLayout.Internal.Fragment
import Data.Text.ParagraphLayout.Internal.LinePagination
import Data.Text.ParagraphLayout.Internal.ParagraphExtents
import Data.Text.ParagraphLayout.Internal.Rect
import Data.Text.ParagraphLayout.Internal.Span

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

instance Line (ParagraphLayout d) where
    lineHeight pl = height $ paragraphRect pl

-- | Wrap the given `SpanLayout`s and compute their containing rectangle.
paragraphLayout :: [SpanLayout d] -> ParagraphLayout d
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 d
emptyParagraphLayout = ParagraphLayout emptyRect $ repeat (SpanLayout [])

-- | Remove fragments that do not match the given predicate.
--
-- The containing rectangle will be recalculated.
filterFragments :: (Fragment d -> Bool) -> ParagraphLayout d ->
    ParagraphLayout d
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 d -> Fragment d) -> ParagraphLayout d ->
    ParagraphLayout d
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 d -> ParagraphLayout d -> ParagraphLayout d
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 d -> [Fragment d]
paragraphFragments pl = concat $ map spanFragments $ spanLayouts pl

-- | Return all shaped runs in the paragraph.
shapedRuns :: ParagraphLayout d -> [ShapedRun]
shapedRuns pl = map shapedRun $ paragraphFragments pl