{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
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)
import Data.Text.Glyphize (Font)
import Graphics.Text.Font.Choose (Pattern(..))
import Graphics.Layout.Box
type Unitted = (Double, Txt.Text)
instance Zero Unitted where zero :: Unitted
zero = (Double
0,Text
"px")
auto :: Unitted
auto :: Unitted
auto = (Double
0,Text
"auto")
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
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
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 %"
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
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
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
'水'
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
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
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
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
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
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'
_ [] = []
data Font' = Font' {
Font' -> Font
hbFont :: Font,
Font' -> Pattern
pattern :: Pattern,
Font' -> Char -> Double
fontHeight :: Char -> Double,
Font' -> Char -> Double
fontAdvance :: Char -> Double,
Font' -> Double
fontSize :: Double,
Font' -> Double
rootEm :: Double,
Font' -> Double
lineheight :: Double,
Font' -> Double
rlh :: Double,
Font' -> Double
vh :: Double,
Font' -> Double
vw :: Double,
Font' -> Double
vmax :: Double,
Font' -> Double
vmin :: Double,
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