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

import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import qualified Data.Text as Txt
import Data.Scientific (toRealFloat)
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 = (0,"auto")

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

-- | Supported length units.
units :: [Unit]
units = Unit -> [Unit]
Txt.words "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 :: NumericValue -> x
n2f (NVInteger x :: Integer
x) = Integer -> x
forall a b. (Real a, Fractional b) => a -> b
realToFrac Integer
x
n2f (NVNumber x :: 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 (x :: Double
x,"cap") f :: 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 'A'
finalizeLength (x :: Double
x,"ch") f :: 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 '0'
finalizeLength (x :: Double
x,"em") f :: 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 (x :: Double
x,"") f :: 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 (x :: Double
x,"ex") f :: 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 'x'
finalizeLength (x :: Double
x,"ic") f :: 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 '水' -- CJK water ideograph
finalizeLength (x :: Double
x,"lh") f :: 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 (x :: Double
x,"rem") f :: 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 (x :: Double
x,"rlh") f :: 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 (x :: Double
x,"vh") f :: 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 (x :: Double
x,"vb") f :: 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 (x :: Double
x,"vw") f :: 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 (x :: Double
x,"vi") f :: 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 (x :: Double
x,"vmax") f :: Font'
f = Double -> Length
Percent (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 (x :: Double
x,"vmin") f :: Font'
f = Double -> Length
Percent (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 (x :: Double
x,"px") f :: 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 (x :: Double
x,"cm") f :: 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
*96Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2.54
finalizeLength (x :: Double
x,"in") f :: 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
*96Double -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
scale Font'
f
finalizeLength (x :: Double
x,"mm") f :: Font'
f | Pixels x' :: Double
x' <- Unitted -> Font' -> Length
finalizeLength (Double
x,"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
/10
finalizeLength (x :: Double
x,"Q") f :: Font'
f | Pixels x' :: Double
x' <- Unitted -> Font' -> Length
finalizeLength (Double
x,"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
/40
finalizeLength (x :: Double
x,"pc") f :: Font'
f | Pixels x' :: Double
x' <- Unitted -> Font' -> Length
finalizeLength (Double
x,"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
/6
finalizeLength (x :: Double
x,"pt") f :: Font'
f | Pixels x' :: Double
x' <- Unitted -> Font' -> Length
finalizeLength (Double
x,"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
/72
finalizeLength (x :: Double
x,"%") _ = 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
/100
finalizeLength (_,"auto") _ = Length
Auto
finalizeLength (_,"min-content") _ = Length
Min
finalizeLength (_,"max-content") _ = Length
Preferred
finalizeLength (x :: Double
x, " ") _ = Double -> Length
Pixels Double
x -- Internal constant value...
finalizeLength (_,unit :: Unit
unit) _ = String -> Length -> Length
forall a. String -> a -> a
trace ("Invalid unit " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Unit -> String
Txt.unpack Unit
unit) (Length -> Length) -> Length -> Length
forall a b. (a -> b) -> a -> b
$ Double -> Length
Pixels 0
-- | Convert from a computed length to the "pt" unit.
px2pt :: Font' -> Double -> Double
px2pt f :: Font'
f x :: 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
/ 96 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 72

-- | 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
    a :: Font'
a == :: Font' -> Font' -> Bool
== b :: Font'
b = Font' -> Pattern
pattern Font'
a Pattern -> Pattern -> Bool
forall a. Eq a => a -> a -> Bool
== Font' -> Pattern
pattern Font'
b