From eae2c2003d8f7d331e6e97364ed25ede50be6d81 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Tue, 28 Feb 2023 17:33:29 +1300 Subject: [PATCH] Unittest basic grid sizing. --- Graphics/Layout/Arithmetic.hs | 13 ++++++----- Graphics/Layout/Box.hs | 2 +- Graphics/Layout/Grid.hs | 36 +++++++++++++++++++++--------- cattrap.cabal | 1 + test/Test.hs | 42 +++++++++++++++++++++++++++++++++++ 5 files changed, 77 insertions(+), 17 deletions(-) diff --git a/Graphics/Layout/Arithmetic.hs b/Graphics/Layout/Arithmetic.hs index 779bffb..eddd12d 100644 --- a/Graphics/Layout/Arithmetic.hs +++ b/Graphics/Layout/Arithmetic.hs @@ -26,6 +26,7 @@ parseCalc toks'@(Delim c:toks) (stack:stacks) | prec stack >= prec (op c) = stack:parseCalc toks' stacks | otherwise = parseCalc toks (op c:stack:stacks) where + prec :: Opcode n -> Int prec Seq = 1 prec Add = 2 prec Subtract = 2 @@ -36,12 +37,12 @@ parseCalc toks'@(Delim c:toks) (stack:stacks) parseCalc (Delim c:toks) [] = parseCalc toks [op c] parseCalc (Comma:toks) stack = parseCalc (Delim ',':toks) stack parseCalc (RightParen:toks) (Func "calc":stack) = parseCalc toks stack -parseCalc (RightParen:toks) (op@(Func _):stack) = op:parseCalc toks stack -parseCalc toks@(RightParen:_) (op:stack) = op:parseCalc toks stack +parseCalc (RightParen:toks) (op'@(Func _):stack) = op':parseCalc toks stack +parseCalc toks@(RightParen:_) (op':stack) = op':parseCalc toks stack parseCalc (RightParen:toks) [] = parseCalc toks [] parseCalc [] [] = [] parseCalc [] stack = parseCalc [RightParen] stack -parseCalc toks stack = [Func "invalid"] +parseCalc _ _ = [Func "invalid"] op :: Char -> Opcode n op '+' = Add @@ -49,6 +50,7 @@ op '-' = Subtract op '*' = Multiply op '/' = Divide op ',' = Seq -- For function-calls. +op _ = Func "invalid" -- Do operands counts line up? Are we dividing by 0? -- Also I see concerns about whether units line up. Not bothering verifying that. @@ -57,7 +59,7 @@ verifyCalc (Seq:expr) stack = verifyCalc expr stack verifyCalc (Add:expr) (_:_:stack) = verifyCalc expr (True:stack) verifyCalc (Subtract:expr) (_:_:stack) = verifyCalc expr (True:stack) verifyCalc (Multiply:expr) (_:_:stack) = verifyCalc expr (True:stack) -verifyCalc (Divide:expr) (False:_) = False +verifyCalc (Divide:_) (False:_) = False verifyCalc (Divide:expr) (_:_:stack) = verifyCalc expr (True:stack) verifyCalc (Num (n, _):expr) stack = verifyCalc expr ((n == 0):stack) verifyCalc (Func x:expr) (_:stack) @@ -110,9 +112,10 @@ mapCalc cb (Add:toks) = Add:mapCalc cb toks mapCalc cb (Subtract:toks) = Subtract:mapCalc cb toks mapCalc cb (Multiply:toks) = Multiply:mapCalc cb toks mapCalc cb (Divide:toks) = Divide:mapCalc cb toks -mapCalc cb (Func f:toks) = Func f:mapCalc cb toks +mapCalc cb (Func f':toks) = Func f':mapCalc cb toks mapCalc _ [] = [] +val2float :: NumericValue -> Float val2float (NVInteger n) = fromIntegral n val2float (NVNumber n) = toRealFloat n diff --git a/Graphics/Layout/Box.hs b/Graphics/Layout/Box.hs index ed7e23f..44877e4 100644 --- a/Graphics/Layout/Box.hs +++ b/Graphics/Layout/Box.hs @@ -9,7 +9,7 @@ mapY :: (m -> mm) -> Border m n -> Border mm n mapX cb self = self { left = cb $ left self, right = cb $ right self } mapY cb self = self { top = cb $ top self, bottom = cb $ bottom self } -data Size m n = Size {inline :: n, block :: m} +data Size m n = Size {inline :: n, block :: m} deriving (Eq, Show) data PaddedBox m n = PaddedBox { min :: Size m n, diff --git a/Graphics/Layout/Grid.hs b/Graphics/Layout/Grid.hs index 1483950..66fd35c 100644 --- a/Graphics/Layout/Grid.hs +++ b/Graphics/Layout/Grid.hs @@ -1,10 +1,13 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards, OverloadedStrings #-} module Graphics.Layout.Grid where +import Data.Either (fromRight) import Data.Text (Text) import Data.List (intersperse) import Graphics.Layout.Box as B +import Debug.Trace (trace) + data Grid m n = Grid { rows :: [(Name, Either m Double)], rowBounds :: [(Double, Double)], @@ -22,12 +25,21 @@ data Alignment = Start | Mid | End type Name = Text +buildGrid rows columns = Grid { + rows = zip (repeat "") rows, + rowBounds = [], + columns = zip (repeat "") columns, + colBounds = [], + gap = Size (Pixels 0) (Pixels 0), + containerSize = Size Auto Auto +} + cellsForCol :: [GridItem y x] -> Int -> [GridItem y x] cellsForCol cells ix = - [cell | cell <- cells, startCol cell == ix, startCol cell /= succ (endCol cell)] + [cell | cell <- cells, startCol cell == ix, startCol cell == pred (endCol cell)] cellsForRow :: [GridItem y x] -> Int -> [GridItem y x] cellsForRow cells ix = - [cell | cell <- cells, startRow cell == ix, startRow cell /= succ (endRow cell)] + [cell | cell <- cells, startRow cell == ix, startRow cell == pred (endRow cell)] verifyGrid self childs = and [ startRow < width && startRow >= 0 && endRow < width && endRow >= 0 && endCol > startCol && endRow > startRow && @@ -89,12 +101,12 @@ gridWidths parent self subwidths = 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 fr ((min, nat), size) = Prelude.max 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 ((_, nat), Left Auto) = Prelude.min nat fr colWidth' fr (_, Right x) = x*fr gridEstHeight :: Grid Length Double -> [GridItem Double Double] -> Double @@ -122,7 +134,7 @@ gridMinHeights parent self childs = rowMinHeight (_, Left (Percent x)) = x * parent rowMinHeight arg@(ix, Left Preferred) = maximum $ (0:) $ map (block . size . gridItemBox) $ cellsForCol childs ix - rowNatHeight (ix, _) = + rowMinHeight (ix, _) = maximum $ (0:) $ map (block . B.min . gridItemBox) $ cellsForCol childs ix gridMaxHeights :: PaddedBox Double Double -> Grid Length Double -> [(Double, Double)] -> (Double, [Double]) @@ -150,12 +162,12 @@ gridHeights parent self subheights = (sum $ intersperse (inline $ gap self) ret, 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 fr ((min, nat), size) = Prelude.max 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 ((min, nat), Left Auto) = Prelude.min fr nat colHeight' fr (_, Right x) = x*fr gridPosition :: Grid Double Double -> [GridItem Double Double] -> [Size Double Double] @@ -172,8 +184,9 @@ gridPosition self childs = map gridCellPosition childs 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 + track ix (size:sizes) = fromRight 0 (snd size) + track (pred ix) sizes + track 0 _ = 0 + track ix [] = trace "WARNING! Malformed input table!" 0 align _ Start = 0 align excess Mid = excess/2 align excess End = excess @@ -201,7 +214,7 @@ gridLayout parent self childs paginate = (self', zip positions childs) self0 = self { columns = zip (map fst $ columns self) $ map Left cols', - rowBounds = rowBounds', + colBounds = colBounds', gap = Size (lowerLength width' gapX) gapY, containerSize = let Size _ y = containerSize self in Size width' y } @@ -215,4 +228,5 @@ enumerate = zip [0..] countFRs (Left Auto:rest) = succ $ countFRs rest countFRs (Right x:rest) = x + countFRs rest +countFRs (_:rest) = countFRs rest countFRs [] = 0 diff --git a/cattrap.cabal b/cattrap.cabal index 5c19ee8..7648f61 100644 --- a/cattrap.cabal +++ b/cattrap.cabal @@ -24,6 +24,7 @@ library build-depends: base >=4.12 && <4.16, css-syntax, scientific, text, stylist-traits -- hs-source-dirs: default-language: Haskell2010 + ghc-options: -Wincomplete-patterns executable cattrap main-is: Main.hs diff --git a/test/Test.hs b/test/Test.hs index 025d443..38231fd 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -6,6 +6,7 @@ import Test.Hspec import Graphics.Layout.Arithmetic import Data.CSS.Syntax.Tokens (tokenize, Token(..)) import Graphics.Layout.Box as B +import Graphics.Layout.Grid import Graphics.Layout.Flow main :: IO () @@ -92,5 +93,46 @@ spec = do height (fst $ layoutFlow zeroBox { size = Size 100 100 } lengthBox [b, a] False) `shouldBe` 25 + describe "Grid" $ do + it "computes single-columns widths/heights" $ do + let (pxGrid, pxCells) = gridLayout zeroBox { + size = Size 100 100 + } (buildGrid [Left $ Pixels 10] [Left $ Pixels 10]) + [GridItem 0 1 0 1 (Size Start Start) zeroBox] True + containerSize pxGrid `shouldBe` Size 10 10 + fst (head pxCells) `shouldBe` Size 0 0 + let (pcGrid, pcCells) = gridLayout zeroBox { + size = Size 100 100 + } (buildGrid [Left $ Percent 0.5] [Left $ Percent 0.5]) + [GridItem 0 1 0 1 (Size Start Start) zeroBox] True + containerSize pcGrid `shouldBe` Size 50 50 + fst (head pcCells) `shouldBe` Size 0 0 + let (autoGrid, autoCells) = gridLayout zeroBox { + size = Size 100 100 + } (buildGrid [Left Auto] [Left Auto]) + [GridItem 0 1 0 1 (Size Start Start) zeroBox { + B.min = Size 10 10, + size = Size 20 20 + }] True + containerSize autoGrid `shouldBe` Size 20 20 + fst (head autoCells) `shouldBe` Size 0 0 + let (prefGrid, prefCells) = gridLayout zeroBox { + size = Size 100 100 + } (buildGrid [Left Preferred] [Left Preferred]) + [GridItem 0 1 0 1 (Size Start Start) zeroBox { + B.min = Size 10 10, + size = Size 15 15 + }] True + containerSize prefGrid `shouldBe` Size 15 15 + fst (head prefCells) `shouldBe` Size 0 0 + let (minGrid, minCells) = gridLayout zeroBox { + size = Size 100 100 + } (buildGrid [Left Min] [Left Min]) + [GridItem 0 1 0 1 (Size Start Start) zeroBox { + B.min = Size 10 10, + size = Size 15 15 + }] True + containerSize minGrid `shouldBe` Size 10 10 + fst (head minCells) `shouldBe` Size 0 0 runMath = flip evalCalc [] . mapCalc fst . flip parseCalc [] . filter (/= Whitespace) . tokenize -- 2.30.2