{-# LANGUAGE OverloadedStrings #-}
-- | Infrastructure for parsing & desugaring CSS properties related to fonts.
module Graphics.Layout.CSS.Font(Font'(..), placeholderFont, hbUnit,
        pattern2hbfont, pattern2font, CSSFont(..), variations') where

import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..), serialize)
import Stylist (PropertyParser(..))
import qualified Data.Text as Txt
import Data.Maybe (fromMaybe)

import Graphics.Layout.Box
import Graphics.Layout.CSS.Length

import Data.Text.Glyphize as HB
import Graphics.Text.Font.Choose (Pattern(..), Value(..), normalizePattern,
                                  getValue', getValue0, setValue, Binding(..),
                                  configSubstitute', defaultSubstitute,
                                  fontSort', MatchKind(..), fontRenderPrepare')
import qualified Data.ByteString as B
import System.IO.Unsafe (unsafePerformIO)

-- | zero'd `Font'` to serve as the root's parent in a font heirarchy.
placeholderFont :: Font'
placeholderFont = Font
-> Pattern
-> (Char -> Double)
-> (Char -> Double)
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Font'
Font' Font
forall a. HasCallStack => a
undefined [] (Double -> Char -> Double
forall a b. a -> b -> a
const Double
0) (Double -> Char -> Double
forall a b. a -> b -> a
const Double
0) Double
0 Double
0 Double
0 Double
0  Double
0 Double
0 Double
0 Double
0  Double
1
-- | Scale-factor for text-shaping APIs.
hbUnit :: Double
hbUnit = Double
64 :: Double

-- | Convert from FontConfig query result to a Harfbuzz font.
pattern2hbfont :: Pattern -> Int -> [Variation] -> Font
pattern2hbfont :: Pattern -> Int -> [Variation] -> Font
pattern2hbfont Pattern
pat Int
scale [Variation]
variations = FontOptions -> Face -> Font
createFontWithOptions FontOptions
options Face
face
  where
    bytes :: ByteString
bytes = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
B.readFile (FilePath -> IO ByteString) -> FilePath -> IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Pattern -> FilePath
forall x. ToValue x => FilePath -> Pattern -> x
getValue0 FilePath
"file" Pattern
pat
    face :: Face
face = ByteString -> Word -> Face
createFace ByteString
bytes (Word -> Face) -> Word -> Face
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ FilePath -> Pattern -> Maybe Int
forall x. ToValue x => FilePath -> Pattern -> Maybe x
getValue' FilePath
"index" Pattern
pat
    options :: FontOptions
options = (FontOptions -> (FilePath, [(Binding, Value)]) -> FontOptions)
-> FontOptions -> Pattern -> FontOptions
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FontOptions -> (FilePath, [(Binding, Value)]) -> FontOptions
forall {a} {a}.
(Eq a, IsString a) =>
FontOptions -> (a, [(a, Value)]) -> FontOptions
value2opt FontOptions
defaultFontOptions { optionScale :: Maybe (Int, Int)
optionScale = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
scale, Int
scale) } (Pattern -> FontOptions) -> Pattern -> FontOptions
forall a b. (a -> b) -> a -> b
$
                Pattern -> Pattern
normalizePattern Pattern
pat

    value2opt :: FontOptions -> (a, [(a, Value)]) -> FontOptions
value2opt FontOptions
opts (a
"slant", (a
_, ValueInt Int
x):[(a, Value)]
_) = FontOptions
opts {
        optionSynthSlant :: Maybe Float
optionSynthSlant = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
x
      }
    value2opt FontOptions
opts (a
"fontvariations", (a, Value)
_:[(a, Value)]
_) = FontOptions
opts {optionVariations :: [Variation]
optionVariations = [Variation]
variations}
    value2opt FontOptions
opts (a, [(a, Value)])
_ = FontOptions
opts

-- | Convert Parsed CSS to a `Font'`.
-- Includes sizing parameters derived from a root & parent `Font'`.
pattern2font :: Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font :: Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font Pattern
pat styles :: CSSFont
styles@CSSFont { cssFontSize :: CSSFont -> Unitted
cssFontSize = (Double
x,Text
"initial") } Font'
parent Font'
root =
    Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font Pattern
