~alcinnz/CatTrap

a5de823ba0a9717a95994b1ec72720fb39dac12f — Adrian Cochrane 1 year, 8 months ago d526688
Bugfix & pagination integration.
3 files changed, 41 insertions(+), 38 deletions(-)

M Graphics/Layout.hs
M Graphics/Layout/Flow.hs
M test/Test.hs
M Graphics/Layout.hs => Graphics/Layout.hs +13 -10
@@ 95,11 95,11 @@ boxMinWidth _ self@(LayoutInline' _ _ _ _ _) = self
boxMinWidth _ self@(LayoutSpan _ _ _) = self
boxNatWidth :: (Zero y, CastDouble y) =>
        Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxNatWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
boxNatWidth parent (LayoutFlow val self childs) = LayoutFlow val self childs'
  where
    self' = self { size = mapSizeX (B.mapAuto size') (size self) }
    {-self' = self { size = mapSizeX (B.mapAuto size') (size self) }
    size' = flowNatWidth parent' self childs''
    childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs'
    childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs'-}
    childs' = map (boxNatWidth $ Just selfWidth) childs
    selfWidth = width $ mapX' (lowerLength parent') self
    parent' = fromMaybe 0 parent


@@ 169,8 169,9 @@ boxNatHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
    size' = flowNatHeight parent self childs''
    childs'' = map (mapY' (lowerLength parent)) $ map layoutGetBox childs'
    childs' = map (boxNatHeight $ inline $ size self) childs
boxNatHeight parent (LayoutGrid val self cells childs) = LayoutGrid val self cells childs'
boxNatHeight parent (LayoutGrid val self cells childs) = LayoutGrid val self' cells childs'
  where
    self' = Size (inline self) (block self) { trackNats = heights }
    heights = sizeTrackNats parent (block self) $ map block cells'
    cells' = map setCellBox' $ zip childs' cells
    childs' = map (boxNatHeight width) childs


@@ 286,9 287,9 @@ boxSplit maxheight pageheight (LayoutInline' a b self paging c) =
  where
    wrap self' = LayoutInline' a b self' paging c
boxSplit _ _ self@(LayoutSpan _ _ _) = (self, Nothing) -- Can't split!
boxPaginate maxheight pageheight node
    | (page, Just overflow) <- boxSplit maxheight pageheight node =
        page:boxPaginate maxheight pageheight overflow
boxPaginate pageheight node
    | (page, Just overflow) <- boxSplit pageheight pageheight node =
        page:boxPaginate pageheight overflow
    | otherwise = [node]

boxPosition :: PropertyParser x => (Double, Double) -> LayoutItem Double Double x ->


@@ 311,8 312,8 @@ boxPosition pos@(x, y) (LayoutInline' val font self paging vals) =
            layoutChildren vals self
boxPosition pos (LayoutSpan val f self) = LayoutSpan (pos, val) f self -- No children...
boxLayout :: PropertyParser x => PaddedBox Double Double -> LayoutItem Length Length x ->
        Bool -> LayoutItem Double Double ((Double, Double), x)
boxLayout parent self paginate = self8
        Bool -> [LayoutItem Double Double ((Double, Double), x)]
boxLayout parent self paginate = self9
  where
    self0 = boxMinWidth Nothing self
    self1 = boxNatWidth Nothing self0


@@ 322,7 323,9 @@ boxLayout parent self paginate = self8
    self5 = boxMinHeight (inline $ size parent) self4
    self6 = boxMaxHeight parent self5
    self7 = boxHeight parent self6
    self8 = boxPosition (0, 0) self7
    self8 | paginate = boxPaginate (block $ size parent) self7
        | otherwise = [self7]
    self9 = map (boxPosition (0, 0)) self8

-- Useful for assembling glyph atlases.
glyphsPerFont :: LayoutItem x y z -> M.Map (Pattern, Double) IS.IntSet

M Graphics/Layout/Flow.hs => Graphics/Layout/Flow.hs +2 -2
@@ 73,9 73,9 @@ positionFlow :: [PaddedBox Double Double] -> [Size Double Double]
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 Double] -> Bool ->
        [PaddedBox Length Double] ->
        (PaddedBox Double Double, [(Size Double Double, PaddedBox Double Double)])
layoutFlow parent self childs paginate = (self', zip positions' childs')
layoutFlow parent self childs = (self', zip positions' childs')
  where
    positions' = positionFlow childs'
    childs' = map layoutZooko childs

M test/Test.hs => test/Test.hs +26 -26
@@ 35,43 35,43 @@ spec = do
                    size = Size 3 1
                } lengthBox {
                    border = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2)
                } [] False) `shouldBe` 4
                } []) `shouldBe` 4
            width (fst $ layoutFlow zeroBox {
                    size = Size 3 1
                } lengthBox {
                    padding = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2)
                } [] False) `shouldBe` 4
                } []) `shouldBe` 4
            width (fst $ layoutFlow zeroBox {
                    size = Size 3 1
                } lengthBox {
                    margin = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2)
                } [] False) `shouldBe` 4
                } []) `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
                } []) `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
                } []) `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
                } []) `shouldBe` 5
        it "Fits children" $ do
            let child = mapX' (lowerLength 100) $ lengthBox {
                size = Size (Pixels 10) (Pixels 10)
              }
            height (fst $ layoutFlow zeroBox {
                size = Size 100 100
              } lengthBox [child, child] False) `shouldBe` 20
              } lengthBox [child, child]) `shouldBe` 20
        it "Collapses margins" $ do
            let a :: PaddedBox Length Double
                a = PaddedBox {


@@ 93,16 93,16 @@ spec = do
                  }
            height (fst $ layoutFlow zeroBox {
                    size = Size 100 100
                } lengthBox [a, a] False) `shouldBe` 25
                } lengthBox [a, a]) `shouldBe` 25
            height (fst $ layoutFlow zeroBox {
                    size = Size 100 100
                } lengthBox [b, b] False) `shouldBe` 25
                } lengthBox [b, b]) `shouldBe` 25
            height (fst $ layoutFlow zeroBox {
                    size = Size 100 100
                } lengthBox [a, b] False) `shouldBe` 20
                } lengthBox [a, b]) `shouldBe` 20
            height (fst $ layoutFlow zeroBox {
                    size = Size 100 100
                } lengthBox [b, a] False) `shouldBe` 25
                } lengthBox [b, a]) `shouldBe` 25
    {-describe "Grid" $ do
        it "computes single-columns widths/heights" $ do
            let (pxGrid, pxCells) = gridLayout zeroBox {


@@ 146,50 146,50 @@ spec = do
            fst (head minCells) `shouldBe` Size 0 0-}
    describe "Abstract layout" $ do
        it "Can overflow parent" $ do
            width (layoutGetBox $ boxLayout zeroBox {
            width (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 3 1
                } (LayoutFlow () lengthBox {
                    border = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2)
                } []) False) `shouldBe` 4
            height (layoutGetBox $ boxLayout zeroBox {
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 3 1
                } (LayoutFlow () lengthBox {
                    border = Border (Pixels 2) (Pixels 2) (Pixels 2) (Pixels 2)
                } []) False) `shouldBe` 4
            width (layoutGetBox $ boxLayout zeroBox {
            width (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 3 1
                } (LayoutFlow () lengthBox {
                    padding = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2)
                } []) False) `shouldBe` 4
            height (layoutGetBox $ boxLayout zeroBox {
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 3 1
                } (LayoutFlow () lengthBox {
                    padding = Border (Pixels 2) (Pixels 2) (Pixels 2) (Pixels 2)
                } []) False) `shouldBe` 4
            width (layoutGetBox $ boxLayout zeroBox {
            width (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 3 1
                } (LayoutFlow () lengthBox {
                    margin = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2)
                } []) False) `shouldBe` 4
            height (layoutGetBox $ boxLayout zeroBox {
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 3 1
                } (LayoutFlow () lengthBox {
                    margin = Border (Pixels 2) (Pixels 2) (Pixels 2) (Pixels 2)
                } []) False) `shouldBe` 4
        it "Fits to parent" $ do
            width (layoutGetBox $ boxLayout zeroBox {
            width (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 5 1
                } (LayoutFlow () lengthBox {
                    border = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2),
                    size = Size Auto $ Pixels 1
                } []) False) `shouldBe` 5
            width (layoutGetBox $ boxLayout zeroBox {
            width (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 5 1
                } (LayoutFlow () lengthBox {
                    padding = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2),
                    size = Size Auto $ Pixels 1
                } []) False) `shouldBe` 5
            width (layoutGetBox $ boxLayout zeroBox {
            width (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 5 1
                } (LayoutFlow () lengthBox {
                    margin = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2),


@@ 200,10 200,10 @@ spec = do
                size = Size (Pixels 10) (Pixels 10),
                B.max = Size (Pixels 10) (Pixels 10)
              } []
            height (layoutGetBox $ boxLayout zeroBox {
            height (layoutGetBox $ head $ boxLayout zeroBox {
                size = Size 100 100
              } child False) `shouldBe` 10
            height (layoutGetBox $ boxLayout zeroBox {
            height (layoutGetBox $ head $ boxLayout zeroBox {
                size = Size 100 100
              } (LayoutFlow () lengthBox [child, child]) False) `shouldBe` 20
        it "Collapses margins" $ do


@@ 225,16 225,16 @@ spec = do
                    border = Border (Pixels 0) (Pixels 0) (Pixels 0) (Pixels 0),
                    margin = Border (Pixels 10) (Pixels 5) (Pixels 0) (Pixels 0)
                  } []
            height (layoutGetBox $ boxLayout zeroBox {
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 100 100
                } (LayoutFlow () lengthBox [a, a]) False) `shouldBe` 25
            height (layoutGetBox $ boxLayout zeroBox {
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 100 100
                } (LayoutFlow () lengthBox [b, b]) False) `shouldBe` 25
            height (layoutGetBox $ boxLayout zeroBox {
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 100 100
                } (LayoutFlow () lengthBox [a, b]) False) `shouldBe` 20
            height (layoutGetBox $ boxLayout zeroBox {
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 100 100
                } (LayoutFlow () lengthBox [b, a]) False) `shouldBe` 25