~jaro/balkon

ref: bf8d44a7375b24b541dc3b11827749c5b1091762 balkon/src/Data/Text/ParagraphLayout/Internal/Plain.hs -rw-r--r-- 3.1 KiB
bf8d44a7Jaro Deprecate ParagraphConstruction. 1 year, 20 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
module Data.Text.ParagraphLayout.Internal.Plain (layoutPlain)
where

import Control.Applicative (ZipList (ZipList), getZipList)
import Data.List.NonEmpty (nonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Text (Text)
import Data.Text.ICU (Breaker, LocaleName, breakCharacter, breakLine)

import Data.Text.ParagraphLayout.Internal.Break
import Data.Text.ParagraphLayout.Internal.Layout
import Data.Text.ParagraphLayout.Internal.ParagraphOptions
import Data.Text.ParagraphLayout.Internal.Plain.Paragraph
import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout
import Data.Text.ParagraphLayout.Internal.ResolvedSpan (WithSpan (WithSpan))
import qualified Data.Text.ParagraphLayout.Internal.ResolvedSpan as RS
import Data.Text.ParagraphLayout.Internal.Run
import Data.Text.ParagraphLayout.Internal.Span
import Data.Text.ParagraphLayout.Internal.TextOptions

-- | Lay out a paragraph of plain, unidirectional text using a single font.
layoutPlain :: Paragraph d -> ParagraphLayout d
layoutPlain p@(Paragraph _ _ _ opts) = paragraphLayout sls
    where
        sls = map SpanLayout fragsBySpan
        fragsBySpan = take (length spans) $ RS.splitBySpanIndex frags
        frags = case nonEmpty wrappedRuns of
            Just xs -> layoutAndAlignLines maxWidth xs
            Nothing -> []
        wrappedRuns = spansToRunsWrapped spans
        maxWidth = paragraphMaxWidth opts
        spans = resolveSpans p

-- | Split a number of spans into a flat array of runs and add a wrapper
-- so that each run can be traced back to its originating span.
spansToRunsWrapped :: [RS.ResolvedSpan d] -> [WithSpan d Run]
spansToRunsWrapped ss = concat $ map spanToRunsWrapped ss

-- | Split a span into runs and add a wrapper
-- so that each run can be traced back to its originating span.
spanToRunsWrapped :: RS.ResolvedSpan d -> [WithSpan d Run]
spanToRunsWrapped s = map (WithSpan s) (spanToRuns s)

resolveSpans :: Paragraph d -> [RS.ResolvedSpan d]
resolveSpans p@(Paragraph _ pStart spans pOpts) = do
    let sBounds = paragraphSpanBounds p
    let sTexts = paragraphSpanTexts p
    let pText = paragraphText p
    let sStarts = NonEmpty.init sBounds

    (i, s, sStart, sText) <- getZipList $ (,,,)
        <$> ZipList [0 ..]
        <*> ZipList spans
        <*> ZipList sStarts
        <*> ZipList sTexts
    let lang = spanLanguage $ spanOptions s
    let lBreaks = paragraphBreaks breakLine pText lang
    let cBreaks = paragraphBreaks breakCharacter pText lang
    return RS.ResolvedSpan
        { RS.spanUserData = spanUserData s
        , RS.spanIndex = i
        , RS.spanOffsetInParagraph = sStart - pStart
        , RS.spanText = sText
        , RS.spanTextOptions = defaultTextOptions
            { textFont = paragraphFont pOpts
            , textLineHeight = paragraphLineHeight pOpts
            , textLanguage = lang
            }
        , RS.spanLineBreaks = subOffsetsDesc (sStart - pStart) lBreaks
        , RS.spanCharacterBreaks = subOffsetsDesc (sStart - pStart) cBreaks
        }

paragraphBreaks :: (LocaleName -> Breaker a) -> Text -> String -> [(Int, a)]
paragraphBreaks breakFunc txt lang =
    breaksDesc (breakFunc (locale lang LBAuto)) txt