From 0eabb5958ef005e5b25651b4520bd033f642d59f Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Mon, 30 Oct 2023 15:15:07 +1300 Subject: [PATCH] Implement table layout. --- Graphics/Layout/CSS.hs | 63 ++++++++++++++++++----------------- Graphics/Layout/Grid/Table.hs | 17 ++++++++++ cattrap.cabal | 2 +- 3 files changed, 51 insertions(+), 31 deletions(-) create mode 100644 Graphics/Layout/Grid/Table.hs diff --git a/Graphics/Layout/CSS.hs b/Graphics/Layout/CSS.hs index b4d8145..7658682 100644 --- a/Graphics/Layout/CSS.hs +++ b/Graphics/Layout/CSS.hs @@ -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) diff --git a/Graphics/Layout/Grid/Table.hs b/Graphics/Layout/Grid/Table.hs new file mode 100644 index 0000000..4618e6f --- /dev/null +++ b/Graphics/Layout/Grid/Table.hs @@ -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 diff --git a/cattrap.cabal b/cattrap.cabal index 12e19f7..9529f8f 100644 --- a/cattrap.cabal +++ b/cattrap.cabal @@ -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, -- 2.30.2