3 files changed, 66 insertions(+), 42 deletions(-)

M balkon.cabal
M src/Data/Text/ParagraphLayout/Plain.hs
A src/Data/Text/ParagraphLayout/ProtoFragment.hs

@@ 100,6 100,7 @@ library
         Data.Text.ParagraphLayout.Fragment,
         Data.Text.ParagraphLayout.LineHeight,
         Data.Text.ParagraphLayout.Plain,
+        Data.Text.ParagraphLayout.ProtoFragment
         Data.Text.ParagraphLayout.Rect,
         Data.Text.ParagraphLayout.ResolvedSpan,
         Data.Text.ParagraphLayout.Run,

@@ 40,6 40,7 @@ import qualified Data.Text.Lazy as Lazy
 
 import Data.Text.ParagraphLayout.Fragment
 import Data.Text.ParagraphLayout.LineHeight
+import qualified Data.Text.ParagraphLayout.ProtoFragment as PF
 import Data.Text.ParagraphLayout.Rect
 import qualified Data.Text.ParagraphLayout.ResolvedSpan as RS
 import Data.Text.ParagraphLayout.Run


@@ 111,14 112,6 @@ base = Rect 0 0 0 0
 containRects :: (Ord a, Num a) => [Rect a] -> Rect a
 containRects = foldr union base
 
-containGlyphsH :: Int32 -> [GlyphPos] -> Rect Int32
-containGlyphsH lineHeight ps = Rect
-    { x_origin = 0
-    , y_origin = 0
-    , x_size = sum $ map x_advance ps
-    , y_size = lineHeight
-    }
-
 -- | Interface for basic plain text layout.
 --
 -- The entire paragraph will be assumed to have the same text direction and


@@ 129,47 122,36 @@ layoutPlain paragraph = ParagraphLayout pRect layouts
     where
         pRect = containRects allRects
         allRects = concat $ map spanRects layouts
-        layouts = snd $ addSpansH 0 spans
-        spans = resolveSpans paragraph
-
--- | Calculate layout for all given spans,
--- arrange them in one horizontal direction starting from the given x_offset,
--- and return the final x_offset for continuation.
-addSpansH :: Int32 -> [RS.ResolvedSpan] -> (Int32, [SpanLayout])
-addSpansH currentX rss = mapAccumL addSpanH currentX rss
-
--- TODO: Break lines.
--- TODO: Allow a run across multiple spans (e.g. if they only differ by colour).
+        layouts = layoutSpans $ resolveSpans paragraph
 
--- | Calculate layout for the given span, arrange each of its fragments
--- in one horizontal direction starting from the given x_offset,
--- and return the final x_offset for continuation.
-addSpanH :: Int32 -> RS.ResolvedSpan -> (Int32, SpanLayout)
-addSpanH currentX rs = (nextX, SpanLayout frags)
-    where (nextX, frags) = mapAccumL addRunH currentX $ spanToRunsWrapped rs
+layoutSpans :: [RS.ResolvedSpan] -> [SpanLayout]
+layoutSpans spans = map SpanLayout fragsBySpan
+    where
+        fragsBySpan = take (length spans) $ splitBySpanIndex indexedPfs
+        indexedPfs = layoutSingleLine $ concat $ map spanToRunsWrapped spans
 
 spanToRunsWrapped :: RS.ResolvedSpan -> [WithSpan Run]
 spanToRunsWrapped s = map (WithSpan s) (spanToRuns s)
 
--- | Calculate layout for the given run,
--- place the generated fragment horizontally at the given x_offset,
--- and return the final x_offset for continuation.
-addRunH :: Int32 -> WithSpan Run -> (Int32, Fragment)
-addRunH currentX run = (nextX, nextFrag)
+-- TODO: Break lines.
+layoutSingleLine :: [WithSpan Run] -> [WithSpan Fragment]
+layoutSingleLine runs = indexedFrags
     where
-        frag = layoutRun run
-        rect = fragmentRect frag
-        nextX = currentX + x_size rect
-        nextFrag = frag { fragmentRect = nextRect }
-        nextRect = rect { x_origin = currentX }
-
-layoutRun :: WithSpan Run -> Fragment
-layoutRun (WithSpan rs run) = Fragment rect (penX, penY) glyphs
+        indexedFrags = map (alignFragmentH originY) pfs
+        pfs = addRunsH originX runs
+        originX = 0
+        originY = 0
+
+-- TODO: Allow a run across multiple spans (e.g. if they only differ by colour).
+
+-- | Align the given horizontal fragment vertically on a line,
+-- using `originY` as its bottom edge.
+alignFragmentH :: Int32 -> WithSpan PF.ProtoFragment -> WithSpan Fragment
+alignFragmentH originY (WithSpan rs pf) = WithSpan rs (Fragment rect (penX, penY) (PF.glyphs pf))
     where
-        rect = containGlyphsH lineHeight $ map snd $ glyphs
-        penX = 0 -- for horizontal text
+        rect = Rect (PF.offset pf) originY (PF.advance pf) lineHeight
+        penX = 0
         penY = descent + leading `div` 2
-        glyphs = shapeRun (WithSpan rs run)
         lineHeight = case RS.spanLineHeight rs of
             Normal -> normalLineHeight
             Absolute h -> h


@@ 177,8 159,31 @@ layoutRun (WithSpan rs run) = Fragment rect (penX, penY) glyphs
         normalLineHeight = ascent + descent
         ascent = ascender extents
         descent = - descender extents
-        extents = fontExtentsForDir font dir
+        extents = fontExtentsForDir font (PF.direction pf)
         font = RS.spanFont rs
+
+-- | Calculate layout for multiple runs on the same line,
+-- arrange them in one horizontal direction starting from the given x_offset.
+addRunsH :: Int32 -> [WithSpan Run] -> [WithSpan PF.ProtoFragment]
+addRunsH currentX runs = snd $ mapAccumL addRunH currentX runs
+
+-- | Calculate layout for the given run,
+-- place the generated fragment horizontally at the given x_offset in a line,
+-- and return the final x_offset for continuation.
+addRunH :: Int32 -> WithSpan Run -> (Int32, WithSpan PF.ProtoFragment)
+addRunH currentX run = (nextX, WithSpan rs pf)
+    where
+        WithSpan rs pf = layoutRun currentX run
+        nextX = currentX + PF.advance pf
+
+-- | Calculate layout for the given run and position it in a line.
+layoutRun :: Int32 -> WithSpan Run -> WithSpan PF.ProtoFragment
+layoutRun originX (WithSpan rs run) = WithSpan rs pf
+    where
+        pf = PF.ProtoFragment dir originX totalX glyphs
+        glyphs = shapeRun (WithSpan rs run)
+        positions = map snd glyphs
+        totalX = sum $ map x_advance positions
         dir = runDirection run
 
 -- | Calculate layout for the given run independently of its position.

@@ 0,0 1,18 @@
+module Data.Text.ParagraphLayout.ProtoFragment (ProtoFragment(..))
+where
+
+import Data.Int (Int32)
+import Data.Text.Glyphize (Direction, GlyphInfo, GlyphPos)
+
+-- | A box fragment positioned within an indeterminate line.
+data ProtoFragment = ProtoFragment
+    { direction :: Maybe Direction
+    -- ^ Text direction, which is constant within a fragment.
+    , offset :: Int32
+    -- ^ Distance from the start of the line,
+    -- depending on the text direction.
+    , advance :: Int32
+    -- ^ Total advance of glyphs in this fragment,
+    -- depending on the text direction.
+    , glyphs :: [(GlyphInfo, GlyphPos)]
+    }