~alcinnz/CatTrap

ref: 0b971321040ca633a863e7d5f012e33b5edc7c30 CatTrap/Graphics/Layout/Inline/CSS.hs -rw-r--r-- 2.3 KiB
0b971321 — Adrian Cochrane Document Graphics.Layout.Grid.CSS 1 year, 5 months ago
                                                                                
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
52
53
54
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Layout.Inline.CSS(CSSInline(..), ParagraphBuilder(..),
    buildParagraph, concatParagraph, finalizeParagraph) 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.Font (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 [flip Span opts $ fromEnum $ Lz.length txt]
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'),
            -- This is what we're computing! Configure to give natural width.
            paragraphMaxWidth = maxBound -- i.e. has all the space it needs...
        }