{-# 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... }