~jaro/balkon

ref: ff1079899e99faf229e747c333f34b5be822877c balkon/src/Data/Text/ParagraphLayout/Run.hs -rw-r--r-- 2.7 KiB
ff107989Jaro Add unit tests for spanToRuns. 1 year, 9 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
module Data.Text.ParagraphLayout.Run (Run(..), spanToRuns)
where

import Data.Text.Glyphize (Direction(..))
import qualified Data.Text.ICU.Char as ICUChar
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as Text
import Data.Text.Script (charScript)

import Data.Text.ParagraphLayout.Span

type ScriptCode = String

-- Each span can be broken into one or more runs by Balkón.
--
-- Each run could have a different script, language, or direction.
--
data Run = Run
    { runText :: Text
    , runDirection :: Maybe Direction
    , runScript :: Maybe ScriptCode
    , runOriginalSpan :: Span
    }
    deriving (Eq, Show)

type ProtoRun = (String, Maybe Direction, ScriptCode)

data Merged a = Incompatible | Merged a

-- TODO: Optimise and preserve the Data.Text.Lazy structure.
spanToRuns :: Span -> [Run]
spanToRuns s = map run $ protoRuns chars
    where
        chars = reverse $ Text.unpack $ spanText s
        run (t, d, sc) = Run
            { runText = Text.pack t
            , runDirection = d
            , runScript = Just sc
            , runOriginalSpan = s
            }

-- TODO: Try to avoid reversing.
protoRuns :: [Char] -> [ProtoRun]
protoRuns = reverse . map (\(t, d, s) -> (reverse t, d, s)) . foldr foldRun []

foldRun :: Char -> [ProtoRun] -> [ProtoRun]
foldRun c [] =
    -- If there are no runs, create a new run with a single character.
    [([c], charDirection c, charScript c)]
foldRun c (r@(oldString, d1, s1):rs) =
    case (mergeDirections d1 d2, mergeScripts s1 s2) of
        -- If direction & script are compatible, add to existing run.
        (Merged d, Merged s) -> ((c:oldString, d, s):rs)
        -- Otherwise create a new run.
        _ -> (([c], d2, s2):r:rs)
    where
        d2 = charDirection c
        s2 = charScript c

-- Simplified detection of text direction for unidirectional text.
mergeDirections :: Maybe Direction -> Maybe Direction -> Merged (Maybe Direction)
mergeDirections Nothing Nothing = Merged Nothing
mergeDirections (Just d1) Nothing = Merged (Just d1)
mergeDirections Nothing (Just d2) = Merged (Just d2)
mergeDirections (Just d1) (Just d2)
    | d1 == d2 = Merged (Just d1)
    | otherwise = Incompatible

-- TODO: Implement proper inheritance rules.
mergeScripts :: ScriptCode -> ScriptCode -> Merged ScriptCode
mergeScripts "Zyyy" s2 = Merged s2
mergeScripts s1 "Zyyy" = Merged s1
mergeScripts s1 "Zinh" = Merged s1
mergeScripts s1 s2
    | s1 == s2 = Merged s1
    | otherwise = Incompatible

-- TODO: Use the BiDi algorithm to support bidirectional text.
charDirection :: Char -> Maybe Direction
charDirection c = case ICUChar.direction c of
    ICUChar.LeftToRight -> Just DirLTR
    ICUChar.RightToLeft -> Just DirRTL
    ICUChar.RightToLeftArabic -> Just DirRTL
    _ -> Nothing