From d4a87f66d024aa3390e7fc3fddcc1aad4b1a0233 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Thu, 1 Jun 2023 14:52:12 +1200 Subject: [PATCH] Correctly reporting surrounding whitespace on inline elements. --- Graphics/Layout.hs | 4 +-- Graphics/Layout/Inline.hs | 59 +++++++++++++++++++++++++++++++-------- 2 files changed, 49 insertions(+), 14 deletions(-) diff --git a/Graphics/Layout.hs b/Graphics/Layout.hs index 29e1a0c..523f45a 100644 --- a/Graphics/Layout.hs +++ b/Graphics/Layout.hs @@ -71,9 +71,7 @@ layoutGetBox (LayoutInline _ self _) = zero { layoutGetBox (LayoutInline' _ self _) = zero { B.min = layoutSize self, B.size = layoutSize self, B.max = layoutSize self } -layoutGetBox (LayoutSpan self) = zero { - B.min = fragmentSize self, B.size = fragmentSize self, B.max = fragmentSize self -} +layoutGetBox (LayoutSpan self) = treeBox self layoutGetBox (LayoutConst _ ret _) = ret -- | Retrieve the subtree under a node. layoutGetChilds (LayoutFlow _ _ ret) = ret diff --git a/Graphics/Layout/Inline.hs b/Graphics/Layout/Inline.hs index b27aec4..e8fe0dc 100644 --- a/Graphics/Layout/Inline.hs +++ b/Graphics/Layout/Inline.hs @@ -3,12 +3,13 @@ -- wraps Balkón for the actual logic. module Graphics.Layout.Inline(inlineMinWidth, inlineMin, inlineNatWidth, inlineHeight, inlineSize, inlineChildren, layoutSize, layoutChildren, positionChildren, - fragmentSize, fragmentSize', fragmentPos, FragmentTree(..), + fragmentSize, fragmentSize', fragmentPos, treeBox, FragmentTree(..), positionSubtree, subtreeInner, paragraphMap, layoutMap, treeMap) where import Data.Text.ParagraphLayout.Rich (Paragraph(..), ParagraphOptions(..), Fragment(..), ParagraphLayout(..), AncestorBox(..), - layoutRich, InnerNode(..), Box(..), RootNode(..)) + InnerNode(..), Box(..), RootNode(..), + layoutRich, boxSpacing, BoxSpacing(..)) import Data.Text.ParagraphLayout.Rect (Rect(..), width, height, x_max, x_min, y_min, y_max) import Data.Text.Internal (Text(..)) @@ -17,6 +18,7 @@ import Data.Char (isSpace) import Data.Int (Int32) import Graphics.Layout.Box hiding (min, max, width, height) +import qualified Graphics.Layout.Box as Box import Graphics.Layout.CSS.Font (Font', hbUnit) -- | Convert from Harfbuzz units to device pixels as a Double @@ -25,19 +27,26 @@ hbScale = (/hbUnit) . fromIntegral -- | Convert from Harfbuzz units to device pixels as a Double or Length. c :: CastDouble a => Int32 -> a c = fromDouble . hbScale +-- | Convert from a CastDouble in device pixels to Harfbuzz units. +unscale :: CastDouble x => x -> Int32 +unscale = floor . (*hbUnit) . toDouble -- | Compute minimum width for some richtext. -inlineMinWidth :: Paragraph a -> Double +inlineMinWidth :: (CastDouble m, CastDouble n) => + Paragraph (a, PaddedBox m n, c) -> Double inlineMinWidth self = hbScale $ width $ layoutRich' self 0 -- | Compute minimum width & height for some richtext. -inlineMin :: (CastDouble x, CastDouble y) => Paragraph a -> Size x y +inlineMin :: (CastDouble x, CastDouble y) => + Paragraph (a, PaddedBox x y, c) -> Size x y inlineMin self = Size (c $ width rect) (c $ height rect) where rect = layoutRich' self 0 -- | Compute natural (single-line) width for some richtext. -inlineNatWidth :: Paragraph a -> Double +inlineNatWidth :: (CastDouble m, CastDouble n) => + Paragraph (a, PaddedBox m n, c) -> Double inlineNatWidth self = hbScale $ width $ layoutRich' self maxBound -- | Compute height for rich text at given width. -inlineHeight :: Double -> Paragraph a -> Double +inlineHeight :: (CastDouble m, CastDouble n) => + Double -> Paragraph (a, PaddedBox m n, c) -> Double inlineHeight width self = hbScale $ height $ layoutRich' self $ round (hbUnit * width) @@ -58,9 +67,21 @@ layoutChildren :: Eq a => ParagraphLayout a -> [FragmentTree a] layoutChildren self = reconstructTree self -- | Layout a paragraph at given width & retrieve resulting rect. -layoutRich' :: Paragraph a -> Int32 -> Rect Int32 -layoutRich' (Paragraph a b c d) width = - paragraphRect $ layoutRich $ Paragraph a b c d { paragraphMaxWidth = width } +layoutRich' :: (CastDouble m, CastDouble n) => + Paragraph (a, PaddedBox m n, c) -> Int32 -> Rect Int32 +layoutRich' (Paragraph a b c d) width = paragraphRect $ layoutRich $ + lowerSpacing $ Paragraph a b c d { paragraphMaxWidth = width } + +lowerSpacing :: (CastDouble m, CastDouble n) => + Paragraph (a, PaddedBox m n, c) -> Paragraph (a, PaddedBox m n, c) +lowerSpacing (Paragraph a b (RootBox c) d) = Paragraph a b (RootBox $ inner c) d + where + inner (Box childs opts) = flip Box opts $ map inner' childs + inner' (InlineBox e@(_, f, _) child opts) = InlineBox e (inner child) opts { + boxSpacing = BoxSpacingLeftRight (leftSpace box) (rightSpace box) + } + where box = mapX' unscale $ mapY' unscale f + inner' self@(TextSequence _ _) = self -- | Apply an operation to the 2nd field of the paragraph's userdata, -- for it's entire subtree. @@ -112,10 +133,26 @@ treeRect (Branch AncestorBox { boxUserData = (_, box', _)} childs) = (y_max a `max` y_max b - y_min a `min` x_min b + vSpace box) box :: PaddedBox Int32 Int32 box = mapX' unscale $ mapY' unscale box' - unscale :: CastDouble x => x -> Int32 - unscale = floor . (*hbUnit) . toDouble treeRect (Leaf self) = fragmentRect self +-- | Compute the paddedbox for a subtree. +treeBox :: (CastDouble m, CastDouble n) => + FragmentTree (a, PaddedBox m n, c) -> PaddedBox m n +treeBox self@(Branch AncestorBox { boxUserData = (_, box', _)} _) = box' { + Box.min = size', Box.max = size', Box.size = size', Box.nat = size + } where + size' = mapSizeX fromDouble $ mapSizeY fromDouble size + size = mapSizeX (subtract $ hSpace box) $ mapSizeY (subtract $ vSpace box)$ + mapSizeX toDouble $ mapSizeY toDouble $ fragmentSize self + box = mapX' toDouble $ mapY' toDouble box' +treeBox self@(Leaf Fragment { fragmentUserData = (_, box', _)}) = box' { + Box.min = size', Box.max = size', Box.size = size', Box.nat = size + } where + size' = mapSizeX fromDouble $ mapSizeY fromDouble size + size = mapSizeX (subtract $ hSpace box) $ mapSizeY (subtract $ vSpace box) $ + mapSizeX toDouble $ mapSizeY toDouble $ fragmentSize self + box = mapX' toDouble $ mapY' toDouble box' + -- | Variant of `fragmentSize` asserting to the typesystem that both fields -- of the resulting `Size` are of the same type. fragmentSize' :: CastDouble x => FragmentTree (a, PaddedBox x x, c) -> Size x x -- 2.30.2