From 074d5d9c1b8ad4db9d357fcce9076bd49413c4d9 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Thu, 23 Feb 2023 15:49:18 +1300
Subject: [PATCH] Finish drafting CSS4 Grid support!

---
 Graphics/Layout/Grid.hs | 132 ++++++++++++++++++++++++++++++++++------
 1 file changed, 115 insertions(+), 17 deletions(-)

diff --git a/Graphics/Layout/Grid.hs b/Graphics/Layout/Grid.hs
index abedd1a..87d5fe8 100644
--- a/Graphics/Layout/Grid.hs
+++ b/Graphics/Layout/Grid.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE RecordWildCards #-}
 module Graphics.Layout.Grid where
 
 import Data.Text (Text)
@@ -12,17 +13,27 @@ data Grid m n = Grid {
 }
 data GridItem m n = GridItem {
     startRow :: Int, endRow :: Int, startCol :: Int, endCol :: Int,
+    alignment :: Size Alignment Alignment,
     gridItemBox :: PaddedBox m n
 }
+data Alignment = Start | Mid | End
 
 type Name = Text
 
 cellsForCol :: [GridItem y x] -> Int -> [GridItem y x]
 cellsForCol cells ix =
-    [cell | cell <- cells, startCol cell == ix, startCol cell /= endCol cell]
+    [cell | cell <- cells, startCol cell == ix, startCol cell /= succ (endCol cell)]
 cellsForRow :: [GridItem y x] -> Int -> [GridItem y x]
 cellsForRow cells ix =
-    [cell | cell <- cells, startRow cell == ix, startRow cell /= endRow cell]
+    [cell | cell <- cells, startRow cell == ix, startRow cell /= succ (endRow cell)]
+verifyGrid self childs = and [
+    startRow < width && startRow >= 0 && endRow < width && endRow >= 0 &&
+    endCol > startCol && endRow > startRow &&
+    startCol < height && startCol >= 0 && endCol < height && endCol >= 0 |
+    GridItem {..} <- childs]
+  where
+    width = length $ columns self
+    height = length $ rows self
 
 {-gridEstWidth :: Grid y Length -> [GridItem y Double] -> Double-}
 gridMinWidths :: Double -> Grid y Length -> [GridItem y Double] -> (Double, [Double])
@@ -33,9 +44,9 @@ gridMinWidths parent self childs =
     colMinWidth (_, Left (Pixels x)) = x
     colMinWidth (_, Left (Percent x)) = x * parent
     colMinWidth arg@(ix, Left Preferred) =
-        maximum $ map (inline . size . gridItemBox) $ cellsForCol childs ix
+        maximum $ (0:) $ map (inline . size . gridItemBox) $ cellsForCol childs ix
     colMinWidth (ix, _) =
-        maximum $ map (inline . B.min . gridItemBox) $ cellsForCol childs ix
+        maximum $ (0:) $ map (inline . B.min . gridItemBox) $ cellsForCol childs ix
 gridNatWidths :: Double -> Grid y Length -> [GridItem y Double] -> (Double, [Double])
 gridNatWidths parent self childs =
     (sum $ intersperse (lowerLength parent $ inline $ gap self) ret, ret)
@@ -44,9 +55,9 @@ gridNatWidths parent self childs =
     colNatWidth (_, Left (Pixels x)) = x
     colNatWidth (_, Left (Percent x)) = x * parent
     colNatWidth arg@(ix, Left Min) =
-        maximum $ map (inline . B.min . gridItemBox) $ cellsForCol childs ix
+        maximum $ (0:) $ map (inline . B.min . gridItemBox) $ cellsForCol childs ix
     colNatWidth (ix, _) =
-        maximum $ map (inline . size . gridItemBox) $ cellsForCol childs ix
+        maximum $ (0:) $ map (inline . size . gridItemBox) $ cellsForCol childs ix
 gridMaxWidths :: PaddedBox y Double -> Grid y Length -> [(Double, Double)] -> (Double, [Double])
 gridMaxWidths parent self subwidths =
     (sum $ intersperse (lowerLength outerwidth $ inline $ gap self) ret, ret)
