3 files changed, 51 insertions(+), 31 deletions(-)

M Graphics/Layout/CSS.hs
A Graphics/Layout/Grid/Table.hs
M cattrap.cabal

@@ 18,6 18,7 @@ import Graphics.Layout.CSS.Length
 import Graphics.Layout.CSS.Font
 import Graphics.Layout.Grid.CSS
 import Graphics.Layout.Grid
+import Graphics.Layout.Grid.Table
 import Graphics.Layout.Inline.CSS
 
 import Data.Char (isSpace)


@@ 154,32 155,32 @@ finalizeTable root parent val childs = LayoutGrid val grid cells' childs'
       }
     (cells', childs') = unzip cells
 
-    (cells, width, height) = lowerCells childs 0
-    lowerCells (StyleTree self@CSSBox { display = TableRow } cells:rest) h =
+    (cells, width, height) = lowerCells childs 0 emptyRow
+    lowerCells (StyleTree self@CSSBox { display = TableRow } cells:rest) h x =
         (row ++ rows, Prelude.max rowwidth width', height')
       where
-        (row, rowwidth) = lowerRow cells 0 h -- FIXME: How to dodge rowspans?
-        (rows, width', height') = lowerCells rest $ succ h
-    lowerCells (StyleTree CSSBox { display = TableHeaderGroup } childs:rest) h =
+        (row, rowwidth, x') = lowerRow cells 0 h x
+        (rows, width', height') = lowerCells rest (succ h) $ commitRow x'
+    lowerCells (StyleTree CSSBox { display = TableHeaderGroup } childs:rest) h x =
         -- Ignore table-header-group styles for now...
         -- Though it'd be nice for this to impact pagination...
-        lowerCells (childs ++ rest) h
-    lowerCells (StyleTree CSSBox { display = TableFooterGroup } childs:rest) h =
-        lowerCells (childs ++ rest) h -- As per TableHeaderGroup
-    lowerCells (StyleTree CSSBox { display = TableRowGroup } childs:rest) h =
-        lowerCells (childs ++ rest) h -- As per TableHeaderGroup
-    lowerCells (StyleTree CSSBox { display = TableColumnGroup } _:rest) h =
-        lowerCells rest h -- It'd be nice to allow styling based on this...
-    lowerCells (StyleTree CSSBox { display = TableColumn } _:rest) h =
-        lowerCells rest h -- As per TableColumnGroup, should be contained within.
-    lowerCells (StyleTree CSSBox { display = TableCaption } _:rest) h =
-        lowerCells rest h -- Handled by callers!
-    lowerCells [] h = ([], 0, h)
-    lowerCells items h = (row ++ rows, Prelude.max rowwidth width', height')
+        lowerCells (childs ++ rest) h x
+    lowerCells (StyleTree CSSBox { display = TableFooterGroup } childs:rest) h x =
+        lowerCells (childs ++ rest) h x -- As per TableHeaderGroup
+    lowerCells (StyleTree CSSBox { display = TableRowGroup } childs:rest) h x =
+        lowerCells (childs ++ rest) h x -- As per TableHeaderGroup
+    lowerCells (StyleTree CSSBox { display = TableColumnGroup } _:rest) h x =
+        lowerCells rest h x -- It'd be nice to allow styling based on this...
+    lowerCells (StyleTree CSSBox { display = TableColumn } _:rest) h x =
+        lowerCells rest h x -- As per TableColumnGroup, should be contained within.
+    lowerCells (StyleTree CSSBox { display = TableCaption } _:rest) h x =
+        lowerCells rest h x -- Handled by callers!
+    lowerCells [] h _ = ([], 0, h)
+    lowerCells items h x = (row ++ rows, Prelude.max rowwidth width', height')
       where
         (cells, rest) = break isRowGroup items
-        (row, rowwidth) = lowerRow cells 0 h -- FIXME: How to dodge rowspans?
-        (rows, width', height') = lowerCells rest $ succ h
+        (row, rowwidth, x') = lowerRow cells 0 h x
+        (rows, width', height') = lowerCells rest (succ h) $ commitRow x'
         isRowGroup (StyleTree CSSBox { display = TableRow } _) = True
         isRowGroup (StyleTree CSSBox { display = TableHeaderGroup } _) = True
         isRowGroup (StyleTree CSSBox { display = TableFooterGroup } _) = True


@@ 187,20 188,22 @@ finalizeTable root parent val childs = LayoutGrid val grid cells' childs'
         isRowGroup (StyleTree CSSBox { display = TableCaption } _) = True
         isRowGroup _ = False
 
-    lowerRow (StyleTree self'@CSSBox { display = TableCell } childs:rest) ix row =
-        (cell:cells, width)
+    lowerRow (StyleTree self'@CSSBox {display=TableCell} childs:rest) ix row x =
+        (cell:cells, width, x')
       where
-        (cells, width) = lowerRow rest end row
-        end = ix + colspan self'
+        (cells, width, x') = lowerRow rest end row $
+            insertCell start (colspan self') (rowspan self') x
+        start = allocCol ix x
+        end = start + colspan self'
         -- TODO: Add alignment support!
-        cell = (GridItem ix end Start 0 0
+        cell = (GridItem start end Start 0 0
                 `Size` GridItem row (row + rowspan self') Start 0 0,
             finalizeCSS root parent $ StyleTree self' { display = Block } childs)
-    lowerRow (self:rest) ix row = (cell:cells, width)
+    lowerRow (self:rest) ix row x = (cell:cells, width, x')
       where
-        (ix', row') = (fromEnum ix, fromEnum row)
-        (cells, width) = lowerRow rest (succ ix) row
+        ix' = allocCol ix x
+        (cells, width, x') = lowerRow rest (succ ix') row $ insertCell ix' 1 1 x
         cell = (GridItem ix' (succ ix') Start 0 0
-                `Size` GridItem row' (succ row') Start 0 0,
+                `Size` GridItem row (succ row) Start 0 0,
             finalizeCSS root parent self)
-    lowerRow [] ix _ = ([], ix)
+    lowerRow [] ix _ x = ([], ix, x)

@@ 0,0 1,17 @@
+module Graphics.Layout.Grid.Table where
+
+type Overflowed = [Int]
+
+emptyRow :: Overflowed
+emptyRow = []
+
+commitRow :: Overflowed -> Overflowed
+commitRow = map $ max 0 . pred
+
+allocCol :: Int -> Overflowed -> Int
+allocCol ix cols = ix + length (span (> 0) $ drop ix cols)
+
+insertCell :: Int -> Int -> Int -> Overflowed -> Overflowed
+insertCell ix colspan rowspan cols =
+    before ++ replicate colspan rowspan ++ drop colspan after
+  where (before, after) = splitAt ix cols

@@ 27,7 27,7 @@ library
                         Graphics.Layout.Box, Graphics.Layout.Arithmetic,
                         Graphics.Layout.CSS.Length, Graphics.Layout.CSS.Font,
                         Graphics.Layout.Inline, Graphics.Layout.Inline.CSS
-  other-modules:        Graphics.Layout.CSS.Parse
+  other-modules:        Graphics.Layout.CSS.Parse, Graphics.Layout.Grid.Table
   -- other-extensions:
   build-depends:       base >=4.12 && <5, containers, parallel >= 3,
                         css-syntax, scientific, text, deepseq,