From ca4b08b080c75d50615f1d7229e0217b4a17f302 Mon Sep 17 00:00:00 2001 From: Jaro Date: Sat, 29 Apr 2023 13:02:34 +0200 Subject: [PATCH] Convert plain layout to a wrapper over rich layout. --- .../Text/ParagraphLayout/Internal/Plain.hs | 122 +++++++++--------- .../ParagraphLayout/Internal/ResolvedSpan.hs | 10 -- 2 files changed, 60 insertions(+), 72 deletions(-) diff --git a/src/Data/Text/ParagraphLayout/Internal/Plain.hs b/src/Data/Text/ParagraphLayout/Internal/Plain.hs index b30e7f4..9397a46 100644 --- a/src/Data/Text/ParagraphLayout/Internal/Plain.hs +++ b/src/Data/Text/ParagraphLayout/Internal/Plain.hs @@ -1,75 +1,73 @@ +-- | Legacy plain text layout interface. 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.BoxOptions +import Data.Text.ParagraphLayout.Internal.Fragment 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 qualified Data.Text.ParagraphLayout.Internal.Plain.Paragraph as P +import qualified Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout as P +import Data.Text.ParagraphLayout.Internal.Rich (layoutRich) +import qualified Data.Text.ParagraphLayout.Internal.Rich.Paragraph as R +import qualified Data.Text.ParagraphLayout.Internal.Rich.ParagraphLayout as R import Data.Text.ParagraphLayout.Internal.Span import Data.Text.ParagraphLayout.Internal.TextOptions +import Data.Text.ParagraphLayout.Internal.Tree + +-- | Lay out a paragraph of plain text using a single font. +layoutPlain :: P.Paragraph d -> P.ParagraphLayout d +layoutPlain p@(P.Paragraph _ _ spans _) = + richLayoutToPlain (length spans) $ layoutRich $ plainToRich p --- | Lay out a paragraph of plain, unidirectional text using a single font. -layoutPlain :: Paragraph d -> ParagraphLayout d -layoutPlain p@(Paragraph _ _ _ opts) = paragraphLayout sls +-- | Convert a legacy plain text paragraph to a rich text paragraph. +-- +-- Each plain text span is converted to a box with one text node inside. +-- +-- Span indexes are added to the user data internally, then used to split the +-- resulting fragments according to their corresponding spans. +plainToRich :: P.Paragraph d -> R.Paragraph (Int, d) +plainToRich (P.Paragraph arr off spans opts) = R.Paragraph arr off rootNode opts 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 + rootNode = RootBox rootBox + rootBox = Box spanNodes baseOpts + spanNodes = map spanNode indexedSpans + spanNode (i, s) = InlineBox + (i, spanUserData s) + (boxFromPlain baseOpts i s) + defaultBoxOptions + indexedSpans = zip [0 ..] spans + baseOpts = defaultTextOptions + { textFont = paragraphFont opts + , textLineHeight = paragraphLineHeight opts + } --- | 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 +-- | Convert a legacy `Span` to a rich text box with one text node inside. +-- +-- Add the given index to the user data, so that it can be extracted later. +boxFromPlain :: TextOptions -> Int -> Span d -> Box (Int, d) +boxFromPlain baseOpts i s = Box [TextSequence (i, spanUserData s) len] opts + where + len = spanLength s + opts = baseOpts { textLanguage = spanLanguage $ spanOptions s } --- | 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) +-- | Convert a rich paragraph layout with span indexes into the legacy paragraph +-- layout with an array of spans. +richLayoutToPlain :: Int -> R.ParagraphLayout (Int, d) -> P.ParagraphLayout d +richLayoutToPlain numSpans pl = P.paragraphLayout sls + where + sls = map SpanLayout fragsBySpan + fragsBySpan = take numSpans $ splitBySpanIndex frags + frags = R.paragraphFragments pl -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 +splitBySpanIndex :: [Fragment (Int, d)] -> [[Fragment d]] +splitBySpanIndex frags = [getBySpanIndex i frags | i <- [0 ..]] - (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 - } +getBySpanIndex :: Int -> [Fragment (Int, d)] -> [Fragment d] +getBySpanIndex idx = map stripSpanIndex . filter ((== idx) . getSpanIndex) + +getSpanIndex :: Fragment (Int, d) -> Int +getSpanIndex Fragment { fragmentUserData = (i, _) } = i -paragraphBreaks :: (LocaleName -> Breaker a) -> Text -> String -> [(Int, a)] -paragraphBreaks breakFunc txt lang = - breaksDesc (breakFunc (locale lang LBAuto)) txt +stripSpanIndex :: Fragment (Int, d) -> Fragment d +stripSpanIndex f = case fragmentUserData f of + (_, d) -> f { fragmentUserData = d } diff --git a/src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs b/src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs index ab971a3..4d87ddd 100644 --- a/src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs +++ b/src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs @@ -1,7 +1,6 @@ module Data.Text.ParagraphLayout.Internal.ResolvedSpan ( ResolvedSpan (..) , WithSpan (WithSpan) - , splitBySpanIndex ) where @@ -48,12 +47,3 @@ instance SeparableTextContainer a => SeparableTextContainer (WithSpan d a) where instance WithLevel a => WithLevel (WithSpan d a) where level (WithSpan _ x) = level x - -splitBySpanIndex :: [WithSpan d a] -> [[a]] -splitBySpanIndex xs = [getBySpanIndex i xs | i <- [0 ..]] - -getBySpanIndex :: Int -> [WithSpan d a] -> [a] -getBySpanIndex idx xs = map contents $ filter matchingIndex $ xs - where - matchingIndex (WithSpan rs _) = (spanIndex rs) == idx - contents (WithSpan _ x) = x -- 2.30.2