3 files changed, 67 insertions(+), 24 deletions(-)

M Graphics/Layout.hs
M Graphics/Layout/CSS.hs
M Graphics/Layout/Inline.hs

@@ 5,7 5,9 @@ module Graphics.Layout(LayoutItem(..),
         boxNatHeight, boxMinHeight, boxMaxHeight, boxHeight,
         boxSplit, boxPaginate, boxPosition, boxLayout, glyphsPerFont) where
 
-import Data.Text.ParagraphLayout (Paragraph(..), ParagraphOptions(..), PageOptions(..), Fragment(..))
+import Data.Text.ParagraphLayout (Paragraph(..), ParagraphOptions(..), Fragment(..),
+        ParagraphLayout(..), PageOptions(..), PageContinuity(..), paginate, layoutPlain)
+import Stylist (PropertyParser(..))
 
 import Graphics.Layout.Box as B
 import Graphics.Layout.Grid as G


@@ 25,8 27,11 @@ data LayoutItem m n x =
     LayoutFlow x (PaddedBox m n) [LayoutItem m n x]
     | LayoutGrid x (Grid m n) [(GridItem m n, LayoutItem m n x)]
     | LayoutInline x Font' Paragraph PageOptions [x] -- Balkon holds children.
+    | LayoutInline' x Font' ParagraphLayout PageOptions [x]
     | LayoutSpan x Font' Fragment
 -- More to come...
+nullLayout :: (PropertyParser x, Zero m, Zero n) => LayoutItem m n x
+nullLayout = LayoutFlow temp zero []
 
 layoutGetBox :: (Zero m, Zero n, CastDouble m, CastDouble n) =>
         LayoutItem m n x -> PaddedBox m n


@@ 36,9 41,12 @@ layoutGetBox (LayoutGrid _ self _) = zero {
     B.size = containerSize self,
     B.max = containerMax self
 }
-layoutGetBox (LayoutInline _ f self _) = zero {
+layoutGetBox (LayoutInline _ f self _ _) = zero {
     B.min = inlineMin f self, B.size = inlineSize f self, B.max = inlineSize f self
 }
+layoutGetBox (LayoutInline' _ f self _ _) = zero {
+    B.min = layoutSize f self, B.size = layoutSize f self, B.max = layoutSize f self
+}
 layoutGetBox (LayoutSpan _ f self) = zero {
     B.min = fragmentSize f self, B.size = fragmentSize f self, B.max = fragmentSize f self
 }


@@ 47,9 55,12 @@ layoutGetChilds (LayoutGrid _ _ ret) = map snd ret
 layoutGetChilds (LayoutSpan _ _ _) = []
 layoutGetChilds (LayoutInline _ font self _ vals) = map inner $ inlineChildren vals self
   where inner (val, fragment) = LayoutSpan val font fragment
+layoutGetChilds (LayoutInline' _ font self _ vals) = map inner $ layoutChildren vals self
+  where inner (val, fragment) = LayoutSpan val font fragment
 layoutGetInner (LayoutFlow ret _ _) = ret
 layoutGetInner (LayoutGrid ret _ _) = ret
 layoutGetInner (LayoutInline ret _ _ _ _) = ret
+layoutGetInner (LayoutInline' ret _ _ _ _) = ret
 layoutGetInner (LayoutSpan ret _ _) = ret
 
 setCellBox' (child, cell) = cell { gridItemBox = layoutGetBox child }


@@ 82,7 93,8 @@ boxMinWidth parent (LayoutGrid val self childs) = LayoutGrid val self' $ zip cel
         (GridItem {..}, _) <- childs]) parent
     zeroBox :: PaddedBox Double Double
     zeroBox = zero
-boxMinWidth _ self@(LayoutInline _ _ _ _) = self
+boxMinWidth _ self@(LayoutInline _ _ _ _ _) = self
+boxMinWidth _ self@(LayoutInline' _ _ _ _ _) = self
 boxMinWidth _ self@(LayoutSpan _ _ _) = self
 boxNatWidth :: (Zero y, CastDouble y) =>
         Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x


@@ 114,7 126,8 @@ boxNatWidth parent (LayoutGrid val self childs) = LayoutGrid val self' $ zip cel
         (GridItem {..}, _) <- childs]) parent
     zeroBox :: PaddedBox Double Double
     zeroBox = zero
