~jaro/balkon

ref: 85383d46341222037bb8fa91204a8349b158011e balkon/src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs -rw-r--r-- 3.8 KiB
85383d46Jaro Test struts in textless box. 1 year, 4 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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
-- | Splitting paragraph layouts between lines.
module Data.Text.ParagraphLayout.Internal.ParagraphLine
    ( GenericLayout
    , cutLines
    , mergeLines
    , forceLeftAlign
    )
where

import Data.Int (Int32)

import Data.Text.ParagraphLayout.Internal.Fragment
import Data.Text.ParagraphLayout.Internal.LineNumbers
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
    -- on the Y axis.
    topDistance :: pl -> Int32

    -- | Actual distance between the paragraph origin and the nearest fragment
    -- on the X axis.
    leftDistance :: pl -> Int32

    -- | Keep only fragments with the given line number.
    limitFragments :: Int -> pl -> pl

    -- | Shift all contents of the paragraph by @dx, dy@.
    shiftContents :: Int32 -> Int32 -> pl -> pl

    -- | Combine contents from two layouts into one,
    -- without any adjustment of coordinates.
    appendContents :: pl -> pl -> pl

instance GenericLayout (P.ParagraphLayout d) where
    empty = P.emptyParagraphLayout
    rect = P.paragraphRect
    topDistance pl = topFragmentOrigin $ P.paragraphFragments pl
    leftDistance pl = leftmostFragmentOrigin $ P.paragraphFragments pl
    limitFragments n = P.filterFragments (fragmentIsOnLine n)
    shiftContents dx dy = P.mapFragments (shiftFragment dx dy)
    appendContents = P.appendFragments

instance GenericLayout (R.ParagraphLayout d) where
    empty = R.emptyParagraphLayout
    rect = R.paragraphRect
    topDistance = R.topDistance
    leftDistance pl = leftmostFragmentOrigin $ R.paragraphFragments pl
    limitFragments n = R.filterLine n
    shiftContents dx dy = R.shiftContents dx dy
    appendContents = R.appendContents

-- | Split the given paragraph layout into single-line layouts.
cutLines :: (GenericLayout pl, LineNumbers 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 = shiftContents 0 (-topDistance pl) pl

-- | Add a constant to each fragment's `x_origin` so that their minimum is zero.
trimLeft :: GenericLayout pl => pl -> pl
trimLeft pl = shiftContents (-leftDistance pl) 0 pl

topFragmentOrigin :: [Fragment d] -> Int32
topFragmentOrigin frags = maximum $ map (y_origin . fragmentRect) frags

leftmostFragmentOrigin :: [Fragment d] -> Int32
leftmostFragmentOrigin frags = minimum $ map (x_origin . fragmentRect) frags

-- | 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' = appendContents pl $ shiftContents 0 y nextLine
        y = y_terminus $ rect pl

fragmentIsOnLine :: Int -> Fragment d -> Bool
fragmentIsOnLine n frag = n == fragmentLine frag

-- | Rearrange fragments on each line so that they are stacked from the left.
--
-- Intended for comparing paragraph layouts of different maximum widths.
forceLeftAlign :: (GenericLayout pl, LineNumbers pl) => pl -> pl
forceLeftAlign pl = mergeLines $ map trimLeft $ cutLines pl