2 files changed, 93 insertions(+), 0 deletions(-)

A Graphics/Layout/Inline.hs
A Graphics/Layout/Inline/CSS.hs

@@ 0,0 1,43 @@
+{-# LANGUAGE TupleSections #-}
+module Graphics.Layout.Inline where
+
+import Data.Text.ParagraphLayout (Paragraph(..), ParagraphOptions(..),
+                                    SpanLayout(..), Fragment(..),
+                                    ParagraphLayout(..), layoutPlain)
+import Data.Text.ParagraphLayout.Rect (Rect, width, height, x_min, y_min)
+import Data.Int (Int32)
+
+import Graphics.Layout.Box (Size(..), CastDouble(..), fromDouble)
+import Graphics.Layout.CSS.Internal (Font', hbScale)
+
+hbScale' font = (/hbScale font) . fromIntegral
+c font = fromDouble . hbScale' font
+
+inlineMinWidth :: Font' -> Paragraph -> Double
+inlineMinWidth font self = hbScale' font $ width $ layoutPlain' self 0
+inlineNatWidth :: Font' -> Paragraph -> Double
+inlineNatWidth font self = hbScale' font $ width $ layoutPlain' self maxBound
+inlineHeight :: Font' -> Double -> Paragraph -> Double
+inlineHeight font width self =
+    hbScale' font $ height $ layoutPlain' self $ round (hbScale font * width)
+
+inlineSize :: (CastDouble x, CastDouble y) => Font' -> Paragraph -> Size x y
+inlineSize font self = Size (c font $ width r) (c font $ height r)
+  where r = paragraphRect $ layoutPlain self
+inlineChildren :: [x] -> Paragraph -> [(x, Fragment)]
+inlineChildren vals = concat . map inner . zip vals . spanLayouts . layoutPlain
+  where inner (x, SpanLayout y) = map (x,) y
+
+layoutPlain' :: Paragraph -> Int32 -> Rect Int32
+layoutPlain' (Paragraph a b c d) width =
+    paragraphRect $ layoutPlain $ Paragraph a b c d { paragraphMaxWidth = width }
+
+fragmentSize :: (CastDouble x, CastDouble y) => Font' -> Fragment -> Size x y
+fragmentSize font self = Size (c font $ width r) (c font $ height r)
+    where r = fragmentRect self
+fragmentSize' :: CastDouble x => Font' -> Fragment -> Size x x
+fragmentSize' = fragmentSize -- Work around for typesystem.
+fragmentPos :: Font' -> (Double, Double) -> Fragment -> (Double, Double)
+fragmentPos font (x, y) self =
+        (x + hbScale' font (x_min r), y + hbScale' font (y_min r))
+    where r = fragmentRect self

@@ 0,0 1,50 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Graphics.Layout.Inline.CSS 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.Maybe (fromJust)
+
+import Graphics.Layout.CSS.Internal (Font'(..), hbScale)
+
+data CSSInline = CSSInline Lz.Text SpanOptions
+
+instance PropertyParser CSSInline where
+    temp = CSSInline "" SpanOptions {
+        spanLanguage = "Zxx"
+    }
+    inherit (CSSInline _ opts) = CSSInline "" opts
+
+    longhand _ (CSSInline _ opts) "content" toks
+        | all isString toks =
+            Just $ CSSInline (Lz.concat [Lz.fromStrict x | String x <- toks]) opts
+      where
+        isString (String _) = True
+        isString _ = False
+    longhand _ (CSSInline txt opts) "-argo-lang" [String x] =
+        Just $ CSSInline txt opts { spanLanguage = Txt.unpack x }
+    longhand _ _ _ _ = Nothing
+
+data ParagraphBuilder = ParagraphBuilder Lz.Text [Span]
+
+buildParagraph :: CSSInline -> ParagraphBuilder
+buildParagraph (CSSInline txt opts) = ParagraphBuilder txt [Span 0 opts]
+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])
+finalizeParagraph :: ParagraphBuilder -> Font' -> Paragraph
+finalizeParagraph (ParagraphBuilder txt ops) font' = Paragraph txt' 0 ops pOps
+    where
+        Text txt' _ _ = Lz.toStrict txt
+        pOps = ParagraphOptions {
+            paragraphFont = fromJust $ hbFont font',
+            paragraphLineHeight = Absolute $ round (lineheight font' * hbScale font'),
+            paragraphMaxWidth = 0 -- This is what we're computing!
+        }