From c06fd5523fd9a30b1da5cb86bc6f862715b0b5d2 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Tue, 21 Feb 2023 16:23:07 +1300 Subject: [PATCH] Test & fix block layout. --- Graphics/Layout.hs | 4 +-- Graphics/Layout/Box.hs | 24 ++++++++++++- Graphics/Layout/CSS.hs | 3 +- Graphics/Layout/Flow.hs | 67 ++++++++++++++++++---------------- Graphics/Layout/Grid.hs | 4 +-- test/Test.hs | 79 ++++++++++++++++++++++++++++++++++++++--- 6 files changed, 139 insertions(+), 42 deletions(-) diff --git a/Graphics/Layout.hs b/Graphics/Layout.hs index 0c0f9da..c42026d 100644 --- a/Graphics/Layout.hs +++ b/Graphics/Layout.hs @@ -8,7 +8,7 @@ data LayoutItem m n x = | LayoutGrid x (Grid m n) [(GridItem m n, LayoutItem m n x)] -- More to come... -boxMinWidth :: Double -> LayoutItem y Length x -> (Double, LayoutItem y Length x) +{-boxMinWidth :: Double -> LayoutItem y Length x -> (Double, LayoutItem y Length x) boxNatWidth :: Double -> LayoutItem y Length x -> (Double, LayoutItem y Length x) boxMaxWidth :: PaddedBox y Length -> LayoutItem y Length x -> (Double, LayoutItem y Length x) boxWidth :: PaddedBox y Length -> LayoutItem y Length x -> (Double, LayoutItem y Double x) @@ -18,4 +18,4 @@ boxMaxHeight :: Double -> LayoutItem Length Double x -> (Double, LayoutItem Leng boxHeight :: Double -> LayoutItem Length Double x -> (Double, LayoutItem Length Length x) boxPosition :: LayoutItem Double Double x -> LayoutItem Double Double x boxLayout :: PaddedBox Double Double -> LayoutItem Length Length x -> Bool -> - LayoutItem Double Double x + LayoutItem Double Double x-} diff --git a/Graphics/Layout/Box.hs b/Graphics/Layout/Box.hs index 28743ba..19084d5 100644 --- a/Graphics/Layout/Box.hs +++ b/Graphics/Layout/Box.hs @@ -19,6 +19,24 @@ data PaddedBox m n = PaddedBox { border :: Border m n, margin :: Border m n } +zeroBox :: PaddedBox Double Double +zeroBox = PaddedBox { + min = Size 0 0, + max = Size 0 0, + size = Size 0 0, + padding = Border 0 0 0 0, + border = Border 0 0 0 0, + margin = Border 0 0 0 0 + } +lengthBox = PaddedBox { + min = Size Auto Auto, + max = Size Auto Auto, + size = Size Auto Auto, + padding = Border zero zero zero zero, + border = Border zero zero zero zero, + margin = Border zero zero zero zero + } where zero = Pixels 0 + width PaddedBox {..} = left margin + left border + left padding + inline size + right padding + right border + right margin height PaddedBox {..} = top margin + top border + top padding + @@ -27,5 +45,9 @@ minWidth PaddedBox {..} = left margin + left border + left padding + inline min + right padding + right border + right margin minHeight PaddedBox {..} = top margin + top border + top padding + block min + bottom padding + bottom border + bottom margin +maxWidth PaddedBox {..} = left margin + left border + left padding + + inline max + right padding + right border + right margin +maxHeight PaddedBox {..} = top margin + top border + top padding + + block max + bottom padding + bottom border + bottom margin -data Length = Pixels Double | Percent Double | Auto | Preferred | Min +data Length = Pixels Double | Percent Double | Auto | Preferred | Min deriving Eq diff --git a/Graphics/Layout/CSS.hs b/Graphics/Layout/CSS.hs index e8d2bbb..aa6bc6f 100644 --- a/Graphics/Layout/CSS.hs +++ b/Graphics/Layout/CSS.hs @@ -5,11 +5,12 @@ import Graphics.Layout data CSSBox = CSSBox { boxSizing :: BoxSizing, - cssBox :: PaddedBox (Double, String) -- Some units need to be resolved per font. calc()? + cssBox :: PaddedBox Unitted Unitted -- Some units need to be resolved per font. calc()? -- Other layout-mode specific properties? -- Resolve font here so we can resolve those units? } data BoxSizing = BorderBox | ContentBox +type Unitted = (Double, String) {-instance PropertyParser CSSBox where ... diff --git a/Graphics/Layout/Flow.hs b/Graphics/Layout/Flow.hs index 0ce675c..e50014b 100644 --- a/Graphics/Layout/Flow.hs +++ b/Graphics/Layout/Flow.hs @@ -2,40 +2,41 @@ module Graphics.Layout.Flow where import Graphics.Layout.Box as B -flowMinWidth :: Double -> PaddedBox _ Length -> [PaddedBox _ Length] -> Double +flowMinWidth :: Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double flowMinWidth _ PaddedBox {B.min = Size (Pixels x) _} _ = x flowMinWidth parent PaddedBox {B.min = Size (Percent x) _} _ = x * parent flowMinWidth parent self@PaddedBox {B.min = Size Preferred _} childs = flowNatWidth parent self childs -flowMinWidth _ _ childs = Prelude.max [ - minWidth $ child {B.min = flowMinWidth 0 child []} | child <- childs - ] -flowNatWidth :: Double -> PaddedBox _ Length -> [PaddedBox _ Length] -> Double +flowMinWidth _ _ childs = maximum $ (0:) $ map minWidth childs +flowNatWidth :: Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double flowNatWidth _ PaddedBox {size = Size (Pixels x) _} _ = x flowNatWidth parent PaddedBox {size = Size (Percent x) _} _ = x * parent flowNatWidth parent self@PaddedBox {size = Size Min _, B.min = Size x _} childs -- Avoid infinite loops! - | x /= Preferred = flowMinWidth parent self child -flowNatWidth parent _ childs = Prelude.max [ - width $ child {B.width = flowNatWidth 0 child []} | child <- childs - ] -flowMaxWidth :: PaddedBox _ Double -> PaddedBox _ Length -> Double + | x /= Preferred = flowMinWidth parent self childs +flowNatWidth parent _ childs = maximum $ (0:) $ map maxWidth childs +flowMaxWidth :: PaddedBox a Double -> PaddedBox b Length -> Double flowMaxWidth _ PaddedBox {B.max = Size (Pixels x) _} = x -flowMaxWidth parent PaddedBox {B.max = Size (Percent x) _} = x * parent -flowMaxWidth parent PaddedBox {B.max = Size Auto _} = inline $ size parent +flowMaxWidth parent PaddedBox {B.max = Size (Percent x) _} = x * (inline $ size parent) +flowMaxWidth parent self@PaddedBox {B.max = Size Auto _} = inline (size parent) - ws + where + ws = l2d (left $ margin self) + l2d (left $ border self) + l2d (left $ padding self) + + l2d (right $ padding self) + l2d (right $ border self) + l2d (right $ margin self) + l2d = lowerLength $ inline $ size parent flowMaxWidth parent self@PaddedBox {B.max = Size Preferred _} = flowNatWidth (inline $ size parent) self [] flowMaxWidth parent self@PaddedBox {B.max = Size Min _} = flowMinWidth (inline $ B.min parent) self [] -flowWidth :: PaddedBox _ Double -> PaddedBox _ Length -> Double +flowWidth :: PaddedBox a Double -> PaddedBox b Length -> Double flowWidth parent self | small > large = small | natural > large = large + | inline (size self) == Auto = large -- specialcase | natural >= small = natural | otherwise = small where small = flowMinWidth (inline $ B.min parent) self [] - natural = flowNatWidth (inline $ width parent) self [] + natural = flowNatWidth (inline $ size parent) self [] large = flowMaxWidth parent self flowNatHeight :: Double -> PaddedBox Length Double -> [PaddedBox Double Double] -> Double @@ -44,16 +45,16 @@ flowNatHeight parent PaddedBox {size = Size _ (Percent y)} _ = y * parent flowNatHeight _ PaddedBox {size = Size _ Min} childs = sum $ map minHeight $ marginCollapse childs flowNatHeight _ PaddedBox {size = Size owidth _} childs = - sum $ map height $ marginCollapse (lowerLength owidth) childs + sum $ map height $ marginCollapse childs flowMinHeight :: Double -> PaddedBox Length Double -> Double flowMinHeight _ PaddedBox {B.min = Size _ (Pixels y)} = y flowMinHeight parent PaddedBox {B.min = Size _ (Percent y)} = y * parent -flowMinHeight _ self = flowNatHeight self [] +flowMinHeight parent self = flowNatHeight parent self [] flowMaxHeight :: Double -> PaddedBox Length Double -> Double flowMaxHeight _ PaddedBox {B.max = Size _ (Pixels y)} = y flowMaxHeight parent PaddedBox {B.max = Size _ (Percent y)} = y * parent flowMaxHeight parent PaddedBox {B.max = Size _ Auto} = parent -flowMaxHeight _ self@PaddedBox {B.max = Size _ Preferred} = flowNatHeight self [] +flowMaxHeight parent self@PaddedBox {B.max = Size _ Preferred} = flowNatHeight parent self [] flowMaxHeight parent self@PaddedBox {B.max = Size _ Min} = flowMinHeight parent self flowHeight :: PaddedBox Double Double -> PaddedBox Length Double -> Double flowHeight parent self @@ -64,21 +65,21 @@ flowHeight parent self where small = flowMinHeight (block $ B.min parent) self natural = flowNatHeight (block $ size parent) self [] - large = flowMaxWidth (block $ B.max parent) self + large = flowMaxHeight (block $ B.max parent) self positionFlow :: [PaddedBox Double Double] -> [Size Double Double] -positionFlow childs = scanl inner (Size 0 0) $ marginCollapse id childs +positionFlow childs = scanl inner (Size 0 0) $ marginCollapse childs where inner (Size x y) self = Size x $ height self layoutFlow :: PaddedBox Double Double -> PaddedBox Length Length -> - [PaddedBox Length Length] -> Bool -> - [(PaddedBox Double Double, [(Size Double Double, PaddedBox Double Double)])] + [PaddedBox Length Double] -> Bool -> + (PaddedBox Double Double, [(Size Double Double, PaddedBox Double Double)]) layoutFlow parent self childs paginate = (self', zip positions' childs') where positions' = positionFlow childs' childs' = map layoutZooko childs self' = self0 { B.min = (B.min self0) { block = flowMinHeight (block $ B.min parent) self0 }, - size = (size self0) { block = flowHeight oheight self0 }, + size = (size self0) { block = flowHeight parent self0 }, B.max = (B.max self0) { block = flowMaxHeight (block $ B.max parent) self0 }, padding = mapY (lowerLength owidth) $ padding self0, border = mapY (lowerLength owidth) $ border self0, @@ -91,28 +92,32 @@ layoutFlow parent self childs paginate = (self', zip positions' childs') size = (size self2) { inline = width' }, B.max = (B.max self2) { inline = flowMaxWidth parent self2 }, B.min = (B.min self2) { inline = flowMinWidth owidth self2 [] }, - padding = mapX (lowerLength owdith) $ padding self2, + padding = mapX (lowerLength owidth) $ padding self2, border = mapX (lowerLength owidth) $ border self2, margin = lowerMargin owidth (owidth - width') $ margin self2 } - width' = flowWidth parent self2 + width' = flowWidth parent self self2 = self { - size = (size self) { inline = Pixels $ flowNatWidth owidth self childs } + size = (size self) { inline = Pixels $ flowNatWidth owidth self childs }, B.min = (B.min self) { inline = Pixels $ flowMinWidth owidth self childs } } owidth = inline $ size parent oheight = block $ size parent layoutZooko child = child { - B.min = Size (flowMinWidth (inline $ B.min self') child []) - (flowMinHeight (block $ B.min self') child), - size = Size (flowWidth self' child) (flowHeight (block $ size self') child), - B.max = Size (flowMaxWidth self' child) (flowMaxHeight (block $ size self') child), + B.min = Size (inline $ B.min child) (flowMinHeight (block $ B.min self') child), + size = Size (inline $ size child) (flowHeight self' child), + B.max = Size (inline $ B.max child) (flowMaxHeight (block $ size self') child), + padding = mapY (lowerLength owidth) $ padding child, + border = mapY (lowerLength owidth) $ border child, + margin = mapY (lowerLength owidth) $ margin child } -marginCollapse cb (x'@PaddedBox {margin = xm@Border { bottom = x }}: +marginCollapse :: [PaddedBox Double n] -> [PaddedBox Double n] +marginCollapse (x'@PaddedBox {margin = xm@Border { bottom = x }}: y'@PaddedBox {margin = ym@Border { top = y}}:rest) - | cb x > cb y = x':marginCollapse (y' {margin = ym { top = 0 }}:rest) + | x > y = x':marginCollapse (y' {margin = ym { top = 0 }}:rest) | otherwise = x' { margin = xm { bottom = 0 }}:marginCollapse (y':rest) +marginCollapse rest = rest lowerLength :: Double -> Length -> Double lowerLength _ (Pixels x) = x diff --git a/Graphics/Layout/Grid.hs b/Graphics/Layout/Grid.hs index 73aabc7..2d52f43 100644 --- a/Graphics/Layout/Grid.hs +++ b/Graphics/Layout/Grid.hs @@ -16,7 +16,7 @@ data GridItem m n = GridItem { type Name = Text -gridMinWidths :: Double -> Grid y Length -> [GridItem y Length] -> (Double, [Double]) +{-gridMinWidths :: Double -> Grid y Length -> [GridItem y Length] -> (Double, [Double]) gridNatWidths :: Double -> Grid y Length -> [GridItem y Length] -> (Double, [Double]) gridMaxWidths :: PaddedBox y Double -> Grid y Length -> (Double, [Double]) gridWidths :: PaddedBox y Double -> Grid y Length -> (Double, [Double]) @@ -27,4 +27,4 @@ gridHeights :: Double -> Grid Length Double -> (Double, [Double]) gridPosition :: GridLength Double Double -> [GridItem Double Double] -> [Size Double Double] gridLayout :: PaddedBox Double Double -> Grid Length Length -> [GridItem Length Length] -> Bool -> - (Grid Double Double, [(Size Double Double, GridItem Double Double)]) + (Grid Double Double, [(Size Double Double, GridItem Double Double)])-} diff --git a/test/Test.hs b/test/Test.hs index b8f0829..025d443 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -5,7 +5,8 @@ import Test.Hspec import Graphics.Layout.Arithmetic import Data.CSS.Syntax.Tokens (tokenize, Token(..)) -import Debug.Trace (traceShowId) +import Graphics.Layout.Box as B +import Graphics.Layout.Flow main :: IO () main = hspec spec @@ -19,9 +20,77 @@ spec = do it "Can perform basic arithmatic" $ do runMath "42" `shouldBe` 42 runMath "6 * 9" `shouldBe` 54 --- runMath "6 * 9 - 42" `shouldBe` 12 --- runMath "6 * (9 - 42)" `shouldBe` -198 --- runMath "6 * calc(9 - 42)" `shouldBe` -198 --- runMath "6 * abs(9 - 42)" `shouldBe` 198 + runMath "6 * 9 - 42" `shouldBe` 12 + runMath "6 * (9 - 42)" `shouldBe` -198 + runMath "6 * calc(9 - 42)" `shouldBe` -198 + runMath "6 * abs(9 - 42)" `shouldBe` 198 + describe "Width sizing" $ do + -- Based on http://hixie.ch/tests/adhoc/css/box/block/ + it "Can overflow parent" $ do + width (fst $ layoutFlow zeroBox { + size = Size 3 1 + } lengthBox { + border = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2) + } [] False) `shouldBe` 4 + width (fst $ layoutFlow zeroBox { + size = Size 3 1 + } lengthBox { + padding = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2) + } [] False) `shouldBe` 4 + width (fst $ layoutFlow zeroBox { + size = Size 3 1 + } lengthBox { + margin = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2) + } [] False) `shouldBe` 4 + it "Fits to parent" $ do + width (fst $ layoutFlow zeroBox { + size = Size 5 1 + } lengthBox { + border = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2), + size = Size Auto $ Pixels 1 + } [] False) `shouldBe` 5 + width (fst $ layoutFlow zeroBox { + size = Size 5 1 + } lengthBox { + padding = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2), + size = Size Auto $ Pixels 1 + } [] False) `shouldBe` 5 + width (fst $ layoutFlow zeroBox { + size = Size 5 1 + } lengthBox { + margin = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2), + size = Size Auto $ Pixels 1 + } [] False) `shouldBe` 5 + it "Collapses margins" $ do + let a :: PaddedBox Length Double + a = PaddedBox { + B.min = Size 0 Auto, + size = Size 0 Auto, + B.max = Size 0 Auto, + padding = Border (Pixels 0) (Pixels 0) 0 0, + border = Border (Pixels 0) (Pixels 0) 0 0, + margin = Border (Pixels 5) (Pixels 10) 0 0 + } + b :: PaddedBox Length Double + b = PaddedBox { + B.min = Size 0 Auto, + size = Size 0 Auto, + B.max = Size 0 Auto, + padding = Border (Pixels 0) (Pixels 0) 0 0, + border = Border (Pixels 0) (Pixels 0) 0 0, + margin = Border (Pixels 10) (Pixels 5) 0 0 + } + height (fst $ layoutFlow zeroBox { + size = Size 100 100 + } lengthBox [a, a] False) `shouldBe` 25 + height (fst $ layoutFlow zeroBox { + size = Size 100 100 + } lengthBox [b, b] False) `shouldBe` 25 + height (fst $ layoutFlow zeroBox { + size = Size 100 100 + } lengthBox [a, b] False) `shouldBe` 20 + height (fst $ layoutFlow zeroBox { + size = Size 100 100 + } lengthBox [b, a] False) `shouldBe` 25 runMath = flip evalCalc [] . mapCalc fst . flip parseCalc [] . filter (/= Whitespace) . tokenize -- 2.30.2