1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
{-# 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 Graphics.Layout.CSS.Internal (Font'(..), hbScale)
import Data.Char (isSpace)
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' -> 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'),
paragraphMaxWidth = 0 -- This is what we're computing!
}