From b7687d6dbb85576bcf07bbc273424a0cef3a9dda Mon Sep 17 00:00:00 2001 From: Jaro Date: Thu, 27 Apr 2023 18:30:00 +0200 Subject: [PATCH] Add basic support for Rich layout. --- balkon.cabal | 3 + .../Text/ParagraphLayout/Internal/Rich.hs | 75 ++++++++++++++++ .../Internal/Rich/Paragraph.hs | 85 +++++++++++++++++++ .../Internal/Rich/ParagraphLayout.hs | 66 ++++++++++++++ 4 files changed, 229 insertions(+) create mode 100644 src/Data/Text/ParagraphLayout/Internal/Rich.hs create mode 100644 src/Data/Text/ParagraphLayout/Internal/Rich/Paragraph.hs create mode 100644 src/Data/Text/ParagraphLayout/Internal/Rich/ParagraphLayout.hs diff --git a/balkon.cabal b/balkon.cabal index 880889b..65d682a 100644 --- a/balkon.cabal +++ b/balkon.cabal @@ -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, diff --git a/src/Data/Text/ParagraphLayout/Internal/Rich.hs b/src/Data/Text/ParagraphLayout/Internal/Rich.hs new file mode 100644 index 0000000..2c3812c --- /dev/null +++ b/src/Data/Text/ParagraphLayout/Internal/Rich.hs @@ -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 diff --git a/src/Data/Text/ParagraphLayout/Internal/Rich/Paragraph.hs b/src/Data/Text/ParagraphLayout/Internal/Rich/Paragraph.hs new file mode 100644 index 0000000..d5bf356 --- /dev/null +++ b/src/Data/Text/ParagraphLayout/Internal/Rich/Paragraph.hs @@ -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 diff --git a/src/Data/Text/ParagraphLayout/Internal/Rich/ParagraphLayout.hs b/src/Data/Text/ParagraphLayout/Internal/Rich/ParagraphLayout.hs new file mode 100644 index 0000000..f812bf0 --- /dev/null +++ b/src/Data/Text/ParagraphLayout/Internal/Rich/ParagraphLayout.hs @@ -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 -- 2.30.2