From 44ea112944690211d7c2da3c19bdadf1a0ca9c14 Mon Sep 17 00:00:00 2001 From: Jaro Date: Tue, 28 Mar 2023 19:20:30 +0200 Subject: [PATCH] Implement splitting ParagraphLayout into lines. --- balkon.cabal | 1 + .../Internal/ParagraphLayout.hs | 39 ++++++++++++ .../ParagraphLayout/Internal/ParagraphLine.hs | 63 +++++++++++++++++++ 3 files changed, 103 insertions(+) create mode 100644 src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs diff --git a/balkon.cabal b/balkon.cabal index f09170f..274aea3 100644 --- a/balkon.cabal +++ b/balkon.cabal @@ -129,6 +129,7 @@ library balkon-internal Data.Text.ParagraphLayout.Internal.Paragraph, Data.Text.ParagraphLayout.Internal.ParagraphConstruction, Data.Text.ParagraphLayout.Internal.ParagraphLayout, + Data.Text.ParagraphLayout.Internal.ParagraphLine, Data.Text.ParagraphLayout.Internal.Plain, Data.Text.ParagraphLayout.Internal.Rect, Data.Text.ParagraphLayout.Internal.ResolvedSpan, diff --git a/src/Data/Text/ParagraphLayout/Internal/ParagraphLayout.hs b/src/Data/Text/ParagraphLayout/Internal/ParagraphLayout.hs index 1c1f86c..3cfc1c4 100644 --- a/src/Data/Text/ParagraphLayout/Internal/ParagraphLayout.hs +++ b/src/Data/Text/ParagraphLayout/Internal/ParagraphLayout.hs @@ -1,5 +1,10 @@ module Data.Text.ParagraphLayout.Internal.ParagraphLayout (ParagraphLayout(..) + ,appendFragments + ,emptyParagraphLayout + ,filterFragments + ,mapFragments + ,paragraphFragments ,paragraphLayout ,paragraphOriginX ,paragraphOriginY @@ -54,6 +59,40 @@ paragraphLayout :: [SpanLayout] -> ParagraphLayout paragraphLayout sls = ParagraphLayout pRect sls where pRect = containRects $ concat $ map spanRects sls +-- | A `ParagraphLayout` with an infinite number of empty spans. +-- Useful as an identity element for `appendFragments`. +emptyParagraphLayout :: ParagraphLayout +emptyParagraphLayout = ParagraphLayout empty $ repeat (SpanLayout []) + +-- | Remove fragments that do not match the given predicate. +-- +-- The containing rectangle will be recalculated. +filterFragments :: (Fragment -> Bool) -> ParagraphLayout -> ParagraphLayout +filterFragments fragPred (ParagraphLayout _ sls) = paragraphLayout sls' + where + sls' = map slMapFunc sls + slMapFunc (SpanLayout frags) = SpanLayout (filter fragPred frags) + +-- | Run a mapping function over each fragment inside a `ParagraphLayout`. +-- +-- The containing rectangle will be recalculated. +mapFragments :: (Fragment -> Fragment) -> ParagraphLayout -> ParagraphLayout +mapFragments fragMapFunc (ParagraphLayout _ sls) = paragraphLayout sls' + where + sls' = map slMapFunc sls + slMapFunc (SpanLayout frags) = SpanLayout (map fragMapFunc frags) + +-- | Combine fragments from two `ParagraphLayout`s. +-- +-- The containing rectangle will be recalculated. +appendFragments :: ParagraphLayout -> ParagraphLayout -> ParagraphLayout +appendFragments pla plb = paragraphLayout sls' + where + sls' = zipWith zipFunc slsa slsb + slsa = spanLayouts pla + slsb = spanLayouts plb + zipFunc (SpanLayout fa) (SpanLayout fb) = SpanLayout (fa ++ fb) + -- | Return all fragments of shaped text in one flat list, -- discarding information about their associated spans. paragraphFragments :: ParagraphLayout -> [Fragment] diff --git a/src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs b/src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs new file mode 100644 index 0000000..69806cf --- /dev/null +++ b/src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs @@ -0,0 +1,63 @@ +module Data.Text.ParagraphLayout.Internal.ParagraphLine (cutLines, mergeLines) +where + +import Data.Int (Int32) +import qualified Data.List.NonEmpty as NonEmpty + +import Data.Text.ParagraphLayout.Internal.Fragment +import Data.Text.ParagraphLayout.Internal.LinePagination +import Data.Text.ParagraphLayout.Internal.ParagraphLayout +import Data.Text.ParagraphLayout.Internal.Rect + +-- | Represents one line of a `ParagraphLayout`. +newtype ParagraphLine = ParagraphLine ParagraphLayout + +instance Line ParagraphLine where + lineHeight (ParagraphLine pl) = height $ paragraphRect pl + +-- | Split the given `ParagraphLayout` into individual lines. +cutLines :: ParagraphLayout -> [ParagraphLine] +cutLines pl = map (\y -> cutLine y pl) (lineOrigins pl) + +-- | Reduce the given `ParagraphLayout` to fragments with the given `y_origin`. +-- +-- This assumes that each line consists of fragments of equal height and that +-- there is no space between lines. +-- +-- TODO: Use line numbers to support rich text. +cutLine :: Int32 -> ParagraphLayout -> ParagraphLine +cutLine y pl = ParagraphLine $ shiftFragments (-y) $ limitFragments y pl + +lineOrigins :: ParagraphLayout -> [Int32] +lineOrigins pl = dedupe $ map (y_origin . fragmentRect) $ paragraphFragments pl + +-- | Remove duplicates from a sorted list. +dedupe :: Eq a => [a] -> [a] +dedupe xs = map NonEmpty.head $ NonEmpty.group xs + +-- | Combine the given `ParagraphLine`s into a `ParagraphLayout` by merging +-- their fragments. +mergeLines :: [ParagraphLine] -> ParagraphLayout +mergeLines lls = foldl mergeLine emptyParagraphLayout lls + +mergeLine :: ParagraphLayout -> ParagraphLine -> ParagraphLayout +mergeLine pl (ParagraphLine nextLine) = pl' + where + -- Quadratic time complexity. TODO: Consider optimising. + pl' = appendFragments pl $ shiftFragments y nextLine + y = y_terminus $ paragraphRect pl + +-- | Add @dy@ to each fragment's `y_origin`. +shiftFragments :: Int32 -> ParagraphLayout -> ParagraphLayout +shiftFragments dy = mapFragments (shiftFragment dy) + +shiftFragment :: Int32 -> Fragment -> Fragment +shiftFragment dy f = f' + where + f' = f { fragmentRect = r' } + r' = r { y_origin = y_origin r + dy } + r = fragmentRect f + +-- | Keep only fragments with the given `y_origin` value. +limitFragments :: Int32 -> ParagraphLayout -> ParagraphLayout +limitFragments y = filterFragments ((== y) . y_origin . fragmentRect) -- 2.30.2