1 files changed, 31 insertions(+), 0 deletions(-)

M Graphics/Layout.hs

@@ 292,6 292,37 @@ boxHeight parent (LayoutInline val font self' vals) =
 boxHeight _ (LayoutSpan val font self') =
     (B.block $ fragmentSize' font self', LayoutSpan val font self')
 
+boxSplit :: 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)
+    | (next:_) <- childs1, ((y,_):_) <- childs0',
+        (tail,Just nextpage) <- boxSplit (maxheight - y) pageheight next =
+            (LayoutFlow val self {
+                size = (size self) { B.block = y }
+            } (childs0 ++ [tail]),
+             Just $ LayoutFlow val self {
+                size = (size self) { B.block = B.block (size self) - y }
+             } (nextpage:childs1))
+    | otherwise =
+        (LayoutFlow val self { size = (size self) { B.block = maxheight } } childs0,
+         Just $ LayoutFlow val self childs1) -- TODO recompute height
+  where
+    childs0 = map snd childs0'
+    childs1 = map snd childs1'
+    (childs0', childs1') = break overflowed $ inner 0 childs
+    overflowed (y, _) = y >= maxheight
+    inner start (child:childs) = (start', child):inner start' childs -- TODO margin collapse?
+        where start' = start + height (layoutGetBox child)
+    inner _ [] = []
+boxSplit _ _ self@(LayoutGrid _ _ _) = (self, Nothing) -- TODO
+boxSplit _ _ self@(LayoutInline _ _ _ _) = (self, Nothing) -- TODO
+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 ->
     LayoutItem Double Double ((Double, Double), x)
 boxPosition pos@(x, y) (LayoutFlow val self childs) = LayoutFlow (pos, val) self childs'