pat CSSFont
styles { cssFontSize :: Unitted
cssFontSize = (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
fontSize Font'
root,Text
" ") } Font'
parent Font'
root
pattern2font Pattern
pat CSSFont
styles Font'
parent Font'
root = Font' {
        hbFont :: Font
hbFont = Font
font',
        pattern :: Pattern
pattern = Pattern
font,
        fontHeight :: Char -> Double
fontHeight = Maybe GlyphExtents -> Double
height' (Maybe GlyphExtents -> Double)
-> (Char -> Maybe GlyphExtents) -> Char -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Word32 -> Maybe GlyphExtents
fontGlyphExtents Font
font' (Word32 -> Maybe GlyphExtents)
-> (Char -> Word32) -> Char -> Maybe GlyphExtents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word32
fontGlyph',
        fontAdvance :: Char -> Double
fontAdvance = Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Double) -> (Char -> Int32) -> Char -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Word32 -> Int32
fontGlyphHAdvance Font
font' (Word32 -> Int32) -> (Char -> Word32) -> Char -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word32
fontGlyph',
        fontSize :: Double
fontSize = Double
fontSize',
        rootEm :: Double
rootEm = Font' -> Double
fontSize Font'
root,
        lineheight :: Double
lineheight = Double
lineheight',
        rlh :: Double
rlh = Font' -> Double
lineheight Font'
root,

        vh :: Double
vh = Font' -> Double
vh Font'
root,
        vw :: Double
vw = Font' -> Double
vw Font'
root,
        vmax :: Double
vmax = Font' -> Double
vmax Font'
root,
        vmin :: Double
vmin = Font' -> Double
vmin Font'
root,
        scale :: Double
scale = Font' -> Double
scale Font'
root
    } where
        height' :: Maybe GlyphExtents -> Double
height' (Just GlyphExtents
x) = Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Double) -> Word32 -> Double
forall a b. (a -> b) -> a -> b
$ GlyphExtents -> Word32
HB.height GlyphExtents
x
        height' Maybe GlyphExtents
Nothing = Double
fontSize'
        lineheight' :: Double
lineheight' | Unitted -> Text
forall a b. (a, b) -> b
snd (CSSFont -> Unitted
cssLineheight CSSFont
styles) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"normal",
            Just FontExtents
extents <- Font -> Maybe FontExtents
fontHExtents Font
font' = (Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Double) -> Int32 -> Double
forall a b. (a -> b) -> a -> b
$ FontExtents -> Int32
lineGap FontExtents
extents)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
hbUnit
            | Bool
otherwise = Unitted -> Font' -> Double
lowerLength' (CSSFont -> Unitted
cssLineheight CSSFont
styles) Font'
parent
        fontSize' :: Double
fontSize' = Unitted -> Font' -> Double
lowerLength' (CSSFont -> Unitted
cssFontSize CSSFont
styles) Font'
parent
        lowerLength' :: Unitted -> Font' -> Double
