4 files changed, 229 insertions(+), 0 deletions(-)

M balkon.cabal
A src/Data/Text/ParagraphLayout/Internal/Rich.hs
A src/Data/Text/ParagraphLayout/Internal/Rich/Paragraph.hs
A src/Data/Text/ParagraphLayout/Internal/Rich/ParagraphLayout.hs

@@ 115,6 115,9 @@ library balkon-internal
         Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout,
         Data.Text.ParagraphLayout.Internal.Rect,
         Data.Text.ParagraphLayout.Internal.ResolvedSpan,
+        Data.Text.ParagraphLayout.Internal.Rich,
+        Data.Text.ParagraphLayout.Internal.Rich.Paragraph,
+        Data.Text.ParagraphLayout.Internal.Rich.ParagraphLayout,
         Data.Text.ParagraphLayout.Internal.Run,
         Data.Text.ParagraphLayout.Internal.Span,
         Data.Text.ParagraphLayout.Internal.TextContainer,

@@ 0,0 1,75 @@
+module Data.Text.ParagraphLayout.Internal.Rich (layoutRich)
+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.Fragment
+import Data.Text.ParagraphLayout.Internal.Layout
+import Data.Text.ParagraphLayout.Internal.ParagraphOptions
+import Data.Text.ParagraphLayout.Internal.ResolvedSpan (WithSpan (WithSpan))
+import qualified Data.Text.ParagraphLayout.Internal.ResolvedSpan as RS
+import Data.Text.ParagraphLayout.Internal.Rich.Paragraph
+import Data.Text.ParagraphLayout.Internal.Rich.ParagraphLayout
+import Data.Text.ParagraphLayout.Internal.Run
+import Data.Text.ParagraphLayout.Internal.TextOptions
+import Data.Text.ParagraphLayout.Internal.Tree
+
+-- | Lay out a rich text paragraph.
+layoutRich :: Paragraph d -> ParagraphLayout d
+layoutRich p@(Paragraph _ _ _ opts) = paragraphLayout $ map unwrap frags
+    where
+        unwrap (WithSpan rs frag) =
+            frag { fragmentUserData = RS.spanUserData rs }
+        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 root _) = do
+    let leaves = flatten root
+    let sTexts = paragraphSpanTexts p
+    let sBounds = paragraphSpanBounds p
+    let sStarts = NonEmpty.init sBounds
+    let pText = paragraphText p
+
+    (i, leaf, sStart, sText) <- getZipList $ (,,,)
+        <$> ZipList [0 ..]
+        <*> ZipList leaves
+        <*> ZipList sStarts
+        <*> ZipList sTexts
+    let (TextLeaf userData _ textOpts _) = leaf
+    let lang = textLanguage textOpts
+    let lBreaks = paragraphBreaks breakLine pText lang
+    let cBreaks = paragraphBreaks breakCharacter pText lang
+    return RS.ResolvedSpan
+        { RS.spanUserData = userData
+        , RS.spanIndex = i
+        , RS.spanOffsetInParagraph = sStart - pStart
+        -- TODO: Consider adding checks for array bounds.
+        , RS.spanText = sText
+        , RS.spanTextOptions = textOpts
+        , 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

@@ 0,0 1,85 @@
+module Data.Text.ParagraphLayout.Internal.Rich.Paragraph
+    ( Paragraph (..)
+    , paragraphSpanBounds
+    , paragraphSpanTexts
+    , paragraphText
+    )
+where
+
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Text.Array (Array)
+import Data.Text.Internal (Text (Text))
+
+import Data.Text.ParagraphLayout.Internal.ParagraphOptions
+import Data.Text.ParagraphLayout.Internal.Tree
+
+-- | Text to be laid out as a single paragraph.
+--
+-- May be divided into a hierarchy of boxes and spans.
+--
+-- The input text must be encoded as UTF-8 in a contiguous byte array.
+--
+-- You may need to use "Data.Text.Internal" in order to determine the byte
+-- array and the necessary offsets to construct the paragraph without copying
+-- data.
+data Paragraph d = Paragraph
+
+    Array
+    -- ^ A byte array containing the whole text to be laid out, in UTF-8.
+    --
+    -- This array will be passed to "Data.Text.Glyphize", which passes it to
+    -- [@hb_buffer_add_utf8()@]
+    -- (https://harfbuzz.github.io/harfbuzz-hb-buffer.html#hb-buffer-add-utf8).
+    --
+    -- In the output, `Data.Text.Glyphize.cluster` will be a byte offset of
+    -- the corresponding input character from this array.
+
+    Int
+    -- ^ Byte offset of the first text node from the start of the byte array.
+    -- Any characters preceding this offset will not be shaped, but may still
+    -- be used to influence the shape of neighbouring characters.
+
+    (RootNode d)
+    -- ^ Parts of the text to be laid out, represented as a tree.
+    -- The in-order walk of this tree corresponds to the logical order
+    -- of the text.
+
+    ParagraphOptions
+    -- ^ Options applying to the paragraph as a whole.
+
+-- | Calculate the offsets into the `Paragraph`'s underlying `Data.Text.Array`
+-- where each text node starts and ends, in ascending order. The resulting list
+-- will be one larger than the number of text nodes in the input.
+--
+-- You can use this function to verify that Balkón will slice the input text
+-- correctly.
+paragraphSpanBounds :: Paragraph d -> NonEmpty Int
+paragraphSpanBounds (Paragraph _ initialOffset root _) =
+    -- TODO: Consider adding checks for array bounds.
+    NonEmpty.scanl (+) initialOffset $ map len $ flatten root
+    where
+        len (TextLeaf _ l _ _) = l
+
+-- | Turn each text node from the input `Paragraph` into a `Text`.
+--
+-- You can use this function to verify that Balkón will slice the input text
+-- correctly.
+paragraphSpanTexts :: Paragraph d -> [Text]
+paragraphSpanTexts p@(Paragraph arr _ _ _) = zipWith toText sStarts sEnds
+    where
+        toText start end = Text arr start (end - start)
+        sStarts = NonEmpty.init sBounds
+        sEnds = NonEmpty.tail sBounds
+        sBounds = paragraphSpanBounds p
+
+-- | Turn all text nodes from the input `Paragraph` into one combined `Text`.
+--
+-- You can use this function to verify that Balkón will slice the input text
+-- correctly.
+paragraphText :: Paragraph d -> Text
+paragraphText p@(Paragraph arr _ _ _) = Text arr start (end - start)
+    where
+        start = NonEmpty.head sBounds
+        end = NonEmpty.last sBounds
+        sBounds = paragraphSpanBounds p

@@ 0,0 1,66 @@
+module Data.Text.ParagraphLayout.Internal.Rich.ParagraphLayout
+    ( ParagraphLayout (..)
+    , appendFragments
+    , emptyParagraphLayout
+    , filterFragments
+    , mapFragments
+    , paragraphLayout
+    , paragraphOriginX
+    , paragraphOriginY
+    , shapedRuns
+    )
+where
+
+import Data.Int (Int32)
+
+import Data.Text.ParagraphLayout.Internal.Fragment
+import Data.Text.ParagraphLayout.Internal.ParagraphExtents
+import Data.Text.ParagraphLayout.Internal.Rect
+
+-- | The resulting layout of the whole paragraph.
+data ParagraphLayout d = ParagraphLayout
+    { paragraphRect :: Rect Int32
+    -- ^ The containing block (CSS3).
+    , paragraphFragments :: [Fragment d]
+    -- ^ The resulting layout of all input text, divided into fragments as
+    -- required by the input structure, line breaking, text writing direction,
+    -- and changes of script.
+    }
+    deriving (Eq, Read, Show)
+
+-- | Wrap the given `Fragment`s and compute their containing rectangle.
+paragraphLayout :: [Fragment d] -> ParagraphLayout d
+paragraphLayout frags = ParagraphLayout pRect frags
+    where pRect = containRects $ map fragmentRect frags
+
+-- | A `ParagraphLayout` with no fragments.
+-- Useful as an identity element for `appendFragments`.
+emptyParagraphLayout :: ParagraphLayout a
+emptyParagraphLayout = ParagraphLayout emptyRect []
+
+-- | Remove fragments that do not match the given predicate.
+--
+-- The containing rectangle will be recalculated.
+filterFragments :: (Fragment d -> Bool) -> ParagraphLayout d ->
+    ParagraphLayout d
+filterFragments predicate (ParagraphLayout _ frags) =
+    paragraphLayout $ filter predicate frags
+
+-- | Run a mapping function over each fragment inside a `ParagraphLayout`.
+--
+-- The containing rectangle will be recalculated.
+mapFragments :: (Fragment d -> Fragment d) -> ParagraphLayout d ->
+    ParagraphLayout d
+mapFragments mapFunc (ParagraphLayout _ frags) =
+    paragraphLayout $ map mapFunc frags
+
+-- | Combine fragments from two `ParagraphLayout`s.
+--
+-- The containing rectangle will be recalculated.
+appendFragments :: ParagraphLayout d -> ParagraphLayout d -> ParagraphLayout d
+appendFragments (ParagraphLayout _ a) (ParagraphLayout _ b) =
+    paragraphLayout $ a ++ b
+
+-- | Return all shaped runs in the paragraph.
+shapedRuns :: ParagraphLayout d -> [ShapedRun]
+shapedRuns pl = map shapedRun $ paragraphFragments pl