-boxNatWidth _ self@(LayoutInline _ _ _ _) = self
+boxNatWidth _ self@(LayoutInline _ _ _ _ _) = self
+boxNatWidth _ self@(LayoutInline' _ _ _ _ _) = self
 boxNatWidth _ self@(LayoutSpan _ _ _) = self
 boxMaxWidth :: PaddedBox a Double -> LayoutItem y Length x -> LayoutItem y Length x
 boxMaxWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'


@@ 127,7 140,8 @@ boxMaxWidth parent (LayoutGrid val self childs) = LayoutGrid val self' childs
   where
     self' = self { containerMax = Size (Pixels max') (block $ containerMax self) }
     (max', _) = gridMaxWidths parent self $ colBounds self
-boxMaxWidth parent self@(LayoutInline _ _ _ _) = self
+boxMaxWidth parent self@(LayoutInline _ _ _ _ _) = self
+boxMaxWidth parent self@(LayoutInline' _ _ _ _ _) = self
 boxMaxWidth parent self@(LayoutSpan _ f self') = self
 boxWidth :: (Zero y, CastDouble y) => PaddedBox b Double -> LayoutItem y Length x ->
         LayoutItem y Double x


@@ 164,9 178,10 @@ boxWidth parent (LayoutGrid val self childs) = LayoutGrid val self' childs'
       }
     outerwidth = inline $ size parent
     (size', widths) = gridWidths parent self $ colBounds self
-boxWidth parent (LayoutInline val font (Paragraph a b c d) vals) =
-    LayoutInline val font (Paragraph a b c d { paragraphMaxWidth = round width }) vals
+boxWidth parent (LayoutInline val font (Paragraph a b c d) paging vals) =
+    LayoutInline val font (Paragraph a b c d { paragraphMaxWidth = round width }) paging vals
   where width = B.inline $ B.size parent
+boxWidth _ (LayoutInline' a b c d e) = LayoutInline' a b c d e
 boxWidth parent (LayoutSpan val font self') = LayoutSpan val font self'
 
 boxNatHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x


@@ 188,7 203,8 @@ boxNatHeight parent (LayoutGrid val self childs) = LayoutGrid val self' $ zip ce
     cells = map setCellBox' $ zip childs' $ map fst childs
     childs' = map (boxNatHeight width) $ map snd childs
     width = inline $ containerSize self
-boxNatHeight parent self@(LayoutInline _ _ _ _) = self
+boxNatHeight parent self@(LayoutInline _ _ _ _ _) = self
+boxNatHeight parent self@(LayoutInline' _ _ _ _ _) = self
 boxNatHeight parent self@(LayoutSpan _ _ _) = self
 boxMinHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x
 boxMinHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs'


@@ 214,7 230,8 @@ boxMinHeight parent (LayoutGrid val self childs) = LayoutGrid val self' childs'
         startCol = startCol cell, endCol = endCol cell, alignment = alignment cell
       } | (cell, _) <- childs]
     width = inline $ containerSize self
-boxMinHeight parent self@(LayoutInline _ font self' _) = self
+boxMinHeight parent self@(LayoutInline _ _ _ _ _) = self
+boxMinHeight _ self@(LayoutInline' _ _ _ _ _) = self
 boxMinHeight parent self@(LayoutSpan _ font self') = self
 boxMaxHeight :: PaddedBox Double Double -> LayoutItem Length Double x ->
         LayoutItem Length Double x


@@ 242,7 259,10 @@ boxMaxHeight parent (LayoutGrid val self childs) = LayoutGrid val self' childs'
       }
     (max', heights) = gridMaxHeights parent self $ rowBounds self
     width = inline $ size parent
-boxMaxHeight parent (LayoutInline val font self' vals) = LayoutInline val font self' vals
+boxMaxHeight parent (LayoutInline val font self' paging vals) =
+    LayoutInline val font self' paging vals
+boxMaxHeight parent (LayoutInline' val font self' paging vals) =
+    LayoutInline' val font self' paging vals
 boxMaxHeight parent (LayoutSpan val font self') = LayoutSpan val font self'
 boxHeight :: PaddedBox Double Double -> LayoutItem Length Double x -> LayoutItem Double Double x
 boxHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs'


@@ 274,10 294,13 @@ boxHeight parent (LayoutGrid val self childs) = LayoutGrid val self' childs'
     lowerSize (Left x) = Left $ lowerLength width x
     lowerSize (Right x) = Right x
     width = inline $ size parent
-boxHeight parent (LayoutInline val font self' vals) = LayoutInline val font self' vals
+boxHeight parent (LayoutInline val font self' paging vals) =
+    LayoutInline val font self' paging vals
+boxHeight _ (LayoutInline' val font self' paging vals) =
+    LayoutInline' val font self' paging vals
 boxHeight _ (LayoutSpan val font self') = LayoutSpan val font self'
 
-boxSplit :: Double -> Double -> LayoutItem Double Double x ->
+boxSplit :: PropertyParser x => Double -> Double -> LayoutItem Double Double x ->
     (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
 boxSplit maxheight _ node | height (layoutGetBox node) <= maxheight = (node, Nothing)
 boxSplit maxheight pageheight (LayoutFlow val self childs)


@@ 301,14 324,24 @@ boxSplit maxheight pageheight (LayoutFlow val self childs)
         where start' = start + height (layoutGetBox child)
     inner _ [] = []
 boxSplit _ _ self@(LayoutGrid _ _ _) = (self, Nothing) -- TODO
-boxSplit _ _ self@(LayoutInline _ _ _ _) = (self, Nothing) -- TODO
+boxSplit maxheight pageheight (LayoutInline a b self c d) =
+    boxSplit maxheight pageheight $ LayoutInline' a b (layoutPlain self) c d
+boxSplit maxheight pageheight (LayoutInline' a b self paging c) =
+    case paginate paging {
+            pageCurrentHeight = toEnum $ fromEnum maxheight,
+            pageNextHeight = toEnum $ fromEnum pageheight
+      } self of
+        (Continue, self', next) -> (wrap self', wrap <$> next)
+        (Break, _, _) -> (nullLayout, Just $ wrap self)
+  where
+    wrap self' = LayoutInline' a b self' paging c
 boxSplit _ _ self@(LayoutSpan _ _ _) = (self, Nothing) -- Can't split!
 boxPaginate maxheight pageheight node
     | (page, Just overflow) <- boxSplit maxheight pageheight node =
         page:boxPaginate maxheight pageheight overflow
     | otherwise = [node]
 
-boxPosition :: (Double, Double) -> LayoutItem Double Double x ->
+boxPosition :: PropertyParser x => (Double, Double) -> LayoutItem Double Double x ->
     LayoutItem Double Double ((Double, Double), x)
 boxPosition pos@(x, y) (LayoutFlow val self childs) = LayoutFlow (pos, val) self childs'
   where


@@ 320,12 353,15 @@ boxPosition pos@(x, y) (LayoutGrid val self childs) = LayoutGrid (pos, val) self
     childs' = map recurse $ zip pos' childs
     recurse ((Size x' y'), (cell, child)) = (cell, boxPosition (x + x', y + y') child)
     pos' = gridPosition self $ map fst childs
-boxPosition pos@(x, y) (LayoutInline val font self vals) =
-    LayoutInline (pos, val) font self $ map (\(x, y) -> (fragmentPos font pos y, x)) $
+boxPosition pos@(x, y) (LayoutInline val font self paging vals) =
+    LayoutInline (pos, val) font self paging $ map (\(x, y) -> (fragmentPos font pos y, x)) $
             inlineChildren vals self
+boxPosition pos@(x, y) (LayoutInline' val font self paging vals) =
+    LayoutInline' (pos, val) font self paging $ map (\(x, y) -> (fragmentPos font pos y, x)) $
+            layoutChildren vals self
 boxPosition pos (LayoutSpan val f self) = LayoutSpan (pos, val) f self -- No children...
-boxLayout :: PaddedBox Double Double -> LayoutItem Length Length x -> Bool ->
-        LayoutItem Double Double ((Double, Double), x)
+boxLayout :: PropertyParser x => PaddedBox Double Double -> LayoutItem Length Length x ->
+        Bool -> LayoutItem Double Double ((Double, Double), x)
 boxLayout parent self paginate = self8
   where
     self0 = boxMinWidth Nothing self

@@ 215,15 215,16 @@ finalizeChilds root parent style' childs@(child:childs')
         -- FIXME propagate display properties, how to handle the hierarchy.
         -- NOTE: Playing around in firefox, it appears the CSS borders should cover
         -- their entire span, doubling up on borders where needed.
-        [LayoutInline (inherit style') parent self (repeat $ inherit style')]
+        [LayoutInline (inherit style') parent self paging (repeat $ inherit style')]
     | (inlines@(_:_), blocks) <- spanInlines childs,
         Just self <- finalizeParagraph (flattenTree inlines) parent  =
-            LayoutInline (inherit style') parent self (repeat $ inherit style') :
+            LayoutInline (inherit style') parent self paging (repeat $ inherit style') :
                 finalizeChilds root parent style' blocks
     | (StyleTree { style = CSSBox { display = Inline } }:childs') <- childs =
         finalizeChilds root parent style' childs' -- Inline's all whitespace...
     | otherwise = finalizeCSS root parent child : finalizeChilds root parent style' childs'
   where
+    paging = pageOptions $ style child
     isInlineTree = all isInlineTree0
     isInlineTree0 StyleTree { style = CSSBox { display = Inline }, children = childs } =
         isInlineTree childs

@@ 1,6 1,7 @@
 {-# LANGUAGE TupleSections #-}
 module Graphics.Layout.Inline(inlineMinWidth, inlineMin, inlineNatWidth, inlineHeight,
-    inlineSize, inlineChildren, fragmentSize, fragmentSize', fragmentPos) where
+    inlineSize, inlineChildren, layoutSize, layoutChildren,
+    fragmentSize, fragmentSize', fragmentPos) where
 
 import Data.Text.ParagraphLayout (Paragraph(..), ParagraphOptions(..),
                                     SpanLayout(..), Fragment(..),


@@ 29,10 30,15 @@ inlineHeight font width self =
     hbScale' font $ height $ layoutPlain' self $ round (hbScale font * width)
 
 inlineSize :: (CastDouble x, CastDouble y) => Font' -> Paragraph -> Size x y
-inlineSize font self = Size (c font $ width r) (c font $ height r)
-  where r = paragraphRect $ layoutPlain self
+inlineSize font self = layoutSize font $ layoutPlain self
 inlineChildren :: [x] -> Paragraph -> [(x, Fragment)]
-inlineChildren vals self = zip vals $ concat $ map inner $ spanLayouts $ layoutPlain self
+inlineChildren vals self = layoutChildren vals $ layoutPlain self
+
+layoutSize :: (CastDouble x, CastDouble y) => Font' -> ParagraphLayout -> Size x y
+layoutSize font self = Size (c font $ width r) (c font $ height r)
+  where r = paragraphRect self
+layoutChildren :: [x] -> ParagraphLayout -> [(x, Fragment)]
+layoutChildren vals self = zip vals $ concat $ map inner $ spanLayouts self
   where inner (SpanLayout y) = y
 
 layoutPlain' :: Paragraph -> Int32 -> Rect Int32