From 65d952e2f615751db54267097c706545be5e6be6 Mon Sep 17 00:00:00 2001 From: Jaro Date: Wed, 8 Mar 2023 13:21:49 +0100 Subject: [PATCH] Slightly decompose the Plain module. --- balkon.cabal | 1 + lib/Data/Text/ParagraphLayout.hs | 1 + .../ParagraphLayout/Internal/Paragraph.hs | 110 ++++++++++++ .../Text/ParagraphLayout/Internal/Plain.hs | 169 +++--------------- .../ParagraphLayout/Internal/ResolvedSpan.hs | 28 ++- .../Text/ParagraphLayout/Internal/Span.hs | 20 ++- .../ParagraphLayout/Internal/TextContainer.hs | 9 + 7 files changed, 191 insertions(+), 147 deletions(-) create mode 100644 src/Data/Text/ParagraphLayout/Internal/Paragraph.hs diff --git a/balkon.cabal b/balkon.cabal index 6de73a3..4c34d0c 100644 --- a/balkon.cabal +++ b/balkon.cabal @@ -98,6 +98,7 @@ library balkon-internal Data.Text.ParagraphLayout.Internal.Break, Data.Text.ParagraphLayout.Internal.Fragment, Data.Text.ParagraphLayout.Internal.LineHeight, + Data.Text.ParagraphLayout.Internal.Paragraph, Data.Text.ParagraphLayout.Internal.ParagraphConstruction, Data.Text.ParagraphLayout.Internal.Plain, Data.Text.ParagraphLayout.Internal.Rect, diff --git a/lib/Data/Text/ParagraphLayout.hs b/lib/Data/Text/ParagraphLayout.hs index 333431c..2187497 100644 --- a/lib/Data/Text/ParagraphLayout.hs +++ b/lib/Data/Text/ParagraphLayout.hs @@ -31,5 +31,6 @@ where import Data.Text.ParagraphLayout.Internal.Fragment import Data.Text.ParagraphLayout.Internal.LineHeight +import Data.Text.ParagraphLayout.Internal.Paragraph import Data.Text.ParagraphLayout.Internal.Plain import Data.Text.ParagraphLayout.Internal.Span diff --git a/src/Data/Text/ParagraphLayout/Internal/Paragraph.hs b/src/Data/Text/ParagraphLayout/Internal/Paragraph.hs new file mode 100644 index 0000000..80f7db7 --- /dev/null +++ b/src/Data/Text/ParagraphLayout/Internal/Paragraph.hs @@ -0,0 +1,110 @@ +module Data.Text.ParagraphLayout.Internal.Paragraph + (Paragraph(..) + ,ParagraphLayout(..) + ,ParagraphOptions(..) + ,paragraphLayout + ,paragraphOriginX + ,paragraphOriginY + ,paragraphSpanBounds + ) +where + +import Data.Int (Int32) +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NonEmpty +import Data.Text.Array (Array) +import Data.Text.Glyphize (Font) + +import Data.Text.ParagraphLayout.Internal.LineHeight +import Data.Text.ParagraphLayout.Internal.Rect +import Data.Text.ParagraphLayout.Internal.Span + +-- | Text to be laid out as a single paragraph. +-- +-- May be divided into any number of neighbouring spans, each of which will +-- be represented as a separate `SpanLayout` in the resulting layout. +-- +-- 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. +-- +-- For simple use cases, it may be sufficient to construct paragraphs using +-- [ParagraphConstruction]("Data.Text.ParagraphLayout.ParagraphConstruction"). +data Paragraph = Paragraph + + Array + -- ^ A byte array containing the whole text to be laid out, in UTF-8. + + Int + -- ^ Byte offset of the first span 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. + + [Span] + -- ^ Parts of the text to be laid out, in logical order. + -- The initial offset plus total length of all spans must not exceed + -- the bounds of the byte array. + -- Any characters following the last span will not be shaped, but may still + -- be used to influence the shape of neighbouring characters. + + ParagraphOptions + -- ^ Options applying to the paragraph as a whole. + +data ParagraphOptions = ParagraphOptions + + { paragraphFont :: Font + -- ^ Font to be used for shaping and measurement. + -- Make sure to set its scale (see `Data.Text.Glyphize.optionScale`) using + -- the same units that you want in the output. + + , paragraphLineHeight :: LineHeight + -- ^ Preferred line height of the resulting box fragments. + + , paragraphMaxWidth :: Int32 + -- ^ Line width at which line breaking should occur. + -- Lines will be broken at language-appropriate boundaries. + -- If a line still exceeds this limit then, it will be broken at character + -- boundaries, and if it already consists of a single cluster that cannot + -- be further broken down, it will overflow. + + } + deriving (Eq, Show) + +-- | The resulting layout of the whole paragraph. +data ParagraphLayout = ParagraphLayout + { paragraphRect :: Rect Int32 + -- ^ The containing block (CSS3). + , spanLayouts :: [SpanLayout] + } + deriving (Eq, Read, Show) + +-- | Calculate the offsets into the `Paragraph`'s underlying `Array` where each +-- span starts and ends, in ascending order. The resulting list will be one +-- larger than the list of input spans. +paragraphSpanBounds :: Paragraph -> NonEmpty Int +paragraphSpanBounds (Paragraph _ initialOffset spans _) = + NonEmpty.scanl (+) initialOffset (map spanLength spans) + +paragraphOriginX :: (Num a) => a +paragraphOriginX = 0 + +paragraphOriginY :: (Num a) => a +paragraphOriginY = 0 + +empty :: (Num a) => Rect a +empty = Rect + { x_origin = paragraphOriginX + , y_origin = paragraphOriginY + , x_size = 0 + , y_size = 0 + } + +containRects :: (Ord a, Num a) => [Rect a] -> Rect a +containRects = foldr union empty + +-- | Wrap the given `SpanLayout`s and compute their containing rectangle. +paragraphLayout :: [SpanLayout] -> ParagraphLayout +paragraphLayout sls = ParagraphLayout pRect sls + where pRect = containRects $ concat $ map spanRects sls diff --git a/src/Data/Text/ParagraphLayout/Internal/Plain.hs b/src/Data/Text/ParagraphLayout/Internal/Plain.hs index 8401990..fc90af1 100644 --- a/src/Data/Text/ParagraphLayout/Internal/Plain.hs +++ b/src/Data/Text/ParagraphLayout/Internal/Plain.hs @@ -7,17 +7,16 @@ module Data.Text.ParagraphLayout.Internal.Plain ) where +import Control.Applicative (ZipList(ZipList), getZipList) import Data.Int (Int32) import Data.List (mapAccumL) import Data.List.NonEmpty (NonEmpty((:|))) +import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (catMaybes, fromMaybe, listToMaybe) -import qualified Data.Text as Text -import Data.Text.Array (Array) import Data.Text.Foreign (lengthWord8) import Data.Text.Glyphize (Buffer(..) ,ContentType(ContentTypeUnicode) - ,Font ,FontExtents(..) ,GlyphInfo ,GlyphPos(x_advance) @@ -33,118 +32,21 @@ import qualified Data.Text.Lazy as Lazy import Data.Text.ParagraphLayout.Internal.Break import Data.Text.ParagraphLayout.Internal.Fragment import Data.Text.ParagraphLayout.Internal.LineHeight +import Data.Text.ParagraphLayout.Internal.Paragraph import qualified Data.Text.ParagraphLayout.Internal.ProtoFragment as PF import Data.Text.ParagraphLayout.Internal.Rect +import Data.Text.ParagraphLayout.Internal.ResolvedSpan (WithSpan(WithSpan)) import qualified Data.Text.ParagraphLayout.Internal.ResolvedSpan as RS import Data.Text.ParagraphLayout.Internal.Run import Data.Text.ParagraphLayout.Internal.Span import Data.Text.ParagraphLayout.Internal.TextContainer --- | Text to be laid out as a single paragraph. --- --- May be divided into any number of neighbouring spans, each of which will --- be represented as a separate `SpanLayout` in the resulting layout. --- --- 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. --- --- For simple use cases, it may be sufficient to construct paragraphs using --- [ParagraphConstruction]("Data.Text.ParagraphLayout.ParagraphConstruction"). -data Paragraph = Paragraph - - Array - -- ^ A byte array containing the whole text to be laid out, in UTF-8. - - Int - -- ^ Byte offset of the first span 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. - - [Span] - -- ^ Parts of the text to be laid out, in logical order. - -- The initial offset plus total length of all spans must not exceed - -- the bounds of the byte array. - -- Any characters following the last span will not be shaped, but may still - -- be used to influence the shape of neighbouring characters. - - ParagraphOptions - -- ^ Options applying to the paragraph as a whole. - -data ParagraphOptions = ParagraphOptions - - { paragraphFont :: Font - -- ^ Font to be used for shaping and measurement. - -- Make sure to set its scale (see `Data.Text.Glyphize.optionScale`) using - -- the same units that you want in the output. - - , paragraphLineHeight :: LineHeight - -- ^ Preferred line height of the resulting box fragments. - - , paragraphMaxWidth :: Int32 - -- ^ Line width at which line breaking should occur. - -- Lines will be broken at language-appropriate boundaries. - -- If a line still exceeds this limit then, it will be broken at character - -- boundaries, and if it already consists of a single cluster that cannot - -- be further broken down, it will overflow. - - } - deriving (Eq, Show) - --- | The resulting layout of the whole paragraph. -data ParagraphLayout = ParagraphLayout - { paragraphRect :: Rect Int32 - -- ^ The containing block (CSS3). - , spanLayouts :: [SpanLayout] - } - deriving (Eq, Read, Show) - --- | The resulting layout of each span, which may include multiple fragments if --- broken over multiple lines. -data SpanLayout = SpanLayout [Fragment] - -- TODO: Consider merging. fragments created by script changes. - deriving (Eq, Read, Show) - --- | Wrapper for temporarily mapping the relationship to a `Span`. -data WithSpan a = WithSpan RS.ResolvedSpan a - -instance Functor WithSpan where - fmap f (WithSpan s a) = WithSpan s (f a) - -instance TextContainer a => TextContainer (WithSpan a) where - getText (WithSpan _ c) = getText c - -instance SeparableTextContainer a => SeparableTextContainer (WithSpan a) where - splitTextAt8 n (WithSpan rs c) = (WithSpan rs c1, WithSpan rs c2) - where (c1, c2) = splitTextAt8 n c - -splitBySpanIndex :: [WithSpan a] -> [[a]] -splitBySpanIndex xs = [getBySpanIndex i xs | i <- [0..]] - -getBySpanIndex :: Int -> [WithSpan a] -> [a] -getBySpanIndex idx xs = map contents $ filter matchingIndex $ xs - where - matchingIndex (WithSpan rs _) = (RS.spanIndex rs) == idx - contents (WithSpan _ x) = x - -spanRects :: SpanLayout -> [Rect Int32] -spanRects (SpanLayout frags) = map fragmentRect frags - -base :: (Num a) => Rect a -base = Rect 0 0 0 0 - -containRects :: (Ord a, Num a) => [Rect a] -> Rect a -containRects = foldr union base - -- | Lay out a paragraph of plain, unidirectional text using a single font. layoutPlain :: Paragraph -> ParagraphLayout -layoutPlain p@(Paragraph _ _ _ opts) = ParagraphLayout pRect sls +layoutPlain p@(Paragraph _ _ _ opts) = paragraphLayout sls where - pRect = containRects $ concat $ map spanRects sls sls = map SpanLayout fragsBySpan - fragsBySpan = take (length spans) $ splitBySpanIndex frags + fragsBySpan = take (length spans) $ RS.splitBySpanIndex frags frags = layoutAndAlignLines maxWidth $ spansToRunsWrapped spans maxWidth = paragraphMaxWidth opts spans = resolveSpans p @@ -169,7 +71,7 @@ layoutAndAlignLines maxWidth runs = frags frags = concat fragsInLines (_, fragsInLines) = mapAccumL alignLineH originY protoFragsInLines protoFragsInLines = layoutLines maxWidth runs - originY = 0 + originY = paragraphOriginY -- | Create a multi-line layout from the given runs, splitting them as -- necessary to fit within the requested line width. @@ -190,7 +92,7 @@ layoutLines maxWidth runs where (fitting, rest) = tryAddRunsH maxWidth originX runs overflowing = addRunsH originX runs - originX = 0 + originX = paragraphOriginX -- TODO: Allow a run across multiple spans (e.g. if they only differ by colour). @@ -272,12 +174,6 @@ breakSplits closed (x:xs) = splits ++ breakSplits (x:closed) xs mapFunc ((x1, x2), _) = (reverse $ collapse $ x1 :| xs, collapse $ x2 :| closed) --- | If the first run is empty, remove it. -collapse :: NonEmpty (WithSpan Run) -> [WithSpan Run] -collapse (x :| xs) - | Text.null (getText x) = xs - | otherwise = x:xs - -- | Calculate layout for multiple runs on the same line and -- arrange them in one horizontal direction starting from the given x_offset. addRunsH :: Int32 -> [WithSpan Run] -> [WithSpan PF.ProtoFragment] @@ -318,21 +214,28 @@ shapeRun (WithSpan rs run) = shape font buffer features features = [] resolveSpans :: Paragraph -> [RS.ResolvedSpan] -resolveSpans p@(Paragraph arr off spans opts) = do - let (end, textsAndMarks) = cutsAndMarks arr off spans - let indexes = [0..] - - (s, (o, t), i) <- zip3 spans textsAndMarks indexes +resolveSpans p@(Paragraph arr pStart spans opts) = do + let sBounds = paragraphSpanBounds p + let pEnd = NonEmpty.last sBounds + let sStarts = NonEmpty.init sBounds + let sLengths = map spanLength spans + + (i, s, sStart, sLen) <- getZipList $ (,,,) + <$> ZipList [0..] + <*> ZipList spans + <*> ZipList sStarts + <*> ZipList sLengths let lang = spanLanguage s - let breaks = paragraphLineBreaks p end lang + let breaks = paragraphLineBreaks p pEnd lang return RS.ResolvedSpan { RS.spanIndex = i - , RS.spanOffsetInParagraph = o - off - , RS.spanText = t + , RS.spanOffsetInParagraph = sStart - pStart + -- TODO: Consider adding checks for array bounds. + , RS.spanText = Text arr sStart sLen , RS.spanFont = paragraphFont opts , RS.spanLineHeight = paragraphLineHeight opts , RS.spanLanguage = lang - , RS.spanLineBreaks = subOffsetsDesc (o - off) breaks + , RS.spanLineBreaks = subOffsetsDesc (sStart - pStart) breaks } paragraphLineBreaks :: Paragraph -> Int -> String -> [(Int, BreakStatus.Line)] @@ -358,27 +261,3 @@ runLineBreaks (WithSpan rs run) = dropWhile (not . valid) $ -- TODO: Identify and correct for differences between the two. localeFromLanguage :: String -> LocaleName localeFromLanguage x = Locale x - --- | Given an underlying `Array`, an initial offset, and a list of consecutive --- `Span`s, produce a list of `Text`s corresponding to the given spans, as well --- as the offset of the start of each `Text` and the end of the last `Text`. --- --- TODO: Consider adding checks for array bounds. -cutsAndMarks :: Array -> Int -> [Span] -> (Int, [(Int, Text)]) -cutsAndMarks arr initialOffset spans = - mapAccumL (cutAndMark arr) initialOffset spans - --- | Like `cut`, but also include the starting offset in the output. -cutAndMark :: Array -> Int -> Span -> (Int, (Int, Text)) -cutAndMark arr off s = (end, (off, t)) - where - (end, t) = cut arr off s - --- | Produce a `Text`, defined by an initial offset and a `Span`, out of the --- underlying `Array`. -cut :: Array -> Int -> Span -> (Int, Text) -cut arr off s = (end, t) - where - len = spanLength s - end = off + len - t = Text arr off len diff --git a/src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs b/src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs index b819849..99ce7de 100644 --- a/src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs +++ b/src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs @@ -1,4 +1,8 @@ -module Data.Text.ParagraphLayout.Internal.ResolvedSpan (ResolvedSpan(..)) +module Data.Text.ParagraphLayout.Internal.ResolvedSpan + (ResolvedSpan(..) + ,WithSpan(WithSpan) + ,splitBySpanIndex + ) where import Data.Text (Text) @@ -26,3 +30,25 @@ instance Eq ResolvedSpan where instance TextContainer ResolvedSpan where getText = spanText + +-- | Wrapper for temporarily mapping the relationship to a `Span`. +data WithSpan a = WithSpan ResolvedSpan a + +instance Functor WithSpan where + fmap f (WithSpan s a) = WithSpan s (f a) + +instance TextContainer a => TextContainer (WithSpan a) where + getText (WithSpan _ c) = getText c + +instance SeparableTextContainer a => SeparableTextContainer (WithSpan a) where + splitTextAt8 n (WithSpan rs c) = (WithSpan rs c1, WithSpan rs c2) + where (c1, c2) = splitTextAt8 n c + +splitBySpanIndex :: [WithSpan a] -> [[a]] +splitBySpanIndex xs = [getBySpanIndex i xs | i <- [0..]] + +getBySpanIndex :: Int -> [WithSpan a] -> [a] +getBySpanIndex idx xs = map contents $ filter matchingIndex $ xs + where + matchingIndex (WithSpan rs _) = (spanIndex rs) == idx + contents (WithSpan _ x) = x diff --git a/src/Data/Text/ParagraphLayout/Internal/Span.hs b/src/Data/Text/ParagraphLayout/Internal/Span.hs index 3b51559..d7c0684 100644 --- a/src/Data/Text/ParagraphLayout/Internal/Span.hs +++ b/src/Data/Text/ParagraphLayout/Internal/Span.hs @@ -1,6 +1,15 @@ -module Data.Text.ParagraphLayout.Internal.Span (Span(..)) +module Data.Text.ParagraphLayout.Internal.Span + (Span(..) + ,SpanLayout(..) + ,spanRects + ) where +import Data.Int (Int32) + +import Data.Text.ParagraphLayout.Internal.Fragment +import Data.Text.ParagraphLayout.Internal.Rect + -- | A paragraph is broken into spans by the caller. -- -- Each span could have a different font family, size, style, text decoration, @@ -16,3 +25,12 @@ data Span = Span } deriving (Eq, Read, Show) + +-- | The resulting layout of each span, which may include multiple fragments if +-- broken over multiple lines. +data SpanLayout = SpanLayout [Fragment] + -- TODO: Consider merging. fragments created by script changes. + deriving (Eq, Read, Show) + +spanRects :: SpanLayout -> [Rect Int32] +spanRects (SpanLayout frags) = map fragmentRect frags diff --git a/src/Data/Text/ParagraphLayout/Internal/TextContainer.hs b/src/Data/Text/ParagraphLayout/Internal/TextContainer.hs index 1f886d7..1405f17 100644 --- a/src/Data/Text/ParagraphLayout/Internal/TextContainer.hs +++ b/src/Data/Text/ParagraphLayout/Internal/TextContainer.hs @@ -1,13 +1,16 @@ module Data.Text.ParagraphLayout.Internal.TextContainer (SeparableTextContainer ,TextContainer + ,collapse ,getText ,splitTextAt8 ,splitTextsAt8 ) where +import Data.List.NonEmpty (NonEmpty((:|))) import Data.Text (Text) +import qualified Data.Text as Text import Data.Text.Foreign (lengthWord8) -- | Class of data types containing `Text` that can be accessed. @@ -43,3 +46,9 @@ splitTextsAt8' n rpre (r:rs) | otherwise = let (r1, r2) = splitTextAt8 n r in (r1:rpre, r2:rs) where l = lengthWord8 $ getText r + +-- | If the first container in the list is empty, remove it. +collapse :: SeparableTextContainer a => NonEmpty a -> [a] +collapse (x :| xs) + | Text.null (getText x) = xs + | otherwise = x:xs -- 2.30.2