@@ -57,22 +68,109 @@ gridMaxWidths parent self subwidths =
     estimate = sum $ intersperse (lowerLength outerwidth $ inline $ gap self) $
         map (colMaxWidth 0) $ zip subwidths $ map snd $ columns self
     colMaxWidth _ (_, Left (Pixels x)) = x
-    colMaxWidth _ (_, Left (Percent x)) = x
+    colMaxWidth _ (_, Left (Percent x)) = x*(inline $ size parent)
     colMaxWidth _ ((_, nat), Left Preferred) = nat
     colMaxWidth _ ((min, _), Left Min) = min
     colMaxWidth fr (_, Left Auto) = fr
     colMaxWidth fr (_, Right x) = x*fr
-    countFRs (Left Auto:rest) = succ $ countFRs rest
-    countFRs (Right x:rest) = x + countFRs rest
-    countFRs [] = 0
-{-gridWidths :: PaddedBox y Double -> Grid y Length -> (Double, [Double])
-gridNatHeights :: PaddedBox Length Double -> [GridItem Length Double] -> (Double, [Double])
-gridMinHeights :: Double -> Grid Length Double -> (Double, [Double])
-gridMaxHeights :: Double -> Grid Length Double -> (Double, [Double])
-gridHeights :: Double -> Grid Length Double -> (Double, [Double])
-gridPosition :: GridLength Double Double -> [GridItem Double Double] -> [Size Double Double]
-gridLayout :: PaddedBox Double Double -> Grid Length Length ->
+gridWidths :: PaddedBox y Double -> Grid y Length -> [(Double, Double)] -> (Double, [Double])
+gridWidths parent self subwidths =
+    (sum $ intersperse (lowerLength outerwidth $ inline $ gap self) ret, ret)
+  where
+    ret = map (colWidth fr) $ zip subwidths $ map snd $ columns self
+    fr = (outerwidth - estimate)/(countFRs $ map snd $ columns self)
+    outerwidth = inline $ size parent
+    estimate = sum $ intersperse (lowerLength outerwidth $ inline $ gap self) $
+        map (colWidth 0) $ zip subwidths $ map snd $ columns self
+    colWidth fr ((min, nat), size) = Prelude.min min $ colWidth' fr ((min, nat), size)
+    colWidth' _ (_, Left (Pixels x)) = x
+    colWidth' _ (_, Left (Percent x)) = x*(inline $ size parent)
+    colWidth' _ ((_, nat), Left Preferred) = nat
+    colWidth' _ ((min, _), Left Min) = min
+    colWidth' fr (_, Left Auto) = fr
+    colWidth' fr (_, Right x) = x*fr
+
+gridNatHeights :: Double -> Grid Length Double -> [GridItem Double Double] -> (Double, [Double])
+gridNatHeights parent self childs =
+    (sum $ intersperse (lowerLength parent $ block $ gap self) ret, ret)
+  where
+    ret = map rowNatHeight $ enumerate $ map snd $ rows self
+    rowNatHeight (_, Left (Pixels x)) = x
+    rowNatHeight (_, Left (Percent x)) = x * parent
+    rowNatHeight arg@(ix, Left Min) =
+        maximum $ (0:) $ map (block . B.min . gridItemBox) $ cellsForCol childs ix
+    rowNatHeight (ix, _) =
+        maximum $ (0:) $ map (block . size . gridItemBox) $ cellsForCol childs ix
+gridMinHeights :: Double -> Grid Length Double -> [GridItem Double Double] -> (Double, [Double])
+gridMinHeights parent self childs =
+    (sum $ intersperse (lowerLength parent $ block $ gap self) ret, ret)
+  where
+    ret = map rowMinHeight $ enumerate $ map snd $ rows self
+    rowMinHeight (_, Left (Pixels x)) = x
+    rowMinHeight (_, Left (Percent x)) = x * parent
+    rowMinHeight arg@(ix, Left Preferred) =
+        maximum $ (0:) $ map (block . size . gridItemBox) $ cellsForCol childs ix
+    rowNatHeight (ix, _) =
+        maximum $ (0:) $ map (block . B.min . gridItemBox) $ cellsForCol childs ix
+gridMaxHeights :: PaddedBox Double Double -> Grid Length Double ->
+    [(Double, Double)] -> (Double, [Double])
+gridMaxHeights parent self subheights = (sum $ intersperse (inline $ gap self) ret, ret)
+  where
+    ret = map (colMaxHeight fr) $ zip subheights $ map snd $ rows self
+    fr = (outerheight - estimate)/(countFRs $ map snd $ rows self)
+    outerwidth = inline $ size parent
+    outerheight = block $ size parent
+    estimate = sum $ intersperse (inline $ gap self) $
+        map (colMaxHeight 0) $ zip subheights $ map snd $ rows self
+    colMaxHeight _ (_, Left (Pixels x)) = x
+    colMaxHeight _ (_, Left (Percent x)) = x*outerwidth
+    colMaxHeight _ ((_, nat), Left Preferred) = nat
+    colMaxHeight _ ((min, _), Left Min) = min
+    colMaxHeight fr (_, Left Auto) = fr
+    colMaxHeight fr (_, Right x) = x*fr
+gridHeights :: PaddedBox Double Double -> Grid Length Double ->
+    [(Double, Double)] -> (Double, [Double])
+gridHeights parent self subheights = (sum $ intersperse (inline $ gap self) ret, ret)
+  where
+    ret = map (colHeight fr) $ zip subheights $ map snd $ rows self
+    fr = (outerheight - estimate)/(countFRs $ map snd $ rows self)
+    outerwidth = inline $ size parent
+    outerheight = block $ size parent
+    estimate = sum $ intersperse (inline $ gap self) $
+        map (colHeight 0) $ zip subheights $ map snd $ rows self
+    colHeight fr ((min, nat), size) = Prelude.min min $ colHeight' fr ((min, nat), size)
+    colHeight' _ (_, Left (Pixels x)) = x
+    colHeight' _ (_, Left (Percent x)) = x*outerwidth
+    colHeight' _ ((_, nat), Left Preferred) = nat
+    colHeight' _ ((min, _), Left Min) = min
+    colHeight' fr ((_, nat), Left Auto) = Prelude.min fr nat
+    colHeight' fr (_, Right x) = x*fr
+
+gridPosition :: Grid Double Double -> [GridItem Double Double] -> [Size Double Double]
+gridPosition self childs = map gridCellPosition childs
+  where
+    gridCellPosition child =
+        Size (x + align extraWidth alignX) (y + align extraHeight alignY)
+      where
+        Size x y = gridCellPosition' child
+        Size alignX alignY = alignment child
+        width = track (endCol child) (columns self) - track (startCol child) (columns self)
+        height = track (endRow child) (rows self) - track (startRow child) (columns self)
+        extraWidth = width - inline (size $ gridItemBox child)
+        extraHeight = height - block (size $ gridItemBox child)
+    gridCellPosition' child =
+        Size (startCol child `track` columns self) (startRow child `track` rows self)
+    track ix sizes | Right x <- map snd sizes !! ix = x -- Might error out if poorly-formed.
+        | otherwise = 0
+    align _ Start = 0
+    align excess Mid = excess/2
+    align excess End = excess
+{-gridLayout :: PaddedBox Double Double -> Grid Length Length ->
         [GridItem Length Length] -> Bool ->
         (Grid Double Double, [(Size Double Double, GridItem Double Double)])-}
 
 enumerate = zip [0..]
+
+countFRs (Left Auto:rest) = succ $ countFRs rest
+countFRs (Right x:rest) = x + countFRs rest
+countFRs [] = 0
-- 
2.30.2