{-# LANGUAGE OverloadedStrings #-}
-- | Infrastructure for parsing & desugaring length units & keywords,
-- in reference to the selected font.
module Graphics.Layout.CSS.Length(Unitted, auto, parseLength, parseLength', units,
        n2f, finalizeLength, finalizeLengths, px2pt, Font'(..)) where

import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import qualified Data.Text as Txt
import Data.Scientific (toRealFloat, fromFloatDigits)
import Debug.Trace (trace) -- For warnings.
import Data.Text.Glyphize (Font)
import Graphics.Text.Font.Choose (Pattern(..))

import Graphics.Layout.Box

-- | A number+unit, prior to resolving side units.
-- The unit may alternately represent a keyword, in which case the number is
-- ignored & typically set to 0.
type Unitted = (Double, Txt.Text)
-- | The CSS `auto` keyword.
auto :: Unitted
auto :: Unitted
auto = (Double
0,Text
"auto")

-- | Parse a pre-tokenized CSS length value.
parseLength :: [Token] -> Maybe Unitted
parseLength :: [Token] -> Maybe Unitted
parseLength [Percentage Text
_ NumericValue
x] = forall a. a -> Maybe a
Just (forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x,Text
"%")
parseLength [Dimension Text
_ NumericValue
x Text
unit]
    | forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x forall a. Eq a => a -> a -> Bool
== Double
0 Bool -> Bool -> Bool
&& Text
unit forall a. Eq a => a -> a -> Bool
== Text
"" = forall a. a -> Maybe a
Just (Double
0,Text
"px")
    | Text
unit forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
units = forall a. a -> Maybe a
Just (forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x,Text
unit)
parseLength [Number Text
_ NumericValue
x] | forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x forall a. Eq a => a -> a -> Bool
== Double
0 = forall a. a -> Maybe a
Just (Double
0,Text
"px")
parseLength [Ident Text
"auto"] = forall a. a -> Maybe a
Just (Double
0,Text
"auto")
parseLength [Ident Text
"initial"] = forall a. a -> Maybe a
Just (Double
0,Text
"auto")
parseLength [Token]
_ = forall a. Maybe a
Nothing
-- | Variant of `parseLength` which supports min-content & max-content keywords.
parseLength' :: [Token] -> Maybe Unitted
parseLength' [Ident Text
"min-content"] = forall a. a -> Maybe a
Just (Double
0,Text
"min-content")
parseLength' [Ident Text
"max-content"] = forall a. a -> Maybe a
Just (Double
0,Text
"max-content")
parseLength' [Token]
toks = [Token] -> Maybe Unitted
parseLength [Token]
toks

-- | Supported length units.
units :: [Text]
units = Text -> [Text]
Txt.words Text
"cap ch em ex ic lh rem rlh vh vw vmax vmin px cm mm Q in pc pt %"

-- | Convert a lexed number to a Double.
n2f :: (Fractional x, RealFloat x) => NumericValue -> x
n2f :: forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f (NVInteger Integer
x) = forall a b. (Real a, Fractional b) => a -> b
realToFrac Integer
x
n2f (NVNumber Scientific
x) = forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
x

