From 9cd91fba670a2470466a3dd80eb93292ecebdd8c Mon Sep 17 00:00:00 2001 From: Jaro Date: Sun, 26 Feb 2023 05:21:48 +0100 Subject: [PATCH] Lay out Runs independently of Spans. --- balkon.cabal | 1 + src/Data/Text/ParagraphLayout/Plain.hs | 89 ++++++++++--------- .../Text/ParagraphLayout/ProtoFragment.hs | 18 ++++ 3 files changed, 66 insertions(+), 42 deletions(-) create mode 100644 src/Data/Text/ParagraphLayout/ProtoFragment.hs diff --git a/balkon.cabal b/balkon.cabal index a4c3b86..5057890 100644 --- a/balkon.cabal +++ b/balkon.cabal @@ -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, diff --git a/src/Data/Text/ParagraphLayout/Plain.hs b/src/Data/Text/ParagraphLayout/Plain.hs index 01f1cef..c432459 100644 --- a/src/Data/Text/ParagraphLayout/Plain.hs +++ b/src/Data/Text/ParagraphLayout/Plain.hs @@ -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. diff --git a/src/Data/Text/ParagraphLayout/ProtoFragment.hs b/src/Data/Text/ParagraphLayout/ProtoFragment.hs new file mode 100644 index 0000000..59658d6 --- /dev/null +++ b/src/Data/Text/ParagraphLayout/ProtoFragment.hs @@ -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)] + } -- 2.30.2