2 files changed, 49 insertions(+), 14 deletions(-)

M Graphics/Layout.hs
M Graphics/Layout/Inline.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

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