{-# 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' forall a. HasCallStack => a
undefined [] (forall a b. a -> b -> a
const Double
0) (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 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
B.readFile forall a b. (a -> b) -> a -> b
$ forall x. ToValue x => FilePath -> Pattern -> x
getValue0 FilePath
"file" Pattern
pat
    face :: Face
face = ByteString -> Word -> Face
createFace ByteString
bytes forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ forall x. ToValue x => FilePath -> Pattern -> Maybe x
getValue' FilePath
"index" Pattern
pat
    options :: FontOptions
options = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {a} {a}.
(Eq a, IsString a) =>
FontOptions -> (a, [(a, Value)]) -> FontOptions
value2opt FontOptions
defaultFontOptions { optionScale :: Maybe (Int, Int)
optionScale = forall a. a -> Maybe a
Just (Int
scale, Int
scale) } 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
xforall 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' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Word32 -> Maybe GlyphExtents
fontGlyphExtents Font
font' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word32
fontGlyph',
        fontAdvance :: Char -> Double
fontAdvance = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Word32 -> Int32
fontGlyphHAdvance Font
font' 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) = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ GlyphExtents -> Word32
HB.height GlyphExtents
x
        height' Maybe GlyphExtents
Nothing = Double
fontSize'
        lineheight' :: Double
lineheight' | forall a b. (a, b) -> b
snd (CSSFont -> Unitted
cssLineheight CSSFont
styles) forall a. Eq a => a -> a -> Bool
== Text
"normal",
            Just FontExtents
extents <- Font -> Maybe FontExtents
fontHExtents Font
font' = (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ FontExtents -> Int32
lineGap FontExtents
extents)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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unitted -> Font' -> Length
finalizeLength Unitted
a
        fontGlyph' :: Char -> Word32
fontGlyph' Char
ch = forall a. a -> Maybe a -> a
fromMaybe Word32
0 forall a b. (a -> b) -> a -> b
$ Font -> Char -> Maybe Char -> Maybe Word32
fontGlyph Font
font' Char
ch forall a. Maybe a
Nothing
        q :: Pattern
q | Maybe [(Binding, Value)]
Nothing <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
"family" Pattern
pat, Just [(Binding, Value)]
val <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
"family" forall a b. (a -> b) -> a -> b
$ Font' -> Pattern
pattern Font'
root =
                (FilePath
"family", [(Binding, Value)]
val)forall a. a -> [a] -> [a]
: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 = 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 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)
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"TODO: Set fallback font!"
        font' :: Font
font' = Pattern -> Int -> [Variation] -> Font
pattern2hbfont Pattern
font (forall a b. (RealFrac a, Integral b) => a -> b
round Double
scale') forall a b. (a -> b) -> a -> b
$ Double -> CSSFont -> [Variation]
variations' Double
fontSize' CSSFont
styles
        scale' :: Double
scale' = Double
fontSize' 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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
fontsize)forall a. a -> [a] -> [a]
:) else forall a. a -> a
id)
    (CSSFont -> Variation
slantVariation CSSFont
selfforall a. a -> [a] -> [a]
:CSSFont -> Variation
widthVariation CSSFont
selfforall a. a -> [a] -> [a]
:CSSFont -> Variation
weightVariation CSSFont
selfforall 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 = 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 forall a b. (a -> b) -> a -> b
$ Double
3forall 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 forall a b. (a -> b) -> a -> b
$ Double
3forall 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 forall a b. (a -> b) -> a -> b
$ Double
8forall 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 forall a b. (a -> b) -> a -> b
$ Double
6forall 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 forall a b. (a -> b) -> a -> b
$ Double
3forall 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"] =
        forall a. a -> Maybe a
Just CSSFont
self { cssFontSize :: Unitted
cssFontSize = (Double
xforall 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"] =
        forall a. a -> Maybe a
Just CSSFont
self { cssFontSize :: Unitted
cssFontSize = (Double
xforall 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 = forall a. a -> Maybe a
Just CSSFont
self { cssFontSize :: Unitted
cssFontSize = Unitted
x }

    longhand CSSFont
_ CSSFont
self Text
"line-height" [Ident Text
"normal"] = 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] = forall a. a -> Maybe a
Just CSSFont
self { cssLineheight :: Unitted
cssLineheight = (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 = forall a. a -> Maybe a
Just CSSFont
self { cssLineheight :: Unitted
cssLineheight = Unitted
x }

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

    longhand CSSFont
_ CSSFont
self Text
"font-weight" [Ident Text
"normal"] =
        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"] =
        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"] =
        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 forall a. Ord a => a -> a -> Bool
>= Integer
100 Bool -> Bool -> Bool
&& Integer
x forall a. Ord a => a -> a -> Bool
< Integer
1000 =
        forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght forall a b. (a -> b) -> a -> b
$ 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) forall a. Ord a => a -> a -> Bool
< Float
400 =
            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) forall a. Ord a => a -> a -> Bool
< Float
600 =
            forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght Float
700 }
        | Bool
otherwise = 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) forall a. Ord a => a -> a -> Bool
< Float
600 =
            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) forall a. Ord a => a -> a -> Bool
< Float
800 =
            forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght Float
400 }
        | Bool
