4 files changed, 50 insertions(+), 46 deletions(-)

M Graphics/Layout.hs
M Graphics/Layout/Box.hs
M Graphics/Layout/CSS.hs
M Graphics/Layout/CSS/Internal.hs

@@ 7,14 7,15 @@ import Graphics.Layout.Box as B
 import Graphics.Layout.Grid as G
 import Graphics.Layout.Flow as F
 import Graphics.Layout.Inline as I
+import Graphics.Layout.CSS.Internal (Font')
 
 import Data.Maybe (fromMaybe)
 
 data LayoutItem m n x =
     LayoutFlow x (PaddedBox m n) [LayoutItem m n x]
     | LayoutGrid x (Grid m n) [(GridItem m n, LayoutItem m n x)]
-    | LayoutInline x Paragraph [x] -- Balkon holds children.
-    | LayoutSpan x Fragment
+    | LayoutInline x Font' Paragraph [x] -- Balkon holds children.
+    | LayoutSpan x Font' Fragment
 -- More to come...
 
 layoutGetBox :: (Zero m, Zero n, CastDouble m, CastDouble n) =>


@@ 25,21 26,21 @@ layoutGetBox (LayoutGrid _ self _) = zero {
     B.size = containerSize self,
     B.max = containerMax self
 }
-layoutGetBox (LayoutInline _ self _) = zero {
-    B.min = inlineSize self, B.size = inlineSize self, B.max = inlineSize self
+layoutGetBox (LayoutInline _ f self _) = zero {
+    B.min = inlineSize f self, B.size = inlineSize f self, B.max = inlineSize f self
 }
-layoutGetBox (LayoutSpan _ self) = zero {
-    B.min = fragmentSize self, B.size = fragmentSize self, B.max = fragmentSize self
+layoutGetBox (LayoutSpan _ f self) = zero {
+    B.min = fragmentSize f self, B.size = fragmentSize f self, B.max = fragmentSize f self
 }
 layoutGetChilds (LayoutFlow _ _ ret) = ret
 layoutGetChilds (LayoutGrid _ _ ret) = map snd ret
-layoutGetChilds (LayoutSpan _ _) = []
-layoutGetChilds (LayoutInline _ self vals) =
-    map (uncurry LayoutSpan) $ inlineChildren vals self
+layoutGetChilds (LayoutSpan _ _ _) = []
+layoutGetChilds (LayoutInline _ font self vals) = map inner $ inlineChildren vals self
+  where inner (val, fragment) = LayoutSpan val font fragment
 layoutGetInner (LayoutFlow ret _ _) = ret
 layoutGetInner (LayoutGrid ret _ _) = ret
-layoutGetInner (LayoutInline ret _ _) = ret
-layoutGetInner (LayoutSpan ret _) = ret
+layoutGetInner (LayoutInline ret _ _ _) = ret
+layoutGetInner (LayoutSpan ret _ _) = ret
 
 setCellBox' (child, cell) = cell { gridItemBox = layoutGetBox child }
 


@@ 72,8 73,8 @@ boxMinWidth parent (LayoutGrid val self childs) =
         (GridItem {..}, _) <- childs]) parent
     zeroBox :: PaddedBox Double Double
     zeroBox = zero
-boxMinWidth _ self@(LayoutInline _ self' _) = (inlineMinWidth self', self)
-boxMinWidth _ self@(LayoutSpan _ self') = (B.inline $ fragmentSize' self', self)
+boxMinWidth _ self@(LayoutInline _ font self' _) = (inlineMinWidth font self', self)
+boxMinWidth _ self@(LayoutSpan _ f self') = (B.inline $ fragmentSize' f self', self)
 boxNatWidth :: (Zero y, CastDouble y) =>
         Maybe Double -> LayoutItem y Length x -> (Double, LayoutItem y Length x)
 boxNatWidth parent (LayoutFlow val self childs) = (size', LayoutFlow val self childs')


@@ 107,8 108,8 @@ boxNatWidth parent (LayoutGrid val self childs) =
         (GridItem {..}, _) <- childs]) parent
     zeroBox :: PaddedBox Double Double
     zeroBox = zero
-boxNatWidth _ self@(LayoutInline _ self' _) = (inlineNatWidth self', self)
-boxNatWidth _ self@(LayoutSpan _ self') = (B.inline $ fragmentSize' self', self)
+boxNatWidth _ self@(LayoutInline _ font self' _) = (inlineNatWidth font self', self)
+boxNatWidth _ self@(LayoutSpan _ f self') = (B.inline $ fragmentSize' f self', self)
 boxMaxWidth :: PaddedBox a Double -> LayoutItem y Length x -> (Double, LayoutItem y Length x)
 boxMaxWidth parent (LayoutFlow val self childs) = (max', LayoutFlow val self' childs)
   where


@@ 119,8 120,8 @@ boxMaxWidth parent (LayoutGrid val self childs) =
   where
     self' = self { containerMax = Size (Pixels max') (block $ containerMax self) }
     (max', _) = gridMaxWidths parent self $ colBounds self
-boxMaxWidth parent self@(LayoutInline _ _ _) = (B.inline $ B.max parent, self)
-boxMaxWidth parent self@(LayoutSpan _ self') = (B.inline $ fragmentSize' self', self)
+boxMaxWidth parent self@(LayoutInline _ _ _ _) = (B.inline $ B.max parent, self)
+boxMaxWidth parent self@(LayoutSpan _ f self') = (B.inline $ fragmentSize' f self', self)
 boxWidth :: (Zero y, CastDouble y) => PaddedBox b Double -> LayoutItem y Length x ->
         (Double, LayoutItem y Double x)
 boxWidth parent (LayoutFlow val self childs) = (size', LayoutFlow val self' childs')


@@ 156,11 157,11 @@ boxWidth parent (LayoutGrid val self childs) = (size', LayoutGrid val self' chil
       }
     outerwidth = inline $ size parent
     (size', widths) = gridWidths parent self $ colBounds self
-boxWidth parent (LayoutInline val (Paragraph a b c d) vals) =
-    (width, LayoutInline val (Paragraph a b c d { paragraphMaxWidth = round width }) vals)
+boxWidth parent (LayoutInline val font (Paragraph a b c d) vals) =
+    (width, LayoutInline val font (Paragraph a b c d { paragraphMaxWidth = round width }) vals)
   where width = B.inline $ B.size parent
-boxWidth parent (LayoutSpan val self') =
-    (B.inline $ fragmentSize' self', LayoutSpan val self')
+boxWidth parent (LayoutSpan val font self') =
+    (B.inline $ fragmentSize' font self', LayoutSpan val font self')
 
 boxNatHeight :: Double -> LayoutItem Length Double x -> (Double, LayoutItem Length Double x)
 boxNatHeight parent (LayoutFlow val self childs) = (size', LayoutFlow val self' childs')


@@ 185,8 186,8 @@ boxNatHeight parent (LayoutGrid val self childs) =
     cells = map setCellBox' $ zip childs' $ map fst childs
     childs' = map snd $ map (boxNatHeight width) $ map snd childs
     width = inline $ containerSize self
-boxNatHeight parent self@(LayoutInline _ self' _) = (inlineHeight parent self', self)
-boxNatHeight parent self@(LayoutSpan _ self') = (B.block $ fragmentSize' self', self)
+boxNatHeight parent self@(LayoutInline _ font self' _) = (inlineHeight font parent self', self)
+boxNatHeight parent self@(LayoutSpan _ font self') = (B.block $ fragmentSize' font self', self)
 boxMinHeight :: Double -> LayoutItem Length Double x -> (Double, LayoutItem Length Double x)
 boxMinHeight parent (LayoutFlow val self childs) = (min', LayoutFlow val self' childs')
   where


@@ 213,8 214,8 @@ boxMinHeight parent (LayoutGrid val self childs) = (min', LayoutGrid val self' c
         startCol = startCol cell, endCol = endCol cell, alignment = alignment cell
       } | (cell, _) <- childs]
     width = inline $ containerSize self
-boxMinHeight parent self@(LayoutInline _ self' _) = (inlineHeight parent self', self)
-boxMinHeight parent self@(LayoutSpan _ self') = (B.block $ fragmentSize' self', self)
+boxMinHeight parent self@(LayoutInline _ font self' _) = (inlineHeight font parent self', self)
+boxMinHeight parent self@(LayoutSpan _ font self') = (B.block $ fragmentSize' font self', self)
 boxMaxHeight :: PaddedBox Double Double -> LayoutItem Length Double x ->
         (Double, LayoutItem Length Double x)
 boxMaxHeight parent (LayoutFlow val self childs) = (max', LayoutFlow val self' childs')


@@ 243,10 244,11 @@ boxMaxHeight parent (LayoutGrid val self childs) = (max', LayoutGrid val self' c
       }
     (max', heights) = gridMaxHeights parent self $ rowBounds self
     width = inline $ size parent
-boxMaxHeight parent (LayoutInline val self' vals) =
-    (inlineHeight (B.inline $ B.size parent) self', LayoutInline val self' vals)
-boxMaxHeight parent (LayoutSpan val self') =
-    (B.block $ fragmentSize' self', LayoutSpan val self')
+boxMaxHeight parent (LayoutInline val font self' vals) =
+    (inlineHeight font (B.inline $ B.size parent) self',
+    LayoutInline val font self' vals)
+boxMaxHeight parent (LayoutSpan val font self') =
+    (B.block $ fragmentSize' font self', LayoutSpan val font self')
 boxHeight :: PaddedBox Double Double -> LayoutItem Length Double x ->
         (Double, LayoutItem Double Double x)
 boxHeight parent (LayoutFlow val self childs) = (size', LayoutFlow val self' childs')


@@ 278,9 280,11 @@ boxHeight parent (LayoutGrid val self childs) = (size', LayoutGrid val self' chi
     lowerSize (Left x) = Left $ lowerLength width x
     lowerSize (Right x) = Right x
     width = inline $ size parent
-boxHeight parent (LayoutInline val self' vals) =
-    (inlineHeight (B.inline $ B.size parent) self', LayoutInline val self' vals)
-boxHeight _ (LayoutSpan val self') = (B.block $ fragmentSize' self', LayoutSpan val self')
+boxHeight parent (LayoutInline val font self' vals) =
+    (inlineHeight font (B.inline $ B.size parent) self',
+    LayoutInline val font self' vals)
+boxHeight _ (LayoutSpan val font self') =
+    (B.block $ fragmentSize' font self', LayoutSpan val font self')
 
 boxPosition :: (Double, Double) -> LayoutItem Double Double x ->
     LayoutItem Double Double ((Double, Double), x)


@@ 294,10 298,10 @@ boxPosition pos@(x, y) (LayoutGrid val self childs) = LayoutGrid (pos, val) self
     childs' = map recurse $ zip pos' childs
     recurse ((Size x' y'), (cell, child)) = (cell, boxPosition (x + x', y + y') child)
     pos' = gridPosition self $ map fst childs
-boxPosition pos@(x, y) (LayoutInline val self vals) =
-    LayoutInline (pos, val) self $ map (\(x, y) -> (fragmentPos pos y, x)) $
+boxPosition pos@(x, y) (LayoutInline val font self vals) =
+    LayoutInline (pos, val) font self $ map (\(x, y) -> (fragmentPos font pos y, x)) $
             inlineChildren vals self
-boxPosition pos (LayoutSpan val self) = LayoutSpan (pos, val) self -- No children...
+boxPosition pos (LayoutSpan val f self) = LayoutSpan (pos, val) f self -- No children...
 boxLayout :: PaddedBox Double Double -> LayoutItem Length Length x -> Bool ->
         LayoutItem Double Double ((Double, Double), x)
 boxLayout parent self paginate = self8

@@ 95,8 95,6 @@ instance (Zero m, Zero n) => Zero (PaddedBox m n) where
 
 class CastDouble a where
     fromDouble :: Double -> a
-fromIntegral' :: (Integral a, CastDouble b) => a -> b
-fromIntegral' = fromDouble . fromIntegral
 
 instance CastDouble Double where fromDouble = id
 instance CastDouble Length where fromDouble = Pixels

@@ 193,9 193,10 @@ finalizeChilds :: PropertyParser x => Font' -> Font' -> [StyleTree (CSSBox x)] -
 finalizeChilds root parent childs@(child:childs')
     | isInlineTree childs =
         -- FIXME propagate display properties, how to handle the hierarchy.
-        [LayoutInline temp (finalizeParagraph (flattenTree childs) parent) (repeat temp)]
+        [LayoutInline temp parent (finalizeParagraph (flattenTree childs) parent)
+                    (repeat temp)]
     | (inlines@(_:_), blocks) <- spanInlines childs =
-        LayoutInline temp (finalizeParagraph (flattenTree childs) parent) []
+        LayoutInline temp parent (finalizeParagraph (flattenTree childs) parent) []
             :finalizeChilds root parent blocks
     | otherwise = finalizeCSS root parent child : finalizeChilds root parent childs'
   where

@@ 78,14 78,15 @@ data Font' = Font' {
     scale :: Double
 }
 placeholderFont = Font' Nothing (const 0) (const 0) 0 0 0 0  0 0 0 0  1
-ppem f = fontSize f/scale f
+hbScale f = fontSize f*hbUnit
+hbUnit = 64
 
-pattern2hbfont :: Pattern -> Word -> [Variation] -> Font
-pattern2hbfont pat ppem variations = createFontWithOptions options face
+pattern2hbfont :: Pattern -> Int -> [Variation] -> Font
+pattern2hbfont pat scale variations = createFontWithOptions options face
   where
     bytes = unsafePerformIO $ B.readFile $ getValue0 "file" pat
     face = createFace bytes $ toEnum $ fromMaybe 0 $ getValue' "index" pat
-    options = foldl value2opt defaultFontOptions { optionPPEm = Just (ppem, ppem) } $
+    options = foldl value2opt defaultFontOptions { optionScale = Just (scale, scale) } $
                 normalizePattern pat
 
     value2opt opts ("slant", (_, ValueInt x):_) = opts {


@@ 113,13 114,13 @@ pattern2font pat styles parent root = Font' {
         height' (Just x) = fromIntegral $ HB.height x
         height' Nothing = fontSize'
         lineheight' | snd (cssLineheight styles) == "normal",
-            Just extents <- fontHExtents font' = (fromIntegral $ lineGap extents)/ppem
+            Just extents <- fontHExtents font' = (fromIntegral $ lineGap extents)/scale'
             | otherwise = lowerLength' (cssLineheight styles) parent
         fontSize' = lowerLength' (cssFontSize styles) parent
         lowerLength' a = lowerLength (fontSize parent) . finalizeLength a
         fontGlyph' ch = fromMaybe 0 $ fontGlyph font' ch Nothing
-        font' = pattern2hbfont pat (round ppem) $ variations' fontSize' styles
-        ppem = fontSize'/scale root
+        font' = pattern2hbfont pat (round scale') $ variations' fontSize' styles
+        scale' = fontSize'*hbUnit
 
 data CSSFont = CSSFont {
     cssFontSize :: Unitted,