cattrap 0.5.0.0 → 0.6.0.0

raw patch · 6 files changed

+122/−65 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Graphics/Layout.hs +51/−22
• Graphics/Layout/CSS.hs +13/−5
• Graphics/Layout/CSS/Parse.hs +14/−1
• Graphics/Layout/Inline.hs +41/−34
• cattrap.cabal +1/−1
• test/Test.hs +2/−2

@@ -39,7 +39,7 @@ import Unsafe.Coerce (unsafeCoerce)  -- | Additional data routed through Balkon.-type UserData m n x = ((Font', Int), PaddedBox m n, x)+type UserData m n x = ((Font', Int), Either (PaddedBox m n) (LayoutItem m n x), x)  -- | A tree of different layout algorithms. -- More to come...@@ -69,7 +69,7 @@     rnf = rnf . layoutGetBox -- Avoid auxiliary properties that don't cleanly `rnf`  -- | Retrieve the surrounding box for a layout item.-layoutGetBox :: (Zero m, Zero n, CastDouble m, CastDouble n) =>+layoutGetBox, b :: (Zero m, Zero n, CastDouble m, CastDouble n) =>         LayoutItem m n x -> PaddedBox m n layoutGetBox (LayoutFlow _ ret _) = ret layoutGetBox (LayoutGrid _ self _ _) = zero {@@ -81,14 +81,19 @@             (fromDouble $ trackNat toDouble $ block self) } layoutGetBox (LayoutInline _ self _) = zero {-    B.min = inlineMin self, B.size = inlineSize self, B.max = inlineSize self-}+    B.min = inlineMin b self, B.size = inlineSize b self, B.max = inlineSize b self+  } layoutGetBox (LayoutInline' _ self _) = zero {     B.min = layoutSize self, B.size = layoutSize self, B.max = layoutSize self }-layoutGetBox (LayoutSpan self) = treeBox self+layoutGetBox (LayoutSpan self) = treeBox $ treeMap layoutGetBoxRight self layoutGetBox (LayoutConst _ ret _) = ret layoutGetBox (LayoutFlex _ self) = flexGetBox layoutGetBox' self++b = layoutGetBox+layoutGetBoxRight (Right self) = layoutGetBox self+layoutGetBoxRight (Left ret) = ret+ layoutGetBox' :: (Zero m, Zero n, CastDouble m, CastDouble n) =>         LayoutItem m n x -> PaddedBox Double Double layoutGetBox' = mapX' toDouble . mapY' toDouble . layoutGetBox@@ -97,7 +102,7 @@ layoutGetChilds (LayoutGrid _ _ _ ret) = ret layoutGetChilds (LayoutSpan (Leaf _)) = [] layoutGetChilds (LayoutSpan (Branch _ ret)) = map LayoutSpan ret-layoutGetChilds (LayoutInline _ self _) = map LayoutSpan $ inlineChildren self+layoutGetChilds (LayoutInline _ self _) = map LayoutSpan $ inlineChildren b self layoutGetChilds (LayoutInline' _ self _) = map LayoutSpan $ layoutChildren self layoutGetChilds (LayoutConst _ _ childs) = childs layoutGetChilds (LayoutFlex _ x) = map Fl.flexInner $ concat $ Fl.children x@@ -219,17 +224,27 @@     }     outerwidth = inline $ size parent     widths = sizeTrackMaxs (inline $ size parent) $ inline self-boxWidth parent (LayoutInline val (Paragraph a b c d) paging) =-    LayoutInline val (paragraphMap (mapX' $ lowerLength width) $-        Paragraph a b c d { paragraphMaxWidth = round width }) paging-  where width = B.inline $ B.size parent-boxWidth p (LayoutInline' a b c) =-    LayoutInline' a (layoutMap (mapX' $ lowerLength $ B.inline $ B.size p) b) c+boxWidth parent self@(LayoutInline val (Paragraph a b c d) paging) =+    LayoutInline val (paragraphMap inner $ Paragraph a b c d {+        paragraphMaxWidth = round $ B.inline $ B.size parent+      }) paging+  where+    inner (Left a) = Left $ resolveWidth a+    inner (Right a) = Right $ boxWidth (resolveWidth $ layoutGetBox self) a+    resolveWidth = mapX' $ lowerLength $ B.inline $ B.size parent+boxWidth parent self@(LayoutInline' a b c) = LayoutInline' a (layoutMap inner b) c+  where+    inner (Left a) = Left $ resolveWidth a+    inner (Right a) = Right $ boxWidth (resolveWidth $ layoutGetBox self) a+    resolveWidth = mapX' $ lowerLength $ B.inline $ B.size parent boxWidth p (LayoutConst val self childs) = LayoutConst val (mapX' cb self) $     map (boxWidth $ mapY' toDouble $ mapX' cb self) childs   where cb = lowerLength $ width p-boxWidth parent (LayoutSpan self') =-    LayoutSpan $ treeMap (mapX' $ lowerLength $ width parent) self'+boxWidth parent self@(LayoutSpan self') = LayoutSpan $ treeMap inner self'+  where+    inner (Left a) = Left $ resolveWidth a+    inner (Right a) = Right $ boxWidth (resolveWidth $ layoutGetBox self) a+    resolveWidth = mapX' $ lowerLength $ B.inline $ B.size parent boxWidth parent (LayoutFlex a b) = LayoutFlex a $ flexMap (boxWidth parent) b  -- | Update a (sub)tree to compute & cache ideal legible height.@@ -326,15 +341,26 @@     lowerSize (Left x) = Left $ lowerLength width x     lowerSize (Right x) = Right x     width = inline $ size parent-boxHeight p (LayoutInline val self' paging) =-    LayoutInline val (paragraphMap (mapY' $ lowerLength $ width p) self') paging-boxHeight p (LayoutInline' val self' paging) =-    LayoutInline' val (layoutMap (mapY' $ lowerLength $ width p) self') paging+boxHeight parent self@(LayoutInline val self' paging) =+    LayoutInline val (paragraphMap inner self') paging+  where+    inner (Left a) = Left $ resolveHeight a+    inner (Right a) = Right $ boxHeight (resolveHeight $ layoutGetBox self) a+    resolveHeight = mapY' $ lowerLength $ B.inline $ B.size parent+boxHeight parent self@(LayoutInline' val self' paging) =+    LayoutInline' val (layoutMap inner self') paging+  where+    inner (Left a) = Left $ resolveHeight a+    inner (Right a) = Right $ boxHeight (resolveHeight $ layoutGetBox self) a+    resolveHeight = mapY' $ lowerLength $ B.inline $ B.size parent boxHeight p (LayoutConst val self childs) =     let self' = mapY' (lowerLength $ width p) self     in LayoutConst val self' $ map (boxHeight self') childs-boxHeight p (LayoutSpan self') =-    LayoutSpan $ treeMap (mapY' $ lowerLength $ width p) self'+boxHeight parent self@(LayoutSpan self') = LayoutSpan $ treeMap inner self'+  where+    inner (Left a) = Left $ resolveHeight a+    inner (Right a) = Right $ boxHeight (resolveHeight $ layoutGetBox self) a+    resolveHeight = mapY' $ lowerLength $ B.inline $ B.size parent boxHeight p (LayoutFlex a b) = LayoutFlex a $     flexResolve (innerMain . layoutGetBox) (width p) $ flexMap (boxHeight p) b @@ -421,7 +447,10 @@     boxPosition pos $ LayoutConst val (layoutGetBox self) $ layoutGetChilds self boxPosition pos (LayoutConst val self childs) =     LayoutConst (pos, val) self $ parMap' (boxPosition pos) childs-boxPosition pos (LayoutSpan self) = LayoutSpan $ positionTree pos self+boxPosition pos (LayoutSpan self) = LayoutSpan $ positionTree pos inner self+  where+    inner _ (Left ret) = Left ret+    inner pos' (Right kid) = Right $ boxPosition pos' kid -- | Compute sizes & position information for all nodes in the (sub)tree. boxLayout :: (PropertyParser x, Eq x) => PaddedBox Double Double ->         LayoutItem Length Length x -> Bool -> @@ -443,7 +472,7 @@ -- | Compute a mapping from a layout tree indicating which glyphs for which fonts -- are required. -- Useful for assembling glyph atlases.-glyphsPerFont :: (CastDouble x, CastDouble y, Eq x, Eq y, Eq z) =>+glyphsPerFont :: (CastDouble x, CastDouble y, Eq x, Eq y, Eq z, Zero x, Zero y) =>         LayoutItem x y z -> M.Map (Pattern, Double) IS.IntSet glyphsPerFont (LayoutSpan self@(Leaf _)) | (_:_) <- glyphs =         (pattern font, fontSize font) `M.singleton` IS.fromList glyphs

@@ -10,7 +10,7 @@ import Stylist (PropertyParser(..)) import Stylist.Tree (StyleTree(..)) import Data.Text.ParagraphLayout.Rich (constructParagraph, defaultBoxOptions,-        LineHeight(..), InnerNode(..), Box(..), RootNode(..))+        LineHeight(..), InnerNode(..), Box(..), RootNode(..), strut)  import Graphics.Layout.Box as B import Graphics.Layout@@ -27,7 +27,7 @@ import Data.Maybe (fromMaybe)  instance (PropertyParser x, Zero m, Zero n) => Default (UserData m n x) where-    def = ((placeholderFont, 0), zero, temp)+    def = ((placeholderFont, 0), Left zero, temp)  -- | Resolves length units in properties handled by downstream components. inner' :: PropertyParser x => Font' -> CSSBox x -> x@@ -109,6 +109,7 @@     isInlineTree = all isInlineTree0     isInlineTree0 StyleTree { style = CSSBox { display = Inline }, children = childs } =         isInlineTree childs+    isInlineTree0 StyleTree { style = CSSBox { display = Inline' _ } } = True     isInlineTree0 _ = False     spanInlines childs = case span isInlineTree0 childs of         (inlines, (StyleTree {@@ -116,21 +117,28 @@           }:blocks)) -> let (inlines', blocks') = spanInlines tail             in (inlines ++ inlines', blocks' ++ blocks)         ret -> ret-    flattenTree0 childs+    flattenTree0 = strut def . flattenTree0'+    flattenTree0' childs         | iStyle@(CSSInline _ _ bidi) <- inlineStyles style',             bidi `elem` [BdOverride, BdIsolateOverride] = RootBox $ Box                 (applyBidi iStyle $ map (flattenTree parent) $ enumerate childs)                 $ flip applyFontInline parent $ txtOpts style'         | otherwise = RootBox $ Box (map (flattenTree parent) $ enumerate childs)             $ flip applyFontInline parent $ txtOpts style'+    flattenTree p (i, StyleTree self@CSSBox { display = Inline' disp' } kids) =+        buildInline' (pattern2font (font self) (font' self) p root) i+            (Right $ finalizeCSS root p $ StyleTree self { display = disp' } kids)+            self []     flattenTree p (i, StyleTree self child@(_:_)) =         buildInline f i self $ map (flattenTree f) $ enumerate child       where f = pattern2font (font self) (font' self) p root     flattenTree f (i,StyleTree {style=self@CSSBox {inlineStyles=CSSInline txt _ _}})         = buildInline f i self [-            TextSequence ((f, 0), zero, inherit $ inner' parent self) txt]+            TextSequence ((f, 0), Left zero, inherit $ inner' parent self) txt]     buildInline f i self childs =-        InlineBox ((f, i), finalizeBox self f, inner' parent self)+        buildInline' f i (Left $ finalizeBox self f) self childs+    buildInline' f i val self childs =+        InlineBox ((f, i), val, inner' parent self)                 (Box childs' $ flip applyFontInline f $ txtOpts self)                 $ resolveBoxOpts f (tableOptions self)       where childs' = applyBidi (inlineStyles self) childs

@@ -73,7 +73,7 @@ -- | Possibly values for CSS display property. data Display = Block | Grid | Inline | Table | None |     TableRow | TableHeaderGroup | TableRowGroup | TableFooterGroup | TableCell |-    TableColumn | TableColumnGroup | TableCaption | Flex deriving Eq+    TableColumn | TableColumnGroup | TableCaption | Flex | Inline' Display deriving Eq -- | Can the display value contain table-rows? rowContainer CSSBox { display = d } =     d `elem` [Table, TableHeaderGroup, TableRowGroup, TableFooterGroup]@@ -263,6 +263,19 @@         Just self { display=TableCaption }     longhand _ self "display" [Ident "inline"] = Just self { display = Inline }     longhand _ self "display" [Ident "flex"] = Just self { display = Flex }+    longhand _ self "display" [Ident "inline-block"] = Just self { display = Inline' Block }+    longhand _ self "display" [Ident "inline", Ident "block"] =+        Just self { display = Inline' Block }+    longhand _ self "display" [Ident "inline-flex"] = Just self { display = Inline' Flex }+    longhand _ self "display" [Ident "inline", Ident "flex"] =+        Just self { display = Inline' Flex }+    longhand _ self "display" [Ident "inline-grid"] = Just self { display = Inline' Grid }+    longhand _ self "display" [Ident "inline", Ident "grid"] =+        Just self { display = Inline' Grid }+    longhand _ self "display" [Ident "inline-table"] = Just self { display = Inline' Table }+    longhand _ self "display" [Ident "inline", Ident "table"] =+        Just self { display = Inline' Table}+    longhand p self "display" (Ident "block":v) = longhand p self "display" v     longhand _ self "display" [Ident "initial"] = Just self { display = Inline }      longhand _ self "orphans" [Number _ (NVInteger x)] =

@@ -10,7 +10,7 @@                                 Fragment(..), ParagraphLayout(..), AncestorBox(..),                                 InnerNode(..), Box(..), RootNode(..),                                 layoutRich, boxSpacing, BoxSpacing(..),-                                activateBoxSpacing, paragraphSafeWidth)+                                activateBoxSpacing, paragraphSafeWidth, textAscender) import Data.Text.ParagraphLayout.Rect (Rect(..),                                 width, height, x_max, x_min, y_min, y_max) import qualified Data.Text.Glyphize as HB@@ -33,19 +33,21 @@ unscale = floor . (*hbUnit) . toDouble  -- | Compute minimum width & height for some richtext.-inlineMin :: (CastDouble x, CastDouble y) =>-        Paragraph (a, PaddedBox x y, c) -> Size x y-inlineMin = layoutSize' . flip layoutRich' 0+inlineMin :: (CastDouble x, CastDouble y) => (z -> PaddedBox x y) ->+        Paragraph (a, Either (PaddedBox x y) z, c) -> Size x y+inlineMin cb self = layoutSize' $ layoutRich' cb self 0 -- | Compute width & height of some richtext at configured width.-inlineSize :: (CastDouble x, CastDouble y) =>-        Paragraph (a, PaddedBox x y, c) -> Size x y-inlineSize self@(Paragraph _ _ _ opts) =-    layoutSize' . layoutRich' self $ paragraphMaxWidth opts+inlineSize :: (CastDouble x, CastDouble y) => (z -> PaddedBox x y) ->+        Paragraph (a, Either (PaddedBox x y) z, c) -> Size x y+inlineSize cb self@(Paragraph _ _ _ opts) =+    layoutSize' . layoutRich' cb self $ paragraphMaxWidth opts -- | Retrieve children out of some richtext, -- associating given userdata with them.-inlineChildren :: (CastDouble x, CastDouble y, Eq x, Eq y, Eq a, Eq c) =>-        Paragraph (a, PaddedBox x y, c) -> [FragmentTree (a, PaddedBox x y, c)]-inlineChildren self = layoutChildren $ layoutRich $ lowerSpacing self+inlineChildren :: (CastDouble x, CastDouble y, Eq x, Eq y, Eq a, Eq c, Eq z) =>+        (z -> PaddedBox x y) ->+        Paragraph (a, Either (PaddedBox x y) z, c) ->+        [FragmentTree (a, Either (PaddedBox x y) z, c)]+inlineChildren cb self = layoutChildren $ layoutRich $ lowerSpacing cb self  -- | Retrieve a laid-out paragraph's rect & convert to CatTrap types. layoutSize :: (CastDouble x, CastDouble y) => ParagraphLayout a -> Size x y@@ -57,26 +59,35 @@  -- | Layout a paragraph at given width & retrieve resulting rect. -- LEGACY.-layoutRich' :: (CastDouble m, CastDouble n) =>-        Paragraph (a, PaddedBox m n, c) -> Int32 -> Rect Int32-layoutRich' (Paragraph a b c d) width =+layoutRich' :: (CastDouble m, CastDouble n) => (x -> PaddedBox m n) ->+        Paragraph (a, Either (PaddedBox m n) x, c) -> Int32 -> Rect Int32+layoutRich' cb (Paragraph a b c d) width =     (paragraphRect layout) { x_size = paragraphSafeWidth layout}   where-    layout = layoutRich$lowerSpacing$Paragraph a b c d {paragraphMaxWidth=width}+    layout = layoutRich $ lowerSpacing cb $ Paragraph a b c d {+        paragraphMaxWidth = width+      }  -- | Copy surrounding whitespace into Balkon properties.-lowerSpacing :: (CastDouble m, CastDouble n) =>-    Paragraph (a, PaddedBox m n, c) -> Paragraph (a, PaddedBox m n, c)-lowerSpacing (Paragraph a b (RootBox c) d) = Paragraph a b (RootBox $ inner c) d+lowerSpacing :: (CastDouble m, CastDouble n) => (x -> PaddedBox m n) ->+    Paragraph (a, Either (PaddedBox m n) x, c) ->+    Paragraph (a, Either (PaddedBox m n) x, c)+lowerSpacing cb (Paragraph a b (RootBox c) d) = Paragraph a b (RootBox $ inner c) d   where     inner (Box childs opts) = flip Box opts $ map inner' childs-    inner' (InlineBox e@(_, f, _) child opts) = InlineBox e (inner child) $-        flip activateBoxSpacing opts $-            BoxSpacingLeftRight (leftSpace box) (rightSpace box)-      where box = mapX' unscale $ mapY' unscale f+    inner' (InlineBox e@(_, Left box, _) child opts) =+        inlineBox e (leftSpace box') (rightSpace box') child opts+      where box' = mapX' unscale $ mapY' unscale box+    inner' (InlineBox e@(_, Right k, _) (Box childs opts') opts) = let box = cb k+        in inlineBox e (Box.width $ mapX' unscale box) 0 (Box childs opts' {+            textAscender = Just $ Box.height $ mapY' unscale box+          }) opts     inner' self@(TextSequence _ _) = self+    inlineBox dat left right child opts = InlineBox dat (inner child) $+        flip activateBoxSpacing opts $ BoxSpacingLeftRight left right  + -- | A tree extracted from Balkón's inline layout. data FragmentTree x = Branch (AncestorBox x) [FragmentTree x]     | Leaf (Fragment x)@@ -120,13 +131,9 @@ fragmentSize self = Size (c $ width r) (c $ height r)     where r = treeRect self -- | Compute the unioned rect for a subtree.-treeRect :: (CastDouble m, CastDouble n) =>-        FragmentTree (a, PaddedBox m n, c) -> Rect Int32+treeRect :: FragmentTree (a, b, c) -> Rect Int32 treeRect (Branch AncestorBox { boxUserData = (_, box', _)} childs) =         unions $ map treeRect childs-    where-        box :: PaddedBox Int32 Int32-        box = mapX' unscale $ mapY' unscale box' treeRect (Leaf self) = fragmentRect self  -- | Compute the paddedbox for a subtree.@@ -182,16 +189,16 @@ reconstructTree' [] = []  -- | Add an X,Y offset to all positions, annotating the userdata.-positionTree :: (CastDouble m, CastDouble n) => (Double, Double) ->-        FragmentTree (a, PaddedBox m n, c) ->-        FragmentTree (a, PaddedBox m n, ((Double, Double), c))-positionTree (x, y) self@(Branch (AncestorBox (a, b, c) d e f g) childs) =-    Branch (AncestorBox (a, b, (pos, c)) d e f g) $ map (positionTree pos) childs+positionTree :: (Double, Double) -> ((Double, Double) -> b -> b') ->+        FragmentTree (a, b, c) -> FragmentTree (a, b', ((Double, Double), c))+positionTree (x, y) cb self@(Branch (AncestorBox (a, b, c) d e f g) childs) =+    Branch (AncestorBox (a, cb pos b, (pos, c)) d e f g) $+        map (positionTree pos cb) childs   where     pos = (x + hbScale (x_min rect), y + hbScale (y_min rect))     rect = treeRect self-positionTree (x, y) self@(Leaf (Fragment (a, b, c) d _ f g h i)) =-    Leaf (Fragment (a, b, (pos, c)) d [] f g h i)+positionTree (x, y) cb self@(Leaf (Fragment (a, b, c) d _ f g h i)) =+    Leaf (Fragment (a, cb pos b, (pos, c)) d [] f g h i)   where     pos = (x + hbScale (x_min rect), y + hbScale (y_min rect))     rect = treeRect self

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                cattrap-version:             0.5.0.0+version:             0.6.0.0 synopsis:            Lays out boxes according to the CSS Box Model. description:         Computes where to place e.g. images, paragraphs, containers, tables, etc onscreen given desired amounts of whitespace. homepage:            https://argonaut-constellation.org/

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} module Main where  import Test.Hspec@@ -370,7 +370,7 @@             }             let inline txt = LayoutInline () (constructParagraph "" (                         RootBox $ Box [-                            TextSequence ((placeholderFont, 12), zero, ()) txt+                            TextSequence ((placeholderFont, 12), Left zero, ()) txt                         ] $ defaultTextOptions DirLTR                     ) "" defaultParagraphOptions) defaultPageOptions             finalizeCSS placeholderFont placeholderFont table `shouldBe`