6 files changed, 139 insertions(+), 42 deletions(-)

M Graphics/Layout.hs
M Graphics/Layout/Box.hs
M Graphics/Layout/CSS.hs
M Graphics/Layout/Flow.hs
M Graphics/Layout/Grid.hs
M test/Test.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-}

@@ 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

@@ 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
     ...

@@ 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

@@ 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)])-}

@@ 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