{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
-- | 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)
instance Zero Unitted where zero :: Unitted
zero = (Double
0,Text
"px")
-- | 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] = Unitted -> Maybe Unitted
forall a. a -> Maybe a
Just (NumericValue -> Double
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x,Text
"%")
parseLength [Dimension Text
_ NumericValue
x Text
unit]
    | NumericValue -> Double
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 Bool -> Bool -> Bool
&& Text
unit Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" = Unitted -> Maybe Unitted
forall a. a -> Maybe a
Just (Double
0,Text
"px")
    | Text
unit Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
units = Unitted -> Maybe Unitted
forall a. a -> Maybe a
Just (NumericValue -> Double
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x,Text
unit)
parseLength [Number Text
_ NumericValue
x] | NumericValue -> Double
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = Unitted -> Maybe Unitted
forall a. a -> Maybe a
Just (Double
0,Text
"px")
parseLength [Ident Text
"auto"] = Unitted -> Maybe Unitted
forall a. a -> Maybe a
Just (Double
0,Text
"auto")
parseLength [Ident Text
"initial"] = Unitted -> Maybe Unitted
forall a. a -> Maybe a
Just (Double
0,Text
"auto")
parseLength [Token]
_ = Maybe Unitted
forall a. Maybe a
Nothing
-- | Variant of `parseLength` which supports min-content & max-content keywords.
parseLength' :: [Token] -> Maybe Unitted
parseLength' [Ident Text
"min-content"] = Unitted -> Maybe Unitted
forall a. a -> Maybe a
Just (Double
0,Text
"min-content")
parseLength' [Ident Text
"max-content"] = Unitted -> Maybe Unitted
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) = Integer -> x
forall a b. (Real a, Fractional b) => a -> b
realToFrac Integer
x
n2f (NVNumber Scientific
x) = 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 (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Char -> Double
fontHeight Font'
f Char
'A'
finalizeLength (Double
x,Text
"ch") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Char -> Double
fontAdvance Font'
f Char
'0'
finalizeLength (Double
x,Text
"em") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
fontSize Font'
f
finalizeLength (Double
x,Text
"") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
fontSize Font'
f -- For line-height.
finalizeLength (Double
x,Text
"ex") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Char -> Double
fontHeight Font'
f Char
'x'
finalizeLength (Double
x,Text
"ic") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall 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 (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
lineheight Font'
f
finalizeLength (Double
x,Text
"rem") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
rootEm Font'
f
finalizeLength (Double
x,Text
"rlh") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
rlh Font'
f
finalizeLength (Double
x,Text
"vh") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
vh Font'
f
finalizeLength (Double
x,Text
"vb") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall 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 (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
vw Font'
f
finalizeLength (Double
x,Text
"vi") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
vw Font'
f -- TODO: Support vertical text
finalizeLength (Double
x,Text
"vmax") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
vmax Font'
f
finalizeLength (Double
x,Text
"vmin") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
vmin Font'
f
finalizeLength (Double
x,Text
"px") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
scale Font'
f
finalizeLength (Double
x,Text
"cm") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
scale Font'
fDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
96Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2.54
finalizeLength (Double
x,Text
"in") Font'
f = Double -> Length
Pixels (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
96Double -> Double -> Double
forall 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 (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
x'Double -> Double -> Double
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 (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
x'Double -> Double -> Double
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 (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
x'Double -> Double -> Double
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 (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
x'Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
72
finalizeLength (Double
x,Text
"%") Font'
_ = Double -> Length
Percent (Double -> Length) -> Double -> Length
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall 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'
_ = [Char] -> Length -> Length
forall a. [Char] -> a -> a
trace ([Char]
"Invalid unit " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Txt.unpack Text
unit) (Length -> Length) -> Length -> Length
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 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Font' -> Double
scale Font'
f Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
96 Double -> Double -> Double
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 Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
units, Pixels Double
y <- Unitted -> Font' -> Length
finalizeLength (NumericValue -> Double
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x,Text
unit) Font'
f =
        Text -> NumericValue -> Text -> Token
Dimension Text
"" (Scientific -> NumericValue
NVNumber (Scientific -> NumericValue) -> Scientific -> NumericValue
forall a b. (a -> b) -> a -> b
$ Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits Double
y) Text
"px"Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:Font' -> [Token] -> [Token]
finalizeLengths Font'
f [Token]
toks
finalizeLengths Font'
f (Number Text
a NumericValue
b:[Token]
ts)|NumericValue -> Double
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
bDouble -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
0=Text -> NumericValue -> Text -> Token
Dimension Text
a NumericValue
b Text
"px"Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:Font' -> [Token] -> [Token]
finalizeLengths Font'
f [Token]
ts
finalizeLengths Font'
f (Token
tok:[Token]
toks) = Token
tokToken -> [Token] -> [Token]
forall 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 Pattern -> Pattern -> Bool
forall a. Eq a => a -> a -> Bool
== Font' -> Pattern
pattern Font'
b
instance Show Font' where
    show :: Font' -> [Char]
show Font'
a = Pattern -> [Char]
forall a. Show a => a -> [Char]
show (Pattern -> [Char]) -> Pattern -> [Char]
forall a b. (a -> b) -> a -> b
$ Font' -> Pattern
pattern Font'
a