lowerLength' Unitted
a = Double -> Length -> Double
lowerLength (Font' -> Double
fontSize Font'
parent) (Length -> Double) -> (Font' -> Length) -> Font' -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unitted -> Font' -> Length
finalizeLength Unitted
a
        fontGlyph' :: Char -> Word32
fontGlyph' Char
ch = Word32 -> Maybe Word32 -> Word32
forall a. a -> Maybe a -> a
fromMaybe Word32
0 (Maybe Word32 -> Word32) -> Maybe Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Font -> Char -> Maybe Char -> Maybe Word32
fontGlyph Font
font' Char
ch Maybe Char
forall a. Maybe a
Nothing
        q :: Pattern
q | Maybe [(Binding, Value)]
Nothing <- FilePath -> Pattern -> Maybe [(Binding, Value)]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
"family" Pattern
pat, Just [(Binding, Value)]
val <- FilePath -> Pattern -> Maybe [(Binding, Value)]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
"family" (Pattern -> Maybe [(Binding, Value)])
-> Pattern -> Maybe [(Binding, Value)]
forall a b. (a -> b) -> a -> b
$ Font' -> Pattern
pattern Font'
root =
                (FilePath
"family", [(Binding, Value)]
val)(FilePath, [(Binding, Value)]) -> Pattern -> Pattern
forall a. a -> [a] -> [a]
:FilePath -> Binding -> Double -> Pattern -> Pattern
forall x.
ToValue x =>
FilePath -> Binding -> x -> Pattern -> Pattern
setValue FilePath
"size" Binding
Weak (Font' -> Double -> Double
px2pt Font'
root Double
fontSize') Pattern
pat
            | Bool
otherwise = FilePath -> Binding -> Double -> Pattern -> Pattern
forall x.
ToValue x =>
FilePath -> Binding -> x -> Pattern -> Pattern
setValue FilePath
"size" Binding
Weak (Font' -> Double -> Double
px2pt Font'
root Double
fontSize') Pattern
pat
        font :: Pattern
font = case Pattern -> Bool -> Maybe (FontSet, CharSet)
fontSort' (Pattern -> Pattern
defaultSubstitute (Pattern -> Pattern) -> Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ Pattern -> MatchKind -> Pattern
configSubstitute' Pattern
q MatchKind
MatchPattern) Bool
False of
            Just (Pattern
font:FontSet
_, CharSet
_) -> Pattern -> Pattern -> Pattern
fontRenderPrepare' Pattern
q Pattern
font
            Maybe (FontSet, CharSet)
_ -> FilePath -> Pattern
forall a. HasCallStack => FilePath -> a
error FilePath
"TODO: Set fallback font!"
        font' :: Font
font' = Pattern -> Int -> [Variation] -> Font
pattern2hbfont Pattern
font (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
scale') ([Variation] -> Font) -> [Variation] -> Font
forall a b. (a -> b) -> a -> b
$ Double -> CSSFont -> [Variation]
variations' Double
fontSize' CSSFont
styles
        scale' :: Double
scale' = Double
fontSize' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
hbUnit

-- | Parsed CSS font properties, excluding the FontConfig query.
data CSSFont = CSSFont {
    -- | Parsed CSS font-size.
    CSSFont -> Unitted
cssFontSize :: Unitted,
    -- | Parsed CSS line-height.
    CSSFont -> Unitted
cssLineheight :: Unitted,
    -- | Parsed CSS font-variation-settings.
    CSSFont -> [Variation]
variations :: [Variation],
    -- | Parsed CSS font-weight.
    CSSFont -> Variation
weightVariation :: Variation,
    -- | Parsed CSS font-stretch.
    CSSFont -> Variation
widthVariation :: Variation,
    -- | Parsed CSS font-style.
    CSSFont -> Variation
slantVariation :: Variation,
    -- | Parsed CSS font-optical-sizing.
    CSSFont -> Bool
opticalSize :: Bool
}
-- | All font-variations from the parsed CSS properties.
-- | Requires the resolved font-size in case font-optical-sizing is set.
variations' :: Double -> CSSFont -> [Variation]
variations' :: Double -> CSSFont -> [Variation]
variations' Double
fontsize CSSFont
self =
    (if CSSFont -> Bool
opticalSize CSSFont
self then (Word32 -> Float -> Variation
Variation Word32
opsz (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
fontsize)Variation -> [Variation] -> [Variation]
forall a. a -> [a] -> [a]
:) else [Variation] -> [Variation]
forall a. a -> a
id)
    (CSSFont -> Variation
slantVariation CSSFont
selfVariation -> [Variation] -> [Variation]
forall a. a -> [a] -> [a]
:CSSFont -> Variation
widthVariation CSSFont
selfVariation -> [Variation] -> [Variation]
forall a. a -> [a] -> [a]
:CSSFont -> Variation
weightVariation CSSFont
selfVariation -> [Variation] -> [Variation]
forall a. a -> [a] -> [a]
:CSSFont -> [Variation]
variations CSSFont
self)

-- | Represents a multiple of the initial font-size.
-- Resolved by `pattern2font`.
fracDefault :: CSSFont -> Double -> Maybe CSSFont
fracDefault :: CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self Double
frac = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self {
    cssFontSize :: Unitted
cssFontSize = (Double
frac,Text
"initial")
}
instance PropertyParser CSSFont where
    temp :: CSSFont
temp = CSSFont {
        cssFontSize :: Unitted
cssFontSize = (Double
12,Text
"pt"),
        cssLineheight :: Unitted
cssLineheight = (Double
1,Text
""),
        variations :: [Variation]
variations = [],
        weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght Float
400,
        widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth Float
100,
        slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
ital Float
0,
        opticalSize :: Bool
opticalSize = Bool
True
    }
    inherit :: CSSFont -> CSSFont
inherit CSSFont
parent = CSSFont
parent
    priority :: CSSFont -> [Text]
priority CSSFont
_ = []

    longhand :: CSSFont -> CSSFont -> Text -> [Token] -> Maybe CSSFont
longhand CSSFont
_ CSSFont
self Text
"font-size" [Ident Text
"xx-small"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self (Double -> Maybe CSSFont) -> Double -> Maybe CSSFont
forall a b. (a -> b) -> a -> b
$ Double
3Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
5
    longhand CSSFont
_ CSSFont
self Text
"font-size" [Ident Text
"x-small"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self (Double -> Maybe CSSFont) -> Double -> Maybe CSSFont
forall a b. (a -> b) -> a -> b
$ Double
3Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
4
    longhand CSSFont
_ CSSFont
self Text
"font-size" [Ident Text
"small"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self (Double -> Maybe CSSFont) -> Double -> Maybe CSSFont
forall a b. (a -> b) -> a -> b
$ Double
8Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
9
    longhand CSSFont
_ CSSFont
self Text
"font-size" [Ident Text
"medium"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self Double
1
    longhand CSSFont
_ CSSFont
self Text
"font-size" [Ident Text
"initial"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self Double
1
    longhand CSSFont
_ CSSFont
self Text
"font-size" [Ident Text
"large"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self (Double -> Maybe CSSFont) -> Double -> Maybe CSSFont
forall a b. (a -> b) -> a -> b
$ Double
6Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
5
    longhand CSSFont
_ CSSFont
self Text
"font-size" [Ident Text
"x-large"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self (Double -> Maybe CSSFont) -> Double -> Maybe CSSFont
forall a b. (a -> b) -> a -> b
$ Double
3Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2
    longhand CSSFont
_ CSSFont
self Text
"font-size" [Ident Text
"xx-large"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self Double
2
    longhand CSSFont
_ CSSFont
self Text
"font-size" [Ident Text
"xxx-large"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self Double
3
    longhand CSSFont
parent CSSFont
self Text
"font-size" [Ident Text
"larger"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { cssFontSize :: Unitted
cssFontSize = (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
1.2,Text
unit) }
      where (Double
x,Text
unit) = CSSFont -> Unitted
cssFontSize CSSFont
parent
    longhand CSSFont
parent CSSFont
self Text
"font-size" [Ident Text
"smaller"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { cssFontSize :: Unitted
cssFontSize = (Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1.2,Text
unit) }
      where (Double
x, Text
unit) = CSSFont -> Unitted
cssFontSize CSSFont
parent
    longhand CSSFont
_ CSSFont
self Text
"font-size" [Token]
toks
        | Just Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { cssFontSize :: Unitted
cssFontSize = Unitted
x }

    longhand CSSFont
_ CSSFont
self Text
"line-height" [Ident Text
"normal"] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { cssLineheight :: Unitted
cssLineheight = (Double
0,Text
"normal") }
    longhand CSSFont
_ CSSFont
self Text
"line-height" [Number Text
_ NumericValue
x] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { cssLineheight :: Unitted
cssLineheight = (NumericValue -> Double
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x,Text
"em") }
    longhand CSSFont
_ CSSFont
self Text
"line-height" [Token]
toks
        | Just Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { cssLineheight :: Unitted
cssLineheight = Unitted
x }

    longhand CSSFont
_ CSSFont
self Text
"font-variation-settings" [Ident Text
"normal"] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { variations :: [Variation]
variations = [] }
    longhand CSSFont
_ CSSFont
self Text
"font-variation-settings" [Ident Text
"initial"] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self {variations :: [Variation]
variations = []}
    longhand CSSFont
_ CSSFont
self Text
"font-variation-settings" [Token]
toks
        | Just [Variation]
x <- [Token] -> Maybe [Variation]
parseVariations [Token]
toks = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { variations :: [Variation]
variations = [Variation]
x }

    longhand CSSFont
_ CSSFont
self Text
"font-weight" [Ident Text
"normal"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght Float
400 }
    longhand CSSFont
_ CSSFont
self Text
"font-weight" [Ident Text
"initial"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght Float
400 }
    longhand CSSFont
_ CSSFont
self Text
"font-weight" [Ident Text
"bold"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght Float
700 }
    longhand CSSFont
_ CSSFont
self Text
"font-weight" [Number Text
_ (NVInteger Integer
x)] | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
100 Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1000 =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght (Float -> Variation) -> Float -> Variation
forall a b. (a -> b) -> a -> b
$ Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x }
    longhand CSSFont
parent CSSFont
self Text
"font-weight" [Ident Text
"bolder"]
        | Variation -> Float
varValue (CSSFont -> Variation
weightVariation CSSFont
parent) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
400 =
            CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght Float
400 }
        | Variation -> Float
varValue (CSSFont -> Variation
weightVariation CSSFont
parent) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
600 =
            CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght Float
700 }
        | Bool
otherwise = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght Float
900 }
    longhand CSSFont
parent CSSFont
self Text
"font-weight" [Ident Text
"lighter"]
        | Variation -> Float
varValue (CSSFont -> Variation
weightVariation CSSFont
parent) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
600 =
            CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght Float
100 }
        | Variation -> Float
varValue (CSSFont -> Variation
weightVariation CSSFont
parent) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
800 =
            CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght Float
400 }
        | Bool
otherwise = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght Float
700 }

    longhand CSSFont
_ CSSFont
self Text
"font-stretch" [Ident Text
"ultra-condensed"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth Float
50 }
    longhand CSSFont
_ CSSFont
self Text
"font-stretch" [Ident Text
"extra-condensed"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth Float
62.5 }
    longhand CSSFont
_ CSSFont
self Text
"font-stretch" [Ident Text
"condensed"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth Float
75 }
    longhand CSSFont
_ CSSFont
self Text
"font-stretch" [Ident Text
"semi-condensed"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth Float
87.5 }
    longhand CSSFont
_ CSSFont
self Text
"font-stretch" [Ident Text
k] | Text
k Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"initial", Text
"normal"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth Float
100 }
    longhand CSSFont
_ CSSFont
self Text
"font-stretch" [Ident Text
"semi-expanded"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth Float
112.5 }
    longhand CSSFont
_ CSSFont
self Text
"font-stretch" [Ident Text
"expanded"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth Float
125 }
    longhand CSSFont
_ CSSFont
self Text
"font-stretch" [Ident Text
"extra-expanded"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth Float
150 }
    longhand CSSFont
_ CSSFont
self Text
"font-stretch" [Ident Text
"ultra-expanded"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth Float
200 }
    longhand CSSFont
_ CSSFont
self Text
"font-stretch" [Percentage Text
_ NumericValue
x] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth (Float -> Variation) -> Float -> Variation
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x }

    longhand CSSFont
_ CSSFont
self Text
"font-style" [Ident Text
"oblique", Dimension Text
_ NumericValue
x Text
"deg"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
slnt (Float -> Variation) -> Float -> Variation
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x }
    longhand CSSFont
_ CSSFont
self Text
"font-style" [Ident Text
"oblique", Dimension Text
_ NumericValue
x Text
"grad"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
slnt (NumericValue -> Float
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
xFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
400Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
360) }
    longhand CSSFont
_ CSSFont
self Text
"font-style" [Ident Text
"oblique", Dimension Text
_ NumericValue
x Text
"rad"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
slnt (NumericValue -> Float
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
180Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
forall a. Floating a => a
pi) }
    longhand CSSFont
_ CSSFont
self Text
"font-style" [Ident Text
"oblique", Dimension Text
_ NumericValue
x Text
"turn"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
slnt (NumericValue -> Float
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
360) }
    longhand CSSFont
_ CSSFont
self Text
"font-style" [Ident Text
"italic"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
ital Float
1 }
    longhand CSSFont
_ CSSFont
self Text
"font-style" [Ident Text
"normal"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
ital Float
0 }
    longhand CSSFont
_ CSSFont
self Text
"font-style" [Ident Text
"initial"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
ital Float
0 }

    longhand CSSFont
_ CSSFont
s Text
"font-optical-sizing" [Ident Text
"auto"] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
s {opticalSize :: Bool
opticalSize = Bool
True}
    longhand CSSFont
_ CSSFont
s Text
"font-optical-sizing" [Ident Text
"initial"] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
s {opticalSize :: Bool
opticalSize = Bool
True}
    longhand CSSFont
_ CSSFont
s Text
"font-optical-sizing" [Ident Text
"none"] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
s {opticalSize :: Bool
opticalSize = Bool
False}

    longhand CSSFont
_ CSSFont
_ Text
_ [Token]
_ = Maybe CSSFont
forall a. Maybe a
Nothing

-- | Utility for parsing multiple font variations (via Harfbuzz).
parseVariations :: [Token] -> Maybe [Variation]
parseVariations (x :: Token
x@(String Text
_):y :: Token
y@(Number Text
_ NumericValue
_):Token
Comma:[Token]
toks)
    | Just Variation
var <- FilePath -> Maybe Variation
parseVariation (FilePath -> Maybe Variation) -> FilePath -> Maybe Variation
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Txt.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ [Token] -> Text
serialize [Token
x, Token
y],
        Just [Variation]
vars <- [Token] -> Maybe [Variation]
parseVariations [Token]
toks = [Variation] -> Maybe [Variation]
forall a. a -> Maybe a
Just ([Variation] -> Maybe [Variation])
-> [Variation] -> Maybe [Variation]
forall a b. (a -> b) -> a -> b
$ Variation
varVariation -> [Variation] -> [Variation]
forall a. a -> [a] -> [a]
:[Variation]
vars
parseVariations toks :: [Token]
toks@[String Text
_, Number Text
_ NumericValue
_]
    | Just Variation
var <- FilePath -> Maybe Variation
parseVariation (FilePath -> Maybe Variation) -> FilePath -> Maybe Variation
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Txt.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ [Token] -> Text
serialize [Token]
toks = [Variation] -> Maybe [Variation]
forall a. a -> Maybe a
Just [Variation
var]
parseVariations [Token]
_ = Maybe [Variation]
forall a. Maybe a
Nothing

wght :: Word32
wght = FilePath -> Word32
tag_from_string FilePath
"wght"
wdth :: Word32
wdth = FilePath -> Word32
tag_from_string FilePath
"wdth"
slnt :: Word32
slnt = FilePath -> Word32
tag_from_string FilePath
"slnt"
ital :: Word32
ital = FilePath -> Word32
tag_from_string FilePath
"ital"
opsz :: Word32
opsz = FilePath -> Word32
tag_from_string FilePath
"opsz"