-- | Resolve a parsed length according to the sizing parameters in a given `Font'`.
finalizeLength :: Unitted -> Font' -> Length
finalizeLength :: Unitted -> Font' -> Length
finalizeLength (Double
x,Text
"cap") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Char -> Double
fontHeight Font'
f Char
'A'
finalizeLength (Double
x,Text
"ch") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Char -> Double
fontAdvance Font'
f Char
'0'
finalizeLength (Double
x,Text
"em") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Double
fontSize Font'
f
finalizeLength (Double
x,Text
"") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Double
fontSize Font'
f -- For line-height.
finalizeLength (Double
x,Text
"ex") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Char -> Double
fontHeight Font'
f Char
'x'
finalizeLength (Double
x,Text
"ic") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Char -> Double
fontHeight Font'
f Char
'水' -- CJK water ideograph
finalizeLength (Double
x,Text
"lh") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Double
lineheight Font'
f
finalizeLength (Double
x,Text
"rem") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Double
rootEm Font'
f
finalizeLength (Double
x,Text
"rlh") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Double
rlh Font'
f
finalizeLength (Double
x,Text
"vh") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Double
vh Font'
f
finalizeLength (Double
x,Text
"vb") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Double
vh Font'
f -- TODO: Support vertical text
finalizeLength (Double
x,Text
"vw") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Double
vw Font'
f
finalizeLength (Double
x,Text
"vi") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Double
vw Font'
f -- TODO: Support vertical text
finalizeLength (Double
x,Text
"vmax") Font'
f = Double -> Length
Percent forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Double
vmax Font'
f
finalizeLength (Double
x,Text
"vmin") Font'
f = Double -> Length
Percent forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Double
vmin Font'
f
finalizeLength (Double
x,Text
"px") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Double
scale Font'
f
finalizeLength (Double
x,Text
"cm") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Font' -> Double
scale Font'
fforall a. Num a => a -> a -> a
*Double
96forall a. Fractional a => a -> a -> a
/Double
2.54
finalizeLength (Double
x,Text
"in") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
xforall a. Num a => a -> a -> a
*Double
96forall a. Num a => a -> a -> a
*Font' -> Double
scale Font'
f
finalizeLength (Double
x,Text
"mm") Font'
f | Pixels Double
x' <- Unitted -> Font' -> Length
finalizeLength (Double
x,Text
"cm") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
x'forall a. Fractional a => a -> a -> a
/Double
10
finalizeLength (Double
x,Text
"Q") Font'
f | Pixels Double
x' <- Unitted -> Font' -> Length
finalizeLength (Double
x,Text
"cm") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
x'forall a. Fractional a => a -> a -> a
/Double
40
finalizeLength (Double
x,Text
"pc") Font'
f | Pixels Double
x' <- Unitted -> Font' -> Length
finalizeLength (Double
x,Text
"in") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
x'forall a. Fractional a => a -> a -> a
/Double
6
finalizeLength (Double
x,Text
"pt") Font'
f | Pixels Double
x' <- Unitted -> Font' -> Length
finalizeLength (Double
x,Text
"in") Font'
f = Double -> Length
Pixels forall a b. (a -> b) -> a -> b
$ Double
x'forall a. Fractional a => a -> a -> a
/Double
72
finalizeLength (Double
x,Text
"%") Font'
_ = Double -> Length
Percent forall a b. (a -> b) -> a -> b
$ Double
xforall a. Fractional a => a -> a -> a
/Double
100
finalizeLength (Double
_,Text
"auto") Font'
_ = Length
Auto
finalizeLength (Double
_,Text
"min-content") Font'
_ = Length
Min
finalizeLength (Double
_,Text
"max-content") Font'
_ = Length
Preferred
finalizeLength (Double
x, Text
" ") Font'
_ = Double -> Length
Pixels Double
x -- Internal constant value...
finalizeLength (Double
_,Text
unit) Font'
_ = forall a. [Char] -> a -> a
trace ([Char]
"Invalid unit " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Txt.unpack Text
unit) forall a b. (a -> b) -> a -> b
$ Double -> Length
Pixels Double
0
-- | Convert from a computed length to the "pt" unit.
px2pt :: Font' -> Double -> Double
px2pt Font'
f Double
x = Double
x forall a. Fractional a => a -> a -> a
/ Font' -> Double
scale Font'
f forall a. Fractional a => a -> a -> a
/ Double
96 forall a. Num a => a -> a -> a
* Double
72

-- | Convert any length-units in the given CSS tokens to device pixels
finalizeLengths :: Font' -> [Token] -> [Token]
finalizeLengths :: Font' -> [Token] -> [Token]
finalizeLengths Font'
f (Dimension Text
_ NumericValue
x Text
unit:[Token]
toks)
    | Text
unit forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
units, Pixels Double
y <- Unitted -> Font' -> Length
finalizeLength (forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x,Text
unit) Font'
f =
        Text -> NumericValue -> Text -> Token
Dimension Text
"" (Scientific -> NumericValue
NVNumber forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> Scientific
fromFloatDigits Double
y) Text
"px"forall a. a -> [a] -> [a]
:Font' -> [Token] -> [Token]
finalizeLengths Font'
f [Token]
toks
finalizeLengths Font'
f (Number Text
a NumericValue
b:[Token]
ts)|forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
bforall a. Eq a => a -> a -> Bool
==Double
0=Text -> NumericValue -> Text -> Token
Dimension Text
a NumericValue
b Text
"px"forall a. a -> [a] -> [a]
:Font' -> [Token] -> [Token]
finalizeLengths Font'
f [Token]
ts
finalizeLengths Font'
f (Token
tok:[Token]
toks) = Token
tokforall a. a -> [a] -> [a]
:Font' -> [Token] -> [Token]
finalizeLengths Font'
f [Token]
toks
finalizeLengths Font'
_ [] = []

-- | A Harfbuzz font with sizing parameters.
data Font' = Font' {
    -- | The Harfbuzz font used to shape text & query character-size information.
    Font' -> Font
hbFont :: Font,
    -- | The FontConfig query result. Useful to incorporate into output rendering.
    Font' -> Pattern
pattern :: Pattern,
    -- | Query the height of a character.
    -- Used for cap, ex, or ic units.
    Font' -> Char -> Double
fontHeight :: Char -> Double,
    -- | Query the width of a character, used for ch unit.
    Font' -> Char -> Double
fontAdvance :: Char -> Double,
    -- | The desired font-size, used for em unit.
    Font' -> Double
fontSize :: Double,
    -- | The root font's size, used for rem unit.
    Font' -> Double
rootEm :: Double,
    -- | The desired line-height, used for lh unit.
    Font' -> Double
lineheight :: Double,
    -- | The root font's line-height, used for rlh unit.
    Font' -> Double
rlh :: Double,
    -- | Scale-factor for vh unit.
    Font' -> Double
vh :: Double,
    -- | Scale-factor for vw unit.
    Font' -> Double
vw :: Double,
    -- | Scale-factor for vmax unit.
    Font' -> Double
vmax :: Double,
    -- | Scale-factor for vmin unit.
    Font' -> Double
vmin :: Double,
    -- | How many device pixels in a CSS px?
    Font' -> Double
scale :: Double
}

instance Eq Font' where
    Font'
a == :: Font' -> Font' -> Bool
== Font'
b = Font' -> Pattern
pattern Font'
a forall a. Eq a => a -> a -> Bool
== Font' -> Pattern
pattern Font'
b