~jaro/balkon

ref: 03d36342529a318aa40fa9da94e8555e2f2017d5 balkon/src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs -rw-r--r-- 3.5 KiB
03d36342Jaro Implement Rich pagination. 1 year, 13 days 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
-- | Splitting paragraph layouts between lines.
module Data.Text.ParagraphLayout.Internal.ParagraphLine
    ( 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 `ParagraphLayout` into single-line layouts.
cutLines :: GenericLayout pl => pl -> [pl]
cutLines pl = map (\ n -> cutLine n pl) (lineNumbers pl)

-- | Reduce the given `ParagraphLayout` 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 `ParagraphLayout`s 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