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
104
105
106
107
108
109
110
111
112
113
114
115
116
module Data.Text.ParagraphLayout.Run (Run(..), spanToRuns)
where
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Text (Text)
import Data.Text.Glyphize (Direction(..))
import qualified Data.Text.ICU.Char as ICUChar
import Data.Text.Script (charScript)
import Data.Text.Zipper
import Data.Text.ParagraphLayout.ResolvedSpan
import Data.Text.ParagraphLayout.TextContainer
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
}
deriving (Eq, Show)
instance TextContainer Run where
getText = runText
setText t r = r { runText = t }
type ProtoRun = (Zipper, Maybe Direction, ScriptCode)
-- Represents a zipper that can advance by at least one character.
data ZipperChoice = ZipperChoice
{ nextChar :: Char
, continuingRun :: Zipper
-- ^ The zipper will advance over the next character,
-- merging it with all preceding characters.
, startingNewRun :: Zipper
-- ^ The zipper will forget all preceding characters and then advance over
-- the next character, making it the first character in a new run of text.
}
considerNext :: Zipper -> Maybe ZipperChoice
considerNext z = case next z of
Nothing -> Nothing
Just c -> Just ZipperChoice
{ nextChar = c
, continuingRun = step z
, startingNewRun = step $ start $ following z
}
data Merged a = Incompatible | Merged a
spanToRuns :: ResolvedSpan -> [Run]
spanToRuns s = map run $ protoRuns zipper
where
zipper = start $ spanText s
run (z, d, sc) = Run
{ runText = preceding z
, runDirection = d
, runScript = Just sc
}
protoRuns :: Zipper -> [ProtoRun]
protoRuns z = reverse $ protoRuns' z []
protoRuns' :: Zipper -> [ProtoRun] -> [ProtoRun]
protoRuns' curZipper curRuns = case considerNext curZipper of
Nothing -> curRuns
Just choice ->
let headRun@(nextZipper, _, _) :| tailRuns = foldRun choice curRuns
in protoRuns' nextZipper (headRun:tailRuns)
foldRun :: ZipperChoice -> [ProtoRun] -> NonEmpty ProtoRun
-- If there are no runs, create a new run with a single character.
foldRun x [] = (continuingRun x, d, s) :| []
where
d = charDirection (nextChar x)
s = charScript (nextChar x)
foldRun x (previousRun@(_, d1, s1) : tailRuns) =
case (mergeDirections d1 d2, mergeScripts s1 s2) of
(Merged d, Merged s) -> (continuingRun x, d, s) :| tailRuns
_ -> (startingNewRun x, d2, s2) :| previousRun : tailRuns
where
d2 = charDirection (nextChar x)
s2 = charScript (nextChar x)
-- 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