3 files changed, 103 insertions(+), 0 deletions(-)

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

@@ 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,

@@ 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]

@@ 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)