otherwise = 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"] =
        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"] =
        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"] =
        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"] =
        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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"initial", Text
"normal"] =
        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"] =
        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"] =
        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"] =
        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"] =
        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] =
        forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth forall a b. (a -> b) -> a -> b
$ 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"] =
        forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
slnt forall a b. (a -> b) -> a -> b
$ 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"] =
        forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
slnt (forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
xforall a. Fractional a => a -> a -> a
/Float
400forall a. Num a => a -> a -> a
*Float
360) }
    longhand CSSFont
_ CSSFont
self Text
"font-style" [Ident Text
"oblique", Dimension Text
_ NumericValue
x Text
"rad"] =
        forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
slnt (forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
xforall a. Num a => a -> a -> a
*Float
180forall a. Fractional a => a -> a -> a
/forall a. Floating a => a
pi) }
    longhand CSSFont
_ CSSFont
self Text
"font-style" [Ident Text
"oblique", Dimension Text
_ NumericValue
x Text
"turn"] =
        forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
slnt (forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
xforall a. Num a => a -> a -> a
*Float
360) }
    longhand CSSFont
_ CSSFont
self Text
"font-style" [Ident Text
"italic"] =
        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"] =
        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"] =
        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"] = forall a. a -> Maybe a
Just CSSFont
s {opticalSize :: Bool
opticalSize = Bool
True}
    longhand CSSFont
_ CSSFont
s Text
"font-optical-sizing" [Ident Text
"initial"] = forall a. a -> Maybe a
Just CSSFont
s {opticalSize :: Bool
opticalSize = Bool
True}
    longhand CSSFont
_ CSSFont
s Text
"font-optical-sizing" [Ident Text
"none"] = forall a. a -> Maybe a
Just CSSFont
s {opticalSize :: Bool
opticalSize = Bool
False}

    longhand CSSFont
_ CSSFont
_ Text
_ [Token]
_ = 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 forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Txt.unpack forall a b. (a -> b) -> a -> b
$ [Token] -> Text
serialize [Token
x, Token
y],
        Just [Variation]
vars <- [Token] -> Maybe [Variation]
parseVariations [Token]
toks = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Variation
varforall a. a -> [a] -> [a]
:[Variation]
vars
parseVariations toks :: [Token]
toks@[String Text
_, Number Text
_ NumericValue
_]
    | Just Variation
var <- FilePath -> Maybe Variation
parseVariation forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Txt.unpack forall a b. (a -> b) -> a -> b
$ [Token] -> Text
serialize [Token]
toks = forall a. a -> Maybe a
Just [Variation
var]
parseVariations [Token]
_ = 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"