6 files changed, 281 insertions(+), 157 deletions(-)

M Graphics/Layout.hs
M Graphics/Layout/CSS.hs
M Graphics/Layout/CSS/Font.hs
M Graphics/Layout/Inline.hs
M Graphics/Layout/Inline/CSS.hs
M cattrap.cabal

@@ 8,10 8,11 @@ module Graphics.Layout(LayoutItem(..),
         layoutGetBox, layoutGetChilds, layoutGetInner,
         boxMinWidth, boxMaxWidth, boxNatWidth, boxWidth,
         boxNatHeight, boxMinHeight, boxMaxHeight, boxHeight,
-        boxSplit, boxPaginate, boxPosition, boxLayout, glyphsPerFont) where
+        boxSplit, boxPaginate, boxPosition, boxLayout{-, glyphsPerFont-}) where
 
-import Data.Text.ParagraphLayout (Paragraph(..), ParagraphOptions(..), Fragment(..),
-        ParagraphLayout(..), PageOptions(..), PageContinuity(..), paginate, layoutPlain)
+import Data.Text.ParagraphLayout.Rich (Paragraph(..), ParagraphOptions(..),
+                                Fragment(..), ParagraphLayout(..), layoutRich)
+import Data.Text.ParagraphLayout (paginate, PageContinuity(..), PageOptions(..))
 import Stylist (PropertyParser(..))
 
 import Graphics.Layout.Box as B


@@ 28,6 29,9 @@ import qualified Data.Map.Strict as M
 import qualified Data.Text.Glyphize as Hb
 import Graphics.Text.Font.Choose (Pattern)
 
