4 files changed, 31 insertions(+), 11 deletions(-)

M Graphics/Layout.hs
M Graphics/Layout/Grid.hs
M Graphics/Layout/Inline.hs
M cattrap.cabal

@@ 94,11 94,13 @@ layoutGetInner (LayoutInline' ret _ _) = ret
 layoutGetInner (LayoutConst ret _ _) = ret
 layoutGetInner (LayoutSpan x) = treeInner x
 
+fragmentFont x = let (ret, _, _) = treeInner' x in ret
+
 -- | map-ready wrapper around `setCellBox` sourcing from a child node.
 setCellBox' (child, cell) = setCellBox cell $ layoutGetBox child
 
 -- | Update a (sub)tree to compute & cache minimum legible sizes.
-boxMinWidth :: (Zero y, CastDouble y) =>
+boxMinWidth :: (Zero y, CastDouble y, NFData y) =>
         Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
 boxMinWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
   where


@@ 125,7 127,7 @@ boxMinWidth _ (LayoutConst val self' childs) =
     LayoutConst val self' $ map (boxMinWidth Nothing) childs
 boxMinWidth _ self@(LayoutSpan _) = self
 -- | Update a (sub)tree to compute & cache ideal width.
-boxNatWidth :: (Zero y, CastDouble y) =>
+boxNatWidth :: (Zero y, CastDouble y, NFData y) =>
         Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
 boxNatWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
   where


@@ 152,7 154,8 @@ boxNatWidth _ (LayoutConst val self' childs) =
     LayoutConst val self' $ map (boxNatWidth Nothing) childs
 boxNatWidth _ self@(LayoutSpan _) = self
 -- | Update a (sub)tree to compute & cache maximum legible width.
-boxMaxWidth :: CastDouble y => PaddedBox a Double -> LayoutItem y Length x -> LayoutItem y Length x
+boxMaxWidth :: (CastDouble y, Zero y, NFData y) =>
+        PaddedBox a Double -> LayoutItem y Length x -> LayoutItem y Length x
 boxMaxWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
   where
     childs' = parMap' (boxMaxWidth self'') childs


@@ 171,8 174,8 @@ boxMaxWidth _ (LayoutConst val self' childs) = LayoutConst val self' $
     map (boxMaxWidth $ mapY' toDouble $ mapX' toDouble self') childs
 boxMaxWidth parent self@(LayoutSpan _) = self
 -- | Update a (sub)tree to compute & cache final width.
-boxWidth :: (Zero y, CastDouble y) => PaddedBox b Double -> LayoutItem y Length x ->
-        LayoutItem y Double x
+boxWidth :: (Zero y, CastDouble y, NFData y) =>
+        PaddedBox b Double -> LayoutItem y Length x -> LayoutItem y Double x
 boxWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
   where
     childs' = parMap' (boxWidth self') childs


@@ 399,4 402,5 @@ glyphsPerFont (LayoutSpan _ font self) =
   where glyphs = map fromEnum $ map Hb.codepoint $ map fst $ fragmentGlyphs self
 glyphsPerFont node = M.unionsWith IS.union $ map glyphsPerFont $ layoutGetChilds node -}
 
-parMap' = parMap rseq
+parMap' :: NFData b => (a -> b) -> [a] -> [b]
+parMap' = parMap rdeepseq

@@ 1,4 1,4 @@
-{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards, OverloadedStrings, DeriveGeneric #-}
 -- | Sizes grid cells & positions elements to them.
 module Graphics.Layout.Grid(Grid(..), Track(..), GridItem(..), GridItem'(..), Alignment(..),
         buildTrack, buildGrid, setCellBox, enumerate, gridItemBox, cellSize,


@@ 11,6 11,8 @@ import Data.List (intersperse)
 import Graphics.Layout.Box as B
 
 import Debug.Trace (trace)
+import GHC.Generics (Generic)
+import Control.DeepSeq (NFData)
 
 -- | An element which positions it's children within a grid.
 type Grid m n = Size (Track m) (Track n)


@@ 40,9 42,11 @@ data GridItem' = GridItem {
     minSize :: Double,
     -- | The maximum aount of space to allocate to this child.
     natSize :: Double
-}
+} deriving (Read, Show, Ord, Eq, Generic)
+instance NFData GridItem'
 -- | How to redistribute excess space.
-data Alignment = Start | Mid | End
+data Alignment = Start | Mid | End deriving (Read, Show, Enum, Ord, Eq, Generic)
+instance NFData Alignment
 
 -- | Constructs a track with default (to-be-computed) values & given cell sizes.
 buildTrack :: CastDouble x => [Either x Double] -> Track x

@@ 3,7 3,8 @@
 -- wraps Balkón for the actual logic.
 module Graphics.Layout.Inline(paragraphMap, layoutMap, treeMap,
     inlineMin, inlineSize, inlineChildren, layoutSize, layoutChildren,
-    treeBox, positionTree, treeInner, FragmentTree(..)) where
+    treeBox, positionTree, treeInner, treeInner', glyphs, codepoints,
+    FragmentTree(..)) where
 
 import Data.Text.ParagraphLayout.Rich (Paragraph(..), ParagraphOptions(..),
                                 Fragment(..), ParagraphLayout(..), AncestorBox(..),


@@ 12,7 13,9 @@ import Data.Text.ParagraphLayout.Rich (Paragraph(..), ParagraphOptions(..),
                                 activateBoxSpacing, paragraphSafeWidth)
 import Data.Text.ParagraphLayout.Rect (Rect(..),
                                 width, height, x_max, x_min, y_min, y_max)
+import qualified Data.Text.Glyphize as HB
 import Data.Int (Int32)
+import Data.Word (Word32)
 import Debug.Trace (trace) -- To warn about unexpected branches!
 
 import Graphics.Layout.Box hiding (min, max, width, height)


@@ 191,6 194,15 @@ positionTree (x, y) self@(Leaf (Fragment (a, b, c) d _ f g h i)) =
 treeInner :: FragmentTree (a, b, c) -> c
 treeInner (Branch AncestorBox { boxUserData = (_, _, ret) } _) = ret
 treeInner (Leaf Fragment { fragmentUserData = (_, _, ret) }) = ret
+treeInner' :: FragmentTree a -> a
+treeInner' (Branch self _) = boxUserData self
+treeInner' (Leaf self) = fragmentUserData self
+
+glyphs :: FragmentTree x -> [(HB.GlyphInfo, HB.GlyphPos)]
+glyphs (Branch _ _) = []
+glyphs (Leaf self) = fragmentGlyphs self
+codepoints :: FragmentTree x -> [Word32]
+codepoints self = map HB.codepoint $ map fst $ glyphs self
 
 ------
 --- Taken from Balkón

@@ 2,7 2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                cattrap
-version:             0.2.0.0
+version:             0.3.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/