+-- | Additional data routed through Balkon.
+type UserData x = (Font', PaddedBox Length Length, x)
+
 -- | A tree of different layout algorithms.
 -- More to come...
 data LayoutItem m n x =


@@ 36,12 40,12 @@ data LayoutItem m n x =
     -- | A grid or table element.
     | LayoutGrid x (Grid m n) [GridItem] [LayoutItem m n x]
     -- | Some richtext.
-    | LayoutInline x Font' Paragraph PageOptions [x] -- Balkon holds children.
+    | LayoutInline x (Paragraph (UserData x)) PageOptions -- Balkon holds children.
     -- | Results laying out richtext, has fixed width.
     -- Generated from `LayoutInline` for the sake of pagination.
-    | LayoutInline' x Font' ParagraphLayout PageOptions [x]
+    | LayoutInline' x (ParagraphLayout (UserData x)) PageOptions
     -- | Children of a `LayoutInline` or `LayoutInline'`.
-    | LayoutSpan x Font' Fragment
+    | LayoutSpan (Fragment (UserData x))
 -- | An empty box.
 nullLayout :: (PropertyParser x, Zero m, Zero n) => LayoutItem m n x
 nullLayout = LayoutFlow temp zero []


@@ 58,29 62,27 @@ layoutGetBox (LayoutGrid _ self _ _) = zero {
     B.max = Size (fromDouble $ trackNat toDouble $ inline self)
             (fromDouble $ trackNat toDouble $ block self)
 }
-layoutGetBox (LayoutInline _ f self _ _) = zero {
-    B.min = inlineMin f self, B.size = inlineSize f self, B.max = inlineSize f self
+layoutGetBox (LayoutInline _ self _) = zero {
+    B.min = inlineMin self, B.size = inlineSize self, B.max = inlineSize self
 }
-layoutGetBox (LayoutInline' _ f self _ _) = zero {
-    B.min = layoutSize f self, B.size = layoutSize f self, B.max = layoutSize f self
+layoutGetBox (LayoutInline' _ self _) = zero {
+    B.min = layoutSize self, B.size = layoutSize self, B.max = layoutSize self
 }
-layoutGetBox (LayoutSpan _ f self) = zero {
-    B.min = fragmentSize f self, B.size = fragmentSize f self, B.max = fragmentSize f self
+layoutGetBox (LayoutSpan self) = zero {
+    B.min = fragmentSize self, B.size = fragmentSize self, B.max = fragmentSize self
 }
 -- | Retrieve the subtree under a node.
 layoutGetChilds (LayoutFlow _ _ ret) = ret
 layoutGetChilds (LayoutGrid _ _ _ ret) = ret
-layoutGetChilds (LayoutSpan _ _ _) = []
-layoutGetChilds (LayoutInline _ font self _ vals) = map inner $ inlineChildren vals self
-  where inner (val, fragment) = LayoutSpan val font fragment
-layoutGetChilds (LayoutInline' _ font self _ vals) = map inner $ layoutChildren vals self
-  where inner (val, fragment) = LayoutSpan val font fragment
+layoutGetChilds (LayoutSpan _) = []
+layoutGetChilds (LayoutInline _ self _) = map LayoutSpan $ inlineChildren self
+layoutGetChilds (LayoutInline' _ self _) = map LayoutSpan $ layoutChildren self
 -- | Retrieve the caller-specified data attached to a layout node.
 layoutGetInner (LayoutFlow ret _ _) = ret
 layoutGetInner (LayoutGrid ret _ _ _) = ret
-layoutGetInner (LayoutInline ret _ _ _ _) = ret
-layoutGetInner (LayoutInline' ret _ _ _ _) = ret
-layoutGetInner (LayoutSpan ret _ _) = ret
+layoutGetInner (LayoutInline ret _ _) = ret
+layoutGetInner (LayoutInline' ret _ _) = ret
+layoutGetInner (LayoutSpan Fragment { fragmentUserData = (_, _, ret) }) = ret
 
 -- | map-ready wrapper around `setCellBox` sourcing from a child node.
 setCellBox' (child, cell) = setCellBox cell $ layoutGetBox child


@@ 107,9 109,9 @@ boxMinWidth parent (LayoutGrid val self cells0 childs) = LayoutGrid val self' ce
     parent' = fromMaybe (gridEstWidth self cells0) parent
     zeroBox :: PaddedBox Double Double
     zeroBox = zero
-boxMinWidth _ self@(LayoutInline _ _ _ _ _) = self
-boxMinWidth _ self@(LayoutInline' _ _ _ _ _) = self
-boxMinWidth _ self@(LayoutSpan _ _ _) = self
+boxMinWidth _ self@(LayoutInline _ _ _) = self
+boxMinWidth _ self@(LayoutInline' _ _ _) = self
+boxMinWidth _ self@(LayoutSpan _) = self
 -- | Update a (sub)tree to compute & cache ideal width.
 boxNatWidth :: (Zero y, CastDouble y) =>
         Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x


@@ 132,9 134,9 @@ boxNatWidth parent (LayoutGrid val self cells0 childs) = LayoutGrid val self' ce
     parent' = fromMaybe (gridEstWidth self cells0) parent
     zeroBox :: PaddedBox Double Double
     zeroBox = zero
-boxNatWidth _ self@(LayoutInline _ _ _ _ _) = self
-boxNatWidth _ self@(LayoutInline' _ _ _ _ _) = self
-boxNatWidth _ self@(LayoutSpan _ _ _) = self
+boxNatWidth _ self@(LayoutInline _ _ _) = self
+boxNatWidth _ self@(LayoutInline' _ _ _) = self
+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 parent (LayoutFlow val self childs) = LayoutFlow val self' childs'


@@ 149,9 151,9 @@ boxMaxWidth parent (LayoutGrid val self cells childs) = LayoutGrid val self cell
     inner (Size cellx celly, child) =
         boxMaxWidth (cellSize (inline self) cellx `size2box` cellSize (block self) celly) child
     size2box x y = zeroBox { B.min = Size x y, B.max = Size x y, B.size = Size x y }
-boxMaxWidth parent self@(LayoutInline _ _ _ _ _) = self
-boxMaxWidth parent self@(LayoutInline' _ _ _ _ _) = self
-boxMaxWidth parent self@(LayoutSpan _ f self') = self
+boxMaxWidth parent self@(LayoutInline _ _ _) = self
+boxMaxWidth parent self@(LayoutInline' _ _ _) = self
+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


@@ 176,11 178,11 @@ boxWidth parent (LayoutGrid val self cells childs) = LayoutGrid val self' cells'
     }
     outerwidth = inline $ size parent
     widths = sizeTrackMaxs (inline $ size parent) $ inline self
-boxWidth parent (LayoutInline val font (Paragraph a b c d) paging vals) =
-    LayoutInline val font (Paragraph a b c d { paragraphMaxWidth = round width }) paging vals
+boxWidth parent (LayoutInline val (Paragraph a b c d) paging) =
+    LayoutInline val (Paragraph a b c d { paragraphMaxWidth = round width }) paging
   where width = B.inline $ B.size parent
-boxWidth _ (LayoutInline' a b c d e) = LayoutInline' a b c d e
-boxWidth parent (LayoutSpan val font self') = LayoutSpan val font self'
+boxWidth _ (LayoutInline' a b c) = LayoutInline' a b c
+boxWidth parent (LayoutSpan self') = LayoutSpan self'
 
 -- | Update a (sub)tree to compute & cache ideal legible height.
 boxNatHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x


@@ 197,9 199,9 @@ boxNatHeight parent (LayoutGrid val self cells childs) = LayoutGrid val self' ce
     cells' = map setCellBox' $ zip childs' cells -- Flatten subgrids
     childs' = map (boxNatHeight width) childs
     width = trackNat id $ inline self
-boxNatHeight parent self@(LayoutInline _ _ _ _ _) = self
-boxNatHeight parent self@(LayoutInline' _ _ _ _ _) = self
-boxNatHeight parent self@(LayoutSpan _ _ _) = self
+boxNatHeight parent self@(LayoutInline _ _ _) = self
+boxNatHeight parent self@(LayoutInline' _ _ _) = self
+boxNatHeight parent self@(LayoutSpan _) = self
 -- | Update a (sub)tree to compute & cache minimum legible height.
 boxMinHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x
 boxMinHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs'


@@ 217,9 219,9 @@ boxMinHeight parent (LayoutGrid val self cells childs) = LayoutGrid val self' ce
     self' = Size (inline self) (block self) { trackMins = heights }
     heights = sizeTrackMins width (block self) $ map block cells
     width = trackNat id $ inline self
-boxMinHeight parent self@(LayoutInline _ _ _ _ _) = self
-boxMinHeight _ self@(LayoutInline' _ _ _ _ _) = self
-boxMinHeight parent self@(LayoutSpan _ font self') = self
+boxMinHeight parent self@(LayoutInline _ _ _) = self
+boxMinHeight _ self@(LayoutInline' _ _ _) = self
+boxMinHeight parent self@(LayoutSpan _) = self
 -- | Update a subtree to compute & cache maximum legible height.
 boxMaxHeight :: PaddedBox Double Double -> LayoutItem Length Double x ->
         LayoutItem Length Double x


@@ 238,11 240,9 @@ boxMaxHeight parent (LayoutGrid val self cells childs) = LayoutGrid val self cel
         child' = boxMaxHeight (gridItemBox self cell) child
     heights = sizeTrackMaxs (inline $ size parent) (block self)
     width = inline $ size parent
-boxMaxHeight parent (LayoutInline val font self' paging vals) =
-    LayoutInline val font self' paging vals
-boxMaxHeight parent (LayoutInline' val font self' paging vals) =
-    LayoutInline' val font self' paging vals
-boxMaxHeight parent (LayoutSpan val font self') = LayoutSpan val font self'
+boxMaxHeight _ (LayoutInline val self' paging) = LayoutInline val self' paging
+boxMaxHeight _ (LayoutInline' val self' paging) = LayoutInline' val self' paging
+boxMaxHeight parent (LayoutSpan self') = LayoutSpan self'
 -- | Update a (sub)tree to compute & cache final height.
 boxHeight :: PaddedBox Double Double -> LayoutItem Length Double x -> LayoutItem Double Double x
 boxHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs'


@@ 269,11 269,9 @@ boxHeight parent (LayoutGrid val self cells0 childs) = LayoutGrid val self' cell
     lowerSize (Left x) = Left $ lowerLength width x
     lowerSize (Right x) = Right x
     width = inline $ size parent
-boxHeight parent (LayoutInline val font self' paging vals) =
-    LayoutInline val font self' paging vals
-boxHeight _ (LayoutInline' val font self' paging vals) =
-    LayoutInline' val font self' paging vals
-boxHeight _ (LayoutSpan val font self') = LayoutSpan val font self'
+boxHeight _ (LayoutInline val self' paging) = LayoutInline val self' paging
+boxHeight _ (LayoutInline' val self' paging) = LayoutInline' val self' paging
+boxHeight _ (LayoutSpan self') = LayoutSpan self'
 
 -- | Split a (sub)tree to fit within max-height.
 -- May take full page height into account.


@@ 301,9 299,9 @@ boxSplit maxheight pageheight (LayoutFlow val self childs)
         where start' = start + height (layoutGetBox child)
     inner _ [] = []
 boxSplit _ _ self@(LayoutGrid _ _ _ _) = (self, Nothing) -- TODO
-boxSplit maxheight pageheight (LayoutInline a b self c d) =
-    boxSplit maxheight pageheight $ LayoutInline' a b (layoutPlain self) c d
-boxSplit maxheight pageheight (LayoutInline' a b self paging c) =
+boxSplit maxheight pageheight (LayoutInline a self b) =
+    boxSplit maxheight pageheight $ LayoutInline' a (layoutRich self) b
+boxSplit maxheight pageheight (LayoutInline' a self paging) =
     case paginate paging {
             pageCurrentHeight = toEnum $ fromEnum maxheight,
             pageNextHeight = toEnum $ fromEnum pageheight


@@ 311,8 309,8 @@ boxSplit maxheight pageheight (LayoutInline' a b self paging c) =
         (Continue, self', next) -> (wrap self', wrap <$> next)
         (Break, _, _) -> (nullLayout, Just $ wrap self)
   where
-    wrap self' = LayoutInline' a b self' paging c
-boxSplit _ _ self@(LayoutSpan _ _ _) = (self, Nothing) -- Can't split!
+    wrap self' = LayoutInline' a self' paging
+boxSplit _ _ self@(LayoutSpan _) = (self, Nothing) -- Can't split!
 -- | Generate a list of pages from a node, splitting subtrees where necessary.
 boxPaginate pageheight node
     | (page, Just overflow) <- boxSplit pageheight pageheight node =


@@ 332,13 330,12 @@ boxPosition pos@(x, y) (LayoutGrid val self cells childs) = LayoutGrid (pos, val
     childs' = map recurse $ zip pos' childs
     recurse ((x', y'), child) = boxPosition (x + x', y + y') child
     pos' = gridPosition self cells
-boxPosition pos@(x, y) (LayoutInline val font self paging vals) =
-    LayoutInline (pos, val) font self paging $ map (\(x, y) -> (fragmentPos font pos y, x)) $
-            inlineChildren vals self
-boxPosition pos@(x, y) (LayoutInline' val font self paging vals) =
-    LayoutInline' (pos, val) font self paging $ map (\(x, y) -> (fragmentPos font pos y, x)) $
-            layoutChildren vals self
-boxPosition pos (LayoutSpan val f self) = LayoutSpan (pos, val) f self -- No children...
+boxPosition pos@(x, y) (LayoutInline val self paging) =
+    boxPosition pos $ LayoutInline' val (layoutRich self) paging
+boxPosition pos@(x, y) (LayoutInline' val self paging) =
+    LayoutInline' (pos, val) (positionChildren pos self) paging
+boxPosition pos (LayoutSpan self@(Fragment (a, b, c) d _ f g h)) =
+    LayoutSpan $ Fragment (a, b, (pos, c)) d [] f g h -- No children...
 -- | Compute sizes & position information for all nodes in the (sub)tree.
 boxLayout :: PropertyParser x => PaddedBox Double Double -> LayoutItem Length Length x ->
         Bool -> [LayoutItem Double Double ((Double, Double), x)]


@@ 359,8 356,8 @@ boxLayout parent self paginate = self9
 -- | Compute a mapping from a layout tree indicating which glyphs for which fonts
 -- are required.
 -- Useful for assembling glyph atlases.
-glyphsPerFont :: LayoutItem x y z -> M.Map (Pattern, Double) IS.IntSet
+{- glyphsPerFont :: LayoutItem x y z -> M.Map (Pattern, Double) IS.IntSet
 glyphsPerFont (LayoutSpan _ font self) =
     (pattern font, fontSize font) `M.singleton` IS.fromList glyphs
   where glyphs = map fromEnum $ map Hb.codepoint $ map fst $ fragmentGlyphs self
-glyphsPerFont node = M.unionsWith IS.union $ map glyphsPerFont $ layoutGetChilds node
+glyphsPerFont node = M.unionsWith IS.union $ map glyphsPerFont $ layoutGetChilds node -}

@@ 9,6 9,11 @@ import Stylist (PropertyParser(..), TrivialPropertyParser, parseOperands,
                 parseUnorderedShorthand', parseUnorderedShorthand)
 import Stylist.Tree (StyleTree(..))
 import Data.Text.ParagraphLayout (PageOptions(..))
+import Data.Text.ParagraphLayout.Rich (paragraphLineHeight, constructParagraph,
+                                        defaultParagraphOptions, textDirection,
+                                        defaultBoxOptions, LineHeight(..),
+                                        InnerNode(..), Box(..), RootNode(..))
+import Data.Text.Glyphize (Direction(..))
 
 import Graphics.Layout.Box as B
 import Graphics.Layout


@@ 20,6 25,7 @@ import Graphics.Layout.Inline.CSS
 
 import Data.Maybe (isJust, fromMaybe)
 import qualified Data.HashMap.Lazy as HM
+import Data.Char (isSpace)
 
 -- | Parsed CSS properties relevant to layout.
 data CSSBox a = CSSBox {


@@ 47,6 53,10 @@ data CSSBox a = CSSBox {
     -- | Parsed widows & orphans controlling pagination.
     pageOptions :: PageOptions
 }
+-- | Accessor for inlineStyle's `textDirection` attribute.
+direction CSSBox { inlineStyles = CSSInline _ opts } = textDirection opts
+-- | Accessor for inlineStyle's options.
+txtOpts CSSBox { inlineStyles = CSSInline _ opts } = opts
 -- | Possible values for CSS box-sizing.
 data BoxSizing = BorderBox | ContentBox
 -- | Empty border, to use as default value.


@@ 114,6 124,17 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
         Just self { cssBox = box { padding = (padding box) { left = x } } }
     longhand _ self@CSSBox {cssBox = box} "padding-right" toks | Just x <- parseLength toks =
         Just self { cssBox = box { padding = (padding box) { right = x } } }
+    longhand _ self@CSSBox {cssBox = box} "padding-inline-start" toks
+        | Just x <- parseLength toks, DirLTR <- direction self =
+            Just self { cssBox = box { padding = (padding box) { left = x } } }
+        | Just x <- parseLength toks, DirRTL <- direction self =
+            Just self { cssBox = box { padding = (padding box) { right = x } } }
+    longhand _ self@CSSBox {cssBox = box} "padding-inline-end" toks
+        | Just x <- parseLength toks, DirLTR <- direction self =
+            Just self { cssBox = box { padding = (padding box) { right = x } } }
+        | Just x <- parseLength toks, DirRTL <- direction self =
+            Just self { cssBox = box { padding = (padding box) { left = x } } }
+
     longhand _ self@CSSBox {cssBox = box} "border-top-width" toks | Just x <- parseLength toks =
         Just self { cssBox = box { border = (border box) { top = x } } }
     longhand _ self@CSSBox {cssBox = box} "border-bottom-width" toks | Just x <- parseLength toks =


@@ 122,6 143,37 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
         Just self { cssBox = box { border = (border box) { left = x } } }
     longhand _ self@CSSBox {cssBox = box} "border-right-width" toks | Just x <- parseLength toks =
         Just self { cssBox = box { border = (border box) { right = x } } }
+    longhand p self "border-inline-start-color" toks
+        | DirLTR <- direction self = longhand p self "border-left-color" toks
+        | DirRTL <- direction self = longhand p self "border-right-color" toks
+    longhand p self "border-inline-start-width" toks
+        | DirLTR <- direction self = longhand p self "border-left-width" toks
+        | DirRTL <- direction self = longhand p self "border-right-width" toks
+    longhand p self "border-inline-start-style" toks
+        | DirLTR <- direction self = longhand p self "border-left-style" toks
+        | DirRTL <- direction self = longhand p self "border-right-style" toks
+    longhand p self "border-inline-end-color" toks
+        | DirLTR <- direction self = longhand p self "border-right-color" toks
+        | DirRTL <- direction self = longhand p self "border-left-color" toks
+    longhand p self "border-inline-end-width" toks
+        | DirLTR <- direction self = longhand p self "border-right-width" toks
+        | DirRTL <- direction self = longhand p self "border-left-width" toks
+    longhand p self "border-inline-end-style" toks
+        | DirLTR <- direction self = longhand p self "border-right-style" toks
+        | DirRTL <- direction self = longhand p self "border-left-style" toks
+    longhand p self "border-start-start-radius" t
+        | DirLTR <- direction self = longhand p self "border-top-left-radius" t
+        | DirRTL <- direction self = longhand p self "border-top-right-radius" t
+    longhand p self "border-start-end-radius" t
+        | DirLTR <- direction self = longhand p self "border-top-right-radius" t
+        | DirRTL <- direction self = longhand p self "border-top-left-radius" t
+    longhand p s "border-end-start-radius" t
+        | DirLTR <- direction s = longhand p s "border-bottom-left-radius" t
+        | DirRTL <- direction s = longhand p s "border-bottom-right-radius" t
+    longhand p s "border-end-end-radius" t
+        | DirLTR <- direction s = longhand p s "border-bottom-right-radius" t
+        | DirRTL <- direction s = longhand p s "border-bottom-left-radius" t
+
     longhand _ self@CSSBox {cssBox = box} "margin-top" toks | Just x <- parseLength toks =
         Just self { cssBox = box { margin = (margin box) { top = x } } }
     longhand _ self@CSSBox {cssBox = box} "margin-bottom" toks | Just x <- parseLength toks =


@@ 130,6 182,31 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
         Just self { cssBox = box { margin = (margin box) { left = x } } }
     longhand _ self@CSSBox {cssBox = box} "margin-right" toks | Just x <- parseLength toks =
         Just self { cssBox = box { margin = (margin box) { right = x } } }
+    longhand _ self@CSSBox {cssBox = box} "margin-inline-start" toks
+        | Just x <- parseLength toks, DirLTR <- direction self =
+            Just self { cssBox = box { margin = (margin box) { left = x } } }
+        | Just x <- parseLength toks, DirRTL <- direction self =
+            Just self { cssBox = box { margin = (margin box) { right = x } } }
+    longhand _ self@CSSBox {cssBox = box} "margin-inline-end" toks
+        | Just x <- parseLength toks, DirLTR <- direction self =
+            Just self { cssBox = box { margin = (margin box) { right = x } } }
+        | Just x <- parseLength toks, DirRTL <- direction self =
+            Just self { cssBox = box { margin = (margin box) { left = x } } }
+
+    -- Placeholder implementations until vertical text is implemented.
+    longhand p self "padding-block-start" t = longhand p self "padding-top" t
+    longhand p self "padding-block-end" t = longhand p self "padding-bottom" t
+    longhand p self "margin-block-start" t = longhand p self "margin-top" t
+    longhand p self "margin-block-end" t = longhand p self "margin-bottom" t
+    longhand p self "border-block-start-color" toks =
+        longhand p self "border-top-color" toks
+    longhand p self "border-block-start-style" toks =
+        longhand p self "border-top-style" toks
+    longhand p self "border-block-start-width" toks =
+        longhand p self "border-top-width" toks
+    longhand p s "border-block-end-color" t = longhand p s "border-bottom-color" t
+    longhand p s "border-block-end-style" t = longhand p s "border-bottom-style" t
+    longhand p s "border-block-end-width" t = longhand p s "border-bottom-width" t
 
     longhand _ self@CSSBox {cssBox = box} "width" toks | Just x <- parseLength' toks =
         Just self { cssBox = box { size = (size box) { inline = x } } }


@@ 260,6 337,22 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
         "border-bottom-color", "border-bottom-style", "border-bottom-width"] toks
     shorthand self "border-left" toks = parseUnorderedShorthand self [
         "border-left-color", "border-left-style", "border-left-width"] toks
+    shorthand self "border-inline" toks = parseUnorderedShorthand self [
+        "border-inline-color", "border-inline-style", "border-inline-width"] toks
+    shorthand self "border-inline-start" toks = parseUnorderedShorthand self [
+        "border-inline-start-color", "border-inline-start-style",
+        "border-inline-start-width"] toks
+    shorthand self "border-inline-end" toks = parseUnorderedShorthand self [
+        "border-inline-end-color", "border-inline-end-style",
+        "border-inline-end-width"] toks
+    shorthand self "border-block" toks = parseUnorderedShorthand self [
+        "border-block-color", "border-block-style", "border-block-width"] toks
+    shorthand self "border-block-start" toks = parseUnorderedShorthand self [
+        "border-block-start-color", "border-block-start-style",
+        "border-block-start-width"] toks
+    shorthand self "border-block-end" toks = parseUnorderedShorthand self [
+        "border-block-end-color", "border-block-end-style",
+        "border-block-end-width"] toks
     shorthand self "border-color" toks
         | length x > 0 && length x <= 4, (top:right:bottom:left:_) <- cycle x,
             all (validProp self "border-top-color") x =


@@ 278,6 371,36 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
                 [("border-top-width", top), ("border-right-width", right),
                  ("border-bottom-width", bottom), ("border-left-width", left)]
       where x = parseOperands toks
+    shorthand self "border-inline-color" toks
+        | length x > 0 && length x <= 2, (s:e:_) <- cycle x,
+            all (validProp self "border-inline-start-color") x =
+                [("border-inline-start-color", s), ("border-inline-end-color", e)]
+      where x = parseOperands toks
+    shorthand self "border-inline-style" toks
+        | length x > 0 && length x <= 2, (s:e:_) <- cycle x,
+            all (validProp self "border-inline-start-style") x =
+                [("border-inline-start-style", s), ("border-inline-end-style", e)]
+      where x = parseOperands toks
+    shorthand self "border-inline-width" toks
+        | length x > 0 && length x <= 2, (s:e:_) <- cycle x,
+            all (validProp self "border-inline-start-width") x =
+                [("border-inline-start-width", s), ("border-inline-end-style", e)]
+      where x = parseOperands toks
+    shorthand self "border-block-color" toks
+        | length x > 0 && length x <= 2, (s:e:_) <- cycle x,
+            all (validProp self "border-block-start-color") x =
+                [("border-block-start-color", s), ("border-block-end-color", e)]
+      where x = parseOperands toks
+    shorthand self "border-block-style" toks
+        | length x > 0 && length x <= 2, (s:e:_) <- cycle x,
+            all (validProp self "border-block-start-style") x =
+                [("border-block-start-style", s), ("border-block-end-style", e)]
+      where x = parseOperands toks
+    shorthand self "border-block-width" toks
+        | length x > 0 && length x <= 2, (s:e:_) <- cycle x,
+            all (validProp self "border-block-start-width") x =
+                [("border-block-start-width", s), ("border-block-end-width", e)]
+      where x = parseOperands toks
 
     shorthand self k v | Just _ <- longhand self self k v = [(k, v)]
     shorthand self k v | ret@(_:_) <- shorthand (font self) k v = ret


@@ 298,7 421,7 @@ finalizeCSS root parent self@StyleTree {
     style = self'@CSSBox { display = Grid, inner = val }, children = childs
   } = LayoutFlow val (finalizeBox self' font_) [
         finalizeGrid (gridStyles self') font_ (map cellStyles $ map style childs)
-            (finalizeChilds root font_ (inner self') childs)]
+            (finalizeChilds root font_ self' childs)]
   where
     font_ = pattern2font (font self') (font' self') parent root
 finalizeCSS root parent self@StyleTree {


@@ 319,26 442,23 @@ finalizeCSS root parent self@StyleTree {
     font_ = pattern2font (font self') (font' self') parent root
 finalizeCSS root parent self@StyleTree {
     style = self'@CSSBox { inner = val }, children = childs
-  } = LayoutFlow val (finalizeBox self' font_) (finalizeChilds root font_ val childs)
+  } = LayoutFlow val (finalizeBox self' font_) (finalizeChilds root font_ self' childs)
   where
     font_ = pattern2font (font self') (font' self') parent root
 finalizeCSS' sysfont self@StyleTree { style = self' } =
     finalizeCSS (pattern2font (font self') (font' self') sysfont sysfont) sysfont self
 
 -- | Desugar a sequence of child nodes, taking care to capture runs of inlines.
-finalizeChilds :: PropertyParser x => Font' -> Font' -> x -> [StyleTree (CSSBox x)] ->
-        [LayoutItem Length Length x]
+finalizeChilds :: PropertyParser x => Font' -> Font' -> CSSBox x ->
+        [StyleTree (CSSBox x)] -> [LayoutItem Length Length x]
 finalizeChilds root parent style' (StyleTree { style = CSSBox { display = None } }:childs) =
     finalizeChilds root parent style' childs
 finalizeChilds root parent style' childs@(child:childs')
-    | isInlineTree childs, Just self <- finalizeParagraph (flattenTree childs) parent =
-        -- FIXME propagate display properties, how to handle the hierarchy.
-        -- NOTE: Playing around in firefox, it appears the CSS borders should cover
-        -- their entire span, doubling up on borders where needed.
-        [LayoutInline (inherit style') parent self paging (repeat $ inherit style')]
+    | isInlineTree childs, Just self <- finalizeParagraph (flattenTree0 childs) =
+        [LayoutInline (inherit $ inner style') self paging]
     | (inlines@(_:_), blocks) <- spanInlines childs,
-        Just self <- finalizeParagraph (flattenTree inlines) parent  =
-            LayoutInline (inherit style') parent self paging (repeat $ inherit style') :
+        Just self <- finalizeParagraph (flattenTree0 inlines) =
+            LayoutInline (inherit $ inner style') self paging :
                 finalizeChilds root parent style' blocks
     | (StyleTree { style = CSSBox { display = Inline } }:childs') <- childs =
         finalizeChilds root parent style' childs' -- Inline's all whitespace...


@@ 355,11 475,26 @@ finalizeChilds root parent style' childs@(child:childs')
           }:blocks)) -> let (inlines', blocks') = spanInlines tail
             in (inlines ++ inlines', blocks' ++ blocks)
         ret -> ret
-    flattenTree (StyleTree { children = child@(_:_) }:childs) =
-        flattenTree child `concatParagraph` flattenTree childs
-    flattenTree (child:childs) =
-        buildParagraph (inlineStyles $ style child) `concatParagraph` flattenTree childs
-    flattenTree [] = ParagraphBuilder "" []
+    flattenTree0 childs = RootBox $ Box (map (flattenTree parent) childs) $
+        flip applyFontInline parent $ txtOpts style'
+    flattenTree p StyleTree { children = child@(_:_), style = self } =
+        InlineBox (f, finalizeBox self f, inner self)
+            (Box (map (flattenTree f) child)
+                $ flip applyFontInline f $ txtOpts self)
+            defaultBoxOptions -- Fill in during layout.
+          where f = pattern2font (font self) (font' self) p root
+    flattenTree f StyleTree {style=self@CSSBox {inlineStyles=CSSInline txt _}} =
+        InlineBox (f, finalizeBox self f, inner self)
+            (Box [TextSequence (f, zero, inherit $ inner self) txt] $
+                flip applyFontInline f $ txtOpts self)
+            defaultBoxOptions -- Fill in during layout.
+    finalizeParagraph (RootBox (Box [TextSequence _ txt] _))
+        | Txt.all isSpace txt = Nothing -- Discard isolated whitespace.
+    finalizeParagraph tree =
+        Just $ constructParagraph "" tree "" defaultParagraphOptions {
+            paragraphLineHeight = Absolute $ toEnum $ fromEnum
+                    (lineheight parent * hbUnit)
+          }
 finalizeChilds _ _ _ [] = []
 
 -- | Desugar most units, possibly in reference to given font.

@@ 1,6 1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | Infrastructure for parsing & desugaring CSS properties related to fonts.
-module Graphics.Layout.CSS.Font(Font'(..), placeholderFont, hbScale, hbUnit,
+module Graphics.Layout.CSS.Font(Font'(..), placeholderFont, hbUnit,
         pattern2hbfont, pattern2font, CSSFont(..), variations') where
 
 import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..), serialize)


@@ 22,9 22,6 @@ import System.IO.Unsafe (unsafePerformIO)
 -- | zero'd `Font'` to serve as the root's parent in a font heirarchy.
 placeholderFont = Font' undefined [] (const 0) (const 0) 0 0 0 0  0 0 0 0  1
 -- | Scale-factor for text-shaping APIs.
-hbScale :: Font' -> Double
-hbScale f = fontSize f*hbUnit
--- | Magic number informing the value of `hbScale`.
 hbUnit = 64 :: Double
 
 -- | Convert from FontConfig query result to a Harfbuzz font.


@@ 78,7 75,7 @@ pattern2font pat styles parent root = Font' {
             Just (font:_, _) -> fontRenderPrepare' q font
             _ -> error "TODO: Set fallback font!"
         font' = pattern2hbfont font (round scale') $ variations' fontSize' styles
-        scale' = fontSize'*hbUnit
+        scale' = hbUnit -- Better way of handling this?
 
 -- | Parsed CSS font properties, excluding the FontConfig query.
 data CSSFont = CSSFont {

@@ 2,12 2,11 @@
 -- | Sizes inline text & extracts positioned children,
 -- wraps Balkón for the actual logic.
 module Graphics.Layout.Inline(inlineMinWidth, inlineMin, inlineNatWidth, inlineHeight,
-    inlineSize, inlineChildren, layoutSize, layoutChildren,
+    inlineSize, inlineChildren, layoutSize, layoutChildren, positionChildren,
     fragmentSize, fragmentSize', fragmentPos) where
 
-import Data.Text.ParagraphLayout (Paragraph(..), ParagraphOptions(..),
-                                    SpanLayout(..), Fragment(..),
-                                    ParagraphLayout(..), layoutPlain, Span(..))
+import Data.Text.ParagraphLayout.Rich (Paragraph(..), ParagraphOptions(..),
+                                Fragment(..), ParagraphLayout(..), layoutRich)
 import Data.Text.ParagraphLayout.Rect (Rect(..), width, height, x_min, y_min)
 import Data.Text.Internal (Text(..))
 import qualified Data.Text as Txt


@@ 15,60 14,68 @@ import Data.Char (isSpace)
 import Data.Int (Int32)
 
 import Graphics.Layout.Box (Size(..), CastDouble(..), fromDouble)
-import Graphics.Layout.CSS.Font (Font', hbScale)
+import Graphics.Layout.CSS.Font (Font', hbUnit)
 
 -- | Convert from Harfbuzz units to device pixels as a Double
-hbScale' font = (/hbScale font) . fromIntegral
+hbScale = (/hbUnit) . fromIntegral
 -- | Convert from Harfbuzz units to device pixels as a Double or Length.
-c font = fromDouble . hbScale' font
+c :: CastDouble a => Int32 -> a
+c = fromDouble . hbScale
 
 -- | Compute minimum width for some richtext.
-inlineMinWidth :: Font' -> Paragraph -> Double
-inlineMinWidth font self = hbScale' font $ width $ layoutPlain' self 0
+inlineMinWidth :: Paragraph a -> Double
+inlineMinWidth self = hbScale $ width $ layoutRich' self 0
 -- | Compute minimum width & height for some richtext.
-inlineMin :: (CastDouble x, CastDouble y) => Font' -> Paragraph -> Size x y
-inlineMin font self = Size (c font $ width rect) (c font $ height rect)
-    where rect = layoutPlain' self 0
+inlineMin :: (CastDouble x, CastDouble y) => Paragraph a -> Size x y
+inlineMin self = Size (c $ width rect) (c $ height rect)
+    where rect = layoutRich' self 0
 -- | Compute natural (single-line) width for some richtext.
-inlineNatWidth :: Font' -> Paragraph -> Double
-inlineNatWidth font self = hbScale' font $ width $ layoutPlain' self maxBound
+inlineNatWidth :: Paragraph a -> Double
+inlineNatWidth self = hbScale $ width $ layoutRich' self maxBound
 -- | Compute height for rich text at given width.
-inlineHeight :: Font' -> Double -> Paragraph -> Double
-inlineHeight font width self =
-    hbScale' font $ height $ layoutPlain' self $ round (hbScale font * width)
+inlineHeight :: Double -> Paragraph a -> Double
+inlineHeight width self =
+    hbScale $ height $ layoutRich' self $ round (hbUnit * width)
 
 -- | Compute width & height of some richtext at configured width.
-inlineSize :: (CastDouble x, CastDouble y) => Font' -> Paragraph -> Size x y
-inlineSize font self = layoutSize font $ layoutPlain self
+inlineSize :: (CastDouble x, CastDouble y) => Paragraph a -> Size x y
+inlineSize self = layoutSize $ layoutRich self
 -- | Retrieve children out of some richtext,
 -- associating given userdata with them.
-inlineChildren :: [x] -> Paragraph -> [(x, Fragment)]
-inlineChildren vals self = layoutChildren vals $ layoutPlain self
+inlineChildren :: Paragraph a -> [Fragment a]
+inlineChildren self = layoutChildren $ layoutRich self
 
 -- | Retrieve a laid-out paragraph's rect & convert to CatTrap types.
-layoutSize :: (CastDouble x, CastDouble y) => Font' -> ParagraphLayout -> Size x y
-layoutSize font self = Size (c font $ width r) (c font $ height r)
+layoutSize :: (CastDouble x, CastDouble y) => ParagraphLayout a -> Size x y
+layoutSize self = Size (c $ width r) (c $ height r)
   where r = paragraphRect self
 -- | Retrieve a laid-out paragraph's children & associate with given userdata.
-layoutChildren :: [x] -> ParagraphLayout -> [(x, Fragment)]
-layoutChildren vals self = zip vals $ concat $ map inner $ spanLayouts self
-  where inner (SpanLayout y) = y
+layoutChildren :: ParagraphLayout a -> [Fragment a]
+layoutChildren self = paragraphFragments self -- TODO: Extract tree...
 
 -- | Layout a paragraph at given width & retrieve resulting rect.
-layoutPlain' :: Paragraph -> Int32 -> Rect Int32
-layoutPlain' (Paragraph a b c d) width =
-    paragraphRect $ layoutPlain $ Paragraph a b c d { paragraphMaxWidth = width }
+layoutRich' :: Paragraph a -> Int32 -> Rect Int32
+layoutRich' (Paragraph a b c d) width =
+    paragraphRect $ layoutRich $ Paragraph a b c d { paragraphMaxWidth = width }
 
 -- | Retrieve the rect for a fragment & convert to CatTrap types.
-fragmentSize :: (CastDouble x, CastDouble y) => Font' -> Fragment -> Size x y
-fragmentSize font self = Size (c font $ width r) (c font $ height r)
+fragmentSize :: (CastDouble x, CastDouble y) => Fragment a -> Size x y
+fragmentSize self = Size (c $ width r) (c $ height r)
     where r = fragmentRect self
 -- | Variant of `fragmentSize` asserting to the typesystem that both fields
 -- of the resulting `Size` are of the same type.
-fragmentSize' :: CastDouble x => Font' -> Fragment -> Size x x
+fragmentSize' :: CastDouble x => Fragment a -> Size x x
 fragmentSize' = fragmentSize -- Work around for typesystem.
 -- | Retrieve the position of a fragment.
-fragmentPos :: Font' -> (Double, Double) -> Fragment -> (Double, Double)
-fragmentPos font (x, y) self =
-        (x + hbScale' font (x_min r), y + hbScale' font (y_min r))
+fragmentPos :: (Double, Double) -> Fragment a -> (Double, Double)
+fragmentPos (x, y) self =
+        (x + hbScale (x_min r), y + hbScale (y_min r))
     where r = fragmentRect self
+
+-- | Alter userdata to hold positions.
+positionChildren :: (Double, Double) -> ParagraphLayout (a, b, c) ->
+                    ParagraphLayout (a, b, ((Double, Double), c))
+positionChildren pos self = self {
+    paragraphFragments = [Fragment (a, b, (fragmentPos pos frag, c)) d [] f g h
+            | frag@(Fragment (a, b, c) d _ f g h) <- paragraphFragments self]
+  }

@@ 1,60 1,48 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | Infrastructure for parsing & desugaring text related CSS properties.
-module Graphics.Layout.Inline.CSS(CSSInline(..), ParagraphBuilder(..),
-    buildParagraph, concatParagraph, finalizeParagraph) where
+module Graphics.Layout.Inline.CSS(CSSInline(..), applyFontInline) where
 
 import Data.CSS.Syntax.Tokens (Token(..))
 import Stylist (PropertyParser(..))
-import qualified Data.Text.Lazy as Lz
 import qualified Data.Text as Txt
 import Data.Text.Internal (Text(..))
-import Data.Text.ParagraphLayout (Span(..), SpanOptions(..), LineHeight(..),
-                                Paragraph(..), ParagraphOptions(..))
+import Data.Text.ParagraphLayout.Rich
+import Data.Text.Glyphize (Direction(..))
 
-import Graphics.Layout.CSS.Font (Font'(..), hbScale)
+import Graphics.Layout.CSS.Font (Font'(..), hbUnit)
 import Data.Char (isSpace)
 
 -- | Document text with Balkón styling options, CSS stylable.
-data CSSInline = CSSInline Lz.Text SpanOptions
+data CSSInline = CSSInline Txt.Text TextOptions
 
 instance PropertyParser CSSInline where
-    temp = CSSInline "" SpanOptions {
-        spanLanguage = "Zxx"
-    }
+    temp = CSSInline "" $ defaultTextOptions DirLTR
     inherit (CSSInline _ opts) = CSSInline "" opts
+    priority _ = ["direction"] -- To inform logical spacing in caller!
 
+    longhand _ (CSSInline _ o) "content" [Ident "initial"] = Just $ CSSInline "" o
     longhand _ (CSSInline _ opts) "content" toks
         | all isString toks =
-            Just $ CSSInline (Lz.concat [Lz.fromStrict x | String x <- toks]) opts
+            Just $ CSSInline (Txt.concat [x | String x <- toks]) opts
       where
         isString (String _) = True
         isString _ = False
+    longhand _ (CSSInline t o) "-argo-lang" [Ident kw]
+        | kw `elem` ["initial", "auto"] = Just $ CSSInline t o {textLanguage=""}
     longhand _ (CSSInline txt opts) "-argo-lang" [String x] =
-        Just $ CSSInline txt opts { spanLanguage = Txt.unpack x }
+        Just $ CSSInline txt opts { textLanguage = Txt.unpack x }
+    longhand _ (CSSInline txt opts) "direction" [Ident "ltr"] =
+        Just $ CSSInline txt opts { textDirection = DirLTR }
+    longhand _ (CSSInline txt opts) "direction" [Ident "rtl"] =
+        Just $ CSSInline txt opts { textDirection = DirRTL }
+    longhand _ (CSSInline txt opts) "direction" [Ident "initial"] =
+        Just $ CSSInline txt opts { textDirection = DirLTR }
     longhand _ _ _ _ = Nothing
 
--- | Helper datastructure for concatenating CSSInlines.
-data ParagraphBuilder = ParagraphBuilder Lz.Text [Span]
-
--- | Convert a CSSInline to a paragraph builder, with a span covering the entire text.
-buildParagraph :: CSSInline -> ParagraphBuilder
-buildParagraph (CSSInline txt opts) =
-    ParagraphBuilder txt [flip Span opts $ fromEnum $ Lz.length txt]
--- | Concatenate two `ParagraphBuilder`s, adjusting the spans appropriately.
-concatParagraph :: ParagraphBuilder -> ParagraphBuilder -> ParagraphBuilder
-concatParagraph (ParagraphBuilder aTxt aOpts) (ParagraphBuilder bTxt bOps) =
-    ParagraphBuilder (aTxt `Lz.append` bTxt)
-                    (aOpts ++ [Span (toEnum (fromEnum $ Lz.length aTxt) + off) opts
-                                | Span off opts <- bOps])
--- | Convert a builder + font to a Balkón paragraph.
-finalizeParagraph :: ParagraphBuilder -> Font' -> Maybe Paragraph
-finalizeParagraph (ParagraphBuilder txt _) _ | Lz.all isSpace txt || Lz.null txt = Nothing
-finalizeParagraph (ParagraphBuilder txt ops) font' = Just $ Paragraph txt' 0 ops pOps
-    where
-        Text txt' _ _ = Lz.toStrict txt
-        pOps = ParagraphOptions {
-            paragraphFont = hbFont font',
-            paragraphLineHeight = Absolute $ round (lineheight font' * hbScale font'),
-            -- This is what we're computing! Configure to give natural width.
-            paragraphMaxWidth = maxBound -- i.e. has all the space it needs...
-        }
+applyFontInline :: TextOptions -> Font' -> TextOptions
+applyFontInline opts font = opts {
+    textFont = hbFont font,
+    textLineHeight = Absolute $ toEnum $ fromEnum $ lineheight font * hbUnit
+  }
+
+

@@ 34,7 34,7 @@ library
                         stylist-traits >= 0.1.3.0 && < 1,
                         fontconfig-pure >= 0.2 && < 0.3,
                         harfbuzz-pure >= 1.0.3.2 && < 1.1, bytestring,
-                        balkon >= 0.2.1 && < 0.3, unordered-containers
+                        balkon >= 1.0 && <2, unordered-containers
   -- hs-source-dirs:
   default-language:    Haskell2010
   ghc-options:         -Wincomplete-patterns