module Graphics.MSDF.Atlas.Layout where

import Data.Aeson
import Data.Char (ord)
import Data.IntMap (IntMap)
import Data.IntMap qualified as IntMap
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import GHC.Generics (Generic)

data Layout = Layout
  { Layout -> Atlas
atlas :: Atlas
  , Layout -> Metrics
metrics :: Metrics
  , Layout -> Vector Glyph
glyphs :: Vector Glyph
  , Layout -> Vector Kerning
kerning :: Vector Kerning
  }
  deriving (Layout -> Layout -> Bool
(Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool) -> Eq Layout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Layout -> Layout -> Bool
== :: Layout -> Layout -> Bool
$c/= :: Layout -> Layout -> Bool
/= :: Layout -> Layout -> Bool
Eq, Eq Layout
Eq Layout =>
(Layout -> Layout -> Ordering)
-> (Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool)
-> (Layout -> Layout -> Layout)
-> (Layout -> Layout -> Layout)
-> Ord Layout
Layout -> Layout -> Bool
Layout -> Layout -> Ordering
Layout -> Layout -> Layout
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Layout -> Layout -> Ordering
compare :: Layout -> Layout -> Ordering
$c< :: Layout -> Layout -> Bool
< :: Layout -> Layout -> Bool
$c<= :: Layout -> Layout -> Bool
<= :: Layout -> Layout -> Bool
$c> :: Layout -> Layout -> Bool
> :: Layout -> Layout -> Bool
$c>= :: Layout -> Layout -> Bool
>= :: Layout -> Layout -> Bool
$cmax :: Layout -> Layout -> Layout
max :: Layout -> Layout -> Layout
$cmin :: Layout -> Layout -> Layout
min :: Layout -> Layout -> Layout
Ord, Int -> Layout -> ShowS
[Layout] -> ShowS
Layout -> String
(Int -> Layout -> ShowS)
-> (Layout -> String) -> ([Layout] -> ShowS) -> Show Layout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Layout -> ShowS
showsPrec :: Int -> Layout -> ShowS
$cshow :: Layout -> String
show :: Layout -> String
$cshowList :: [Layout] -> ShowS
showList :: [Layout] -> ShowS
Show, (forall x. Layout -> Rep Layout x)
-> (forall x. Rep Layout x -> Layout) -> Generic Layout
forall x. Rep Layout x -> Layout
forall x. Layout -> Rep Layout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Layout -> Rep Layout x
from :: forall x. Layout -> Rep Layout x
$cto :: forall x. Rep Layout x -> Layout
to :: forall x. Rep Layout x -> Layout
Generic)

instance FromJSON Layout
instance ToJSON Layout

data Atlas = Atlas
  { Atlas -> AtlasType
aType :: AtlasType
  , Atlas -> Maybe Float
distanceRange :: Maybe Float
  , Atlas -> Maybe Float
distanceRangeMiddle :: Maybe Float
  , Atlas -> Float
size :: Float -- ^ The `size` field represents the font size in pixels per em.
  , Atlas -> Int
width :: Int -- ^ Atlas image width in pixels
  , Atlas -> Int
height :: Int -- ^ Atlas image height in pixels
  , Atlas -> YOrigin
yOrigin :: YOrigin
  }
  deriving (Atlas -> Atlas -> Bool
(Atlas -> Atlas -> Bool) -> (Atlas -> Atlas -> Bool) -> Eq Atlas
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Atlas -> Atlas -> Bool
== :: Atlas -> Atlas -> Bool
$c/= :: Atlas -> Atlas -> Bool
/= :: Atlas -> Atlas -> Bool
Eq, Eq Atlas
Eq Atlas =>
(Atlas -> Atlas -> Ordering)
-> (Atlas -> Atlas -> Bool)
-> (Atlas -> Atlas -> Bool)
-> (Atlas -> Atlas -> Bool)
-> (Atlas -> Atlas -> Bool)
-> (Atlas -> Atlas -> Atlas)
-> (Atlas -> Atlas -> Atlas)
-> Ord Atlas
Atlas -> Atlas -> Bool
Atlas -> Atlas -> Ordering
Atlas -> Atlas -> Atlas
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Atlas -> Atlas -> Ordering
compare :: Atlas -> Atlas -> Ordering
$c< :: Atlas -> Atlas -> Bool
< :: Atlas -> Atlas -> Bool
$c<= :: Atlas -> Atlas -> Bool
<= :: Atlas -> Atlas -> Bool
$c> :: Atlas -> Atlas -> Bool
> :: Atlas -> Atlas -> Bool
$c>= :: Atlas -> Atlas -> Bool
>= :: Atlas -> Atlas -> Bool
$cmax :: Atlas -> Atlas -> Atlas
max :: Atlas -> Atlas -> Atlas
$cmin :: Atlas -> Atlas -> Atlas
min :: Atlas -> Atlas -> Atlas
Ord, Int -> Atlas -> ShowS
[Atlas] -> ShowS
Atlas -> String
(Int -> Atlas -> ShowS)
-> (Atlas -> String) -> ([Atlas] -> ShowS) -> Show Atlas
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Atlas -> ShowS
showsPrec :: Int -> Atlas -> ShowS
$cshow :: Atlas -> String
show :: Atlas -> String
$cshowList :: [Atlas] -> ShowS
showList :: [Atlas] -> ShowS
Show, (forall x. Atlas -> Rep Atlas x)
-> (forall x. Rep Atlas x -> Atlas) -> Generic Atlas
forall x. Rep Atlas x -> Atlas
forall x. Atlas -> Rep Atlas x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Atlas -> Rep Atlas x
from :: forall x. Atlas -> Rep Atlas x
$cto :: forall x. Rep Atlas x -> Atlas
to :: forall x. Rep Atlas x -> Atlas
Generic)

instance FromJSON Atlas where
  parseJSON :: Value -> Parser Atlas
parseJSON = String -> (Object -> Parser Atlas) -> Value -> Parser Atlas
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Atlas" \Object
o -> do
    AtlasType
aType <- Object
o Object -> Key -> Parser AtlasType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    Maybe Float
distanceRange <- Object
o Object -> Key -> Parser (Maybe Float)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"distanceRange"
    Maybe Float
distanceRangeMiddle <- Object
o Object -> Key -> Parser (Maybe Float)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"distanceRangeMiddle"
    Float
size <- Object
o Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
    Int
width <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"width"
    Int
height <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"
    YOrigin
yOrigin <- Object
o Object -> Key -> Parser YOrigin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"yOrigin"
    Atlas -> Parser Atlas
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Atlas{Float
Int
Maybe Float
YOrigin
AtlasType
aType :: AtlasType
distanceRange :: Maybe Float
distanceRangeMiddle :: Maybe Float
size :: Float
width :: Int
height :: Int
yOrigin :: YOrigin
aType :: AtlasType
distanceRange :: Maybe Float
distanceRangeMiddle :: Maybe Float
size :: Float
width :: Int
height :: Int
yOrigin :: YOrigin
..}

instance ToJSON Atlas where
  toJSON :: Atlas -> Value
toJSON Atlas{Float
Int
Maybe Float
YOrigin
AtlasType
aType :: Atlas -> AtlasType
distanceRange :: Atlas -> Maybe Float
distanceRangeMiddle :: Atlas -> Maybe Float
size :: Atlas -> Float
width :: Atlas -> Int
height :: Atlas -> Int
yOrigin :: Atlas -> YOrigin
aType :: AtlasType
distanceRange :: Maybe Float
distanceRangeMiddle :: Maybe Float
size :: Float
width :: Int
height :: Int
yOrigin :: YOrigin
..} = [Pair] -> Value
object
    [ Key
"type" Key -> AtlasType -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= AtlasType
aType
    , Key
"distanceRange" Key -> Maybe Float -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Float
distanceRange
    , Key
"distanceRangeMiddle" Key -> Maybe Float -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Float
distanceRangeMiddle
    , Key
"size" Key -> Float -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Float
size
    , Key
"width" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
width
    , Key
"height" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
height
    , Key
"yOrigin" Key -> YOrigin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= YOrigin
yOrigin
    ]

data AtlasType
  = Hardmask -- ^ non-anti-aliased binary image
  | Softmask -- ^ anti-aliased image
  | SDF -- ^ true signed distance field (SDF)
  | PSDF -- ^ signed perpendicular distance field (PSDF)
  | MSDF -- ^ multi-channel signed distance field (MSDF)
  | MTSDF -- ^ combination of MSDF and true SDF in the alpha channel
  deriving (AtlasType -> AtlasType -> Bool
(AtlasType -> AtlasType -> Bool)
-> (AtlasType -> AtlasType -> Bool) -> Eq AtlasType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AtlasType -> AtlasType -> Bool
== :: AtlasType -> AtlasType -> Bool
$c/= :: AtlasType -> AtlasType -> Bool
/= :: AtlasType -> AtlasType -> Bool
Eq, Eq AtlasType
Eq AtlasType =>
(AtlasType -> AtlasType -> Ordering)
-> (AtlasType -> AtlasType -> Bool)
-> (AtlasType -> AtlasType -> Bool)
-> (AtlasType -> AtlasType -> Bool)
-> (AtlasType -> AtlasType -> Bool)
-> (AtlasType -> AtlasType -> AtlasType)
-> (AtlasType -> AtlasType -> AtlasType)
-> Ord AtlasType
AtlasType -> AtlasType -> Bool
AtlasType -> AtlasType -> Ordering
AtlasType -> AtlasType -> AtlasType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AtlasType -> AtlasType -> Ordering
compare :: AtlasType -> AtlasType -> Ordering
$c< :: AtlasType -> AtlasType -> Bool
< :: AtlasType -> AtlasType -> Bool
$c<= :: AtlasType -> AtlasType -> Bool
<= :: AtlasType -> AtlasType -> Bool
$c> :: AtlasType -> AtlasType -> Bool
> :: AtlasType -> AtlasType -> Bool
$c>= :: AtlasType -> AtlasType -> Bool
>= :: AtlasType -> AtlasType -> Bool
$cmax :: AtlasType -> AtlasType -> AtlasType
max :: AtlasType -> AtlasType -> AtlasType
$cmin :: AtlasType -> AtlasType -> AtlasType
min :: AtlasType -> AtlasType -> AtlasType
Ord, Int -> AtlasType -> ShowS
[AtlasType] -> ShowS
AtlasType -> String
(Int -> AtlasType -> ShowS)
-> (AtlasType -> String)
-> ([AtlasType] -> ShowS)
-> Show AtlasType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AtlasType -> ShowS
showsPrec :: Int -> AtlasType -> ShowS
$cshow :: AtlasType -> String
show :: AtlasType -> String
$cshowList :: [AtlasType] -> ShowS
showList :: [AtlasType] -> ShowS
Show, Int -> AtlasType
AtlasType -> Int
AtlasType -> [AtlasType]
AtlasType -> AtlasType
AtlasType -> AtlasType -> [AtlasType]
AtlasType -> AtlasType -> AtlasType -> [AtlasType]
(AtlasType -> AtlasType)
-> (AtlasType -> AtlasType)
-> (Int -> AtlasType)
-> (AtlasType -> Int)
-> (AtlasType -> [AtlasType])
-> (AtlasType -> AtlasType -> [AtlasType])
-> (AtlasType -> AtlasType -> [AtlasType])
-> (AtlasType -> AtlasType -> AtlasType -> [AtlasType])
-> Enum AtlasType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: AtlasType -> AtlasType
succ :: AtlasType -> AtlasType
$cpred :: AtlasType -> AtlasType
pred :: AtlasType -> AtlasType
$ctoEnum :: Int -> AtlasType
toEnum :: Int -> AtlasType
$cfromEnum :: AtlasType -> Int
fromEnum :: AtlasType -> Int
$cenumFrom :: AtlasType -> [AtlasType]
enumFrom :: AtlasType -> [AtlasType]
$cenumFromThen :: AtlasType -> AtlasType -> [AtlasType]
enumFromThen :: AtlasType -> AtlasType -> [AtlasType]
$cenumFromTo :: AtlasType -> AtlasType -> [AtlasType]
enumFromTo :: AtlasType -> AtlasType -> [AtlasType]
$cenumFromThenTo :: AtlasType -> AtlasType -> AtlasType -> [AtlasType]
enumFromThenTo :: AtlasType -> AtlasType -> AtlasType -> [AtlasType]
Enum, AtlasType
AtlasType -> AtlasType -> Bounded AtlasType
forall a. a -> a -> Bounded a
$cminBound :: AtlasType
minBound :: AtlasType
$cmaxBound :: AtlasType
maxBound :: AtlasType
Bounded, (forall x. AtlasType -> Rep AtlasType x)
-> (forall x. Rep AtlasType x -> AtlasType) -> Generic AtlasType
forall x. Rep AtlasType x -> AtlasType
forall x. AtlasType -> Rep AtlasType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AtlasType -> Rep AtlasType x
from :: forall x. AtlasType -> Rep AtlasType x
$cto :: forall x. Rep AtlasType x -> AtlasType
to :: forall x. Rep AtlasType x -> AtlasType
Generic)

instance FromJSON AtlasType where
  parseJSON :: Value -> Parser AtlasType
parseJSON = String -> (Text -> Parser AtlasType) -> Value -> Parser AtlasType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"AtlasType" \case
    Text
"hardmask" -> AtlasType -> Parser AtlasType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtlasType
Hardmask
    Text
"softmask" -> AtlasType -> Parser AtlasType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtlasType
Softmask
    Text
"sdf" -> AtlasType -> Parser AtlasType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtlasType
SDF
    Text
"psdf" -> AtlasType -> Parser AtlasType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtlasType
PSDF
    Text
"msdf" -> AtlasType -> Parser AtlasType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtlasType
MSDF
    Text
"mtsdf" -> AtlasType -> Parser AtlasType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtlasType
MTSDF
    Text
huh -> String -> Parser AtlasType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser AtlasType) -> String -> Parser AtlasType
forall a b. (a -> b) -> a -> b
$ String
"Unexpected AtlasType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
huh

instance ToJSON AtlasType where
  toJSON :: AtlasType -> Value
toJSON = \case
    AtlasType
Hardmask -> Value
"hardmask"
    AtlasType
Softmask -> Value
"softmask"
    AtlasType
SDF -> Value
"sdf"
    AtlasType
PSDF -> Value
"psdf"
    AtlasType
MSDF -> Value
"msdf"
    AtlasType
MTSDF -> Value
"mtsdf"

data YOrigin
  = Top
  | Bottom
  deriving (YOrigin -> YOrigin -> Bool
(YOrigin -> YOrigin -> Bool)
-> (YOrigin -> YOrigin -> Bool) -> Eq YOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: YOrigin -> YOrigin -> Bool
== :: YOrigin -> YOrigin -> Bool
$c/= :: YOrigin -> YOrigin -> Bool
/= :: YOrigin -> YOrigin -> Bool
Eq, Eq YOrigin
Eq YOrigin =>
(YOrigin -> YOrigin -> Ordering)
-> (YOrigin -> YOrigin -> Bool)
-> (YOrigin -> YOrigin -> Bool)
-> (YOrigin -> YOrigin -> Bool)
-> (YOrigin -> YOrigin -> Bool)
-> (YOrigin -> YOrigin -> YOrigin)
-> (YOrigin -> YOrigin -> YOrigin)
-> Ord YOrigin
YOrigin -> YOrigin -> Bool
YOrigin -> YOrigin -> Ordering
YOrigin -> YOrigin -> YOrigin
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: YOrigin -> YOrigin -> Ordering
compare :: YOrigin -> YOrigin -> Ordering
$c< :: YOrigin -> YOrigin -> Bool
< :: YOrigin -> YOrigin -> Bool
$c<= :: YOrigin -> YOrigin -> Bool
<= :: YOrigin -> YOrigin -> Bool
$c> :: YOrigin -> YOrigin -> Bool
> :: YOrigin -> YOrigin -> Bool
$c>= :: YOrigin -> YOrigin -> Bool
>= :: YOrigin -> YOrigin -> Bool
$cmax :: YOrigin -> YOrigin -> YOrigin
max :: YOrigin -> YOrigin -> YOrigin
$cmin :: YOrigin -> YOrigin -> YOrigin
min :: YOrigin -> YOrigin -> YOrigin
Ord, Int -> YOrigin -> ShowS
[YOrigin] -> ShowS
YOrigin -> String
(Int -> YOrigin -> ShowS)
-> (YOrigin -> String) -> ([YOrigin] -> ShowS) -> Show YOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YOrigin -> ShowS
showsPrec :: Int -> YOrigin -> ShowS
$cshow :: YOrigin -> String
show :: YOrigin -> String
$cshowList :: [YOrigin] -> ShowS
showList :: [YOrigin] -> ShowS
Show, Int -> YOrigin
YOrigin -> Int
YOrigin -> [YOrigin]
YOrigin -> YOrigin
YOrigin -> YOrigin -> [YOrigin]
YOrigin -> YOrigin -> YOrigin -> [YOrigin]
(YOrigin -> YOrigin)
-> (YOrigin -> YOrigin)
-> (Int -> YOrigin)
-> (YOrigin -> Int)
-> (YOrigin -> [YOrigin])
-> (YOrigin -> YOrigin -> [YOrigin])
-> (YOrigin -> YOrigin -> [YOrigin])
-> (YOrigin -> YOrigin -> YOrigin -> [YOrigin])
-> Enum YOrigin
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: YOrigin -> YOrigin
succ :: YOrigin -> YOrigin
$cpred :: YOrigin -> YOrigin
pred :: YOrigin -> YOrigin
$ctoEnum :: Int -> YOrigin
toEnum :: Int -> YOrigin
$cfromEnum :: YOrigin -> Int
fromEnum :: YOrigin -> Int
$cenumFrom :: YOrigin -> [YOrigin]
enumFrom :: YOrigin -> [YOrigin]
$cenumFromThen :: YOrigin -> YOrigin -> [YOrigin]
enumFromThen :: YOrigin -> YOrigin -> [YOrigin]
$cenumFromTo :: YOrigin -> YOrigin -> [YOrigin]
enumFromTo :: YOrigin -> YOrigin -> [YOrigin]
$cenumFromThenTo :: YOrigin -> YOrigin -> YOrigin -> [YOrigin]
enumFromThenTo :: YOrigin -> YOrigin -> YOrigin -> [YOrigin]
Enum, YOrigin
YOrigin -> YOrigin -> Bounded YOrigin
forall a. a -> a -> Bounded a
$cminBound :: YOrigin
minBound :: YOrigin
$cmaxBound :: YOrigin
maxBound :: YOrigin
Bounded, (forall x. YOrigin -> Rep YOrigin x)
-> (forall x. Rep YOrigin x -> YOrigin) -> Generic YOrigin
forall x. Rep YOrigin x -> YOrigin
forall x. YOrigin -> Rep YOrigin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. YOrigin -> Rep YOrigin x
from :: forall x. YOrigin -> Rep YOrigin x
$cto :: forall x. Rep YOrigin x -> YOrigin
to :: forall x. Rep YOrigin x -> YOrigin
Generic)

instance FromJSON YOrigin where
  parseJSON :: Value -> Parser YOrigin
parseJSON = String -> (Text -> Parser YOrigin) -> Value -> Parser YOrigin
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"yOrigin" \case
    Text
"top" -> YOrigin -> Parser YOrigin
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure YOrigin
Top
    Text
"bottom" -> YOrigin -> Parser YOrigin
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure YOrigin
Bottom
    Text
huh -> String -> Parser YOrigin
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser YOrigin) -> String -> Parser YOrigin
forall a b. (a -> b) -> a -> b
$ String
"Unexpected yOrigin: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
huh

instance ToJSON YOrigin where
  toJSON :: YOrigin -> Value
toJSON = \case
    YOrigin
Top -> Text -> Value
String Text
"top"
    YOrigin
Bottom -> Text -> Value
String Text
"bottom"

    -- - If there are multiple input fonts (`-and` parameter), the remaining data are grouped into `variants`, each representing an input font.
    --

-- | Useful font metric values retrieved from the font. All values are in em's.
data Metrics = Metrics
  { Metrics -> Float
emSize :: Float
  , Metrics -> Float
lineHeight :: Float
  , Metrics -> Float
ascender :: Float
  , Metrics -> Float
descender :: Float
  , Metrics -> Float
underlineY :: Float
  , Metrics -> Float
underlineThickness :: Float
  }
  deriving (Metrics -> Metrics -> Bool
(Metrics -> Metrics -> Bool)
-> (Metrics -> Metrics -> Bool) -> Eq Metrics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Metrics -> Metrics -> Bool
== :: Metrics -> Metrics -> Bool
$c/= :: Metrics -> Metrics -> Bool
/= :: Metrics -> Metrics -> Bool
Eq, Eq Metrics
Eq Metrics =>
(Metrics -> Metrics -> Ordering)
-> (Metrics -> Metrics -> Bool)
-> (Metrics -> Metrics -> Bool)
-> (Metrics -> Metrics -> Bool)
-> (Metrics -> Metrics -> Bool)
-> (Metrics -> Metrics -> Metrics)
-> (Metrics -> Metrics -> Metrics)
-> Ord Metrics
Metrics -> Metrics -> Bool
Metrics -> Metrics -> Ordering
Metrics -> Metrics -> Metrics
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Metrics -> Metrics -> Ordering
compare :: Metrics -> Metrics -> Ordering
$c< :: Metrics -> Metrics -> Bool
< :: Metrics -> Metrics -> Bool
$c<= :: Metrics -> Metrics -> Bool
<= :: Metrics -> Metrics -> Bool
$c> :: Metrics -> Metrics -> Bool
> :: Metrics -> Metrics -> Bool
$c>= :: Metrics -> Metrics -> Bool
>= :: Metrics -> Metrics -> Bool
$cmax :: Metrics -> Metrics -> Metrics
max :: Metrics -> Metrics -> Metrics
$cmin :: Metrics -> Metrics -> Metrics
min :: Metrics -> Metrics -> Metrics
Ord, Int -> Metrics -> ShowS
[Metrics] -> ShowS
Metrics -> String
(Int -> Metrics -> ShowS)
-> (Metrics -> String) -> ([Metrics] -> ShowS) -> Show Metrics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Metrics -> ShowS
showsPrec :: Int -> Metrics -> ShowS
$cshow :: Metrics -> String
show :: Metrics -> String
$cshowList :: [Metrics] -> ShowS
showList :: [Metrics] -> ShowS
Show, (forall x. Metrics -> Rep Metrics x)
-> (forall x. Rep Metrics x -> Metrics) -> Generic Metrics
forall x. Rep Metrics x -> Metrics
forall x. Metrics -> Rep Metrics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Metrics -> Rep Metrics x
from :: forall x. Metrics -> Rep Metrics x
$cto :: forall x. Rep Metrics x -> Metrics
to :: forall x. Rep Metrics x -> Metrics
Generic)

instance FromJSON Metrics
instance ToJSON Metrics

data Glyph = Glyph
  { Glyph -> Maybe Int
index :: Maybe Int
  , Glyph -> Maybe Int
unicode :: Maybe Int
  , Glyph -> Float
advance :: Float
  , Glyph -> Maybe Bounds
planeBounds :: Maybe Bounds
  , Glyph -> Maybe Bounds
atlasBounds :: Maybe Bounds
  }
  deriving (Glyph -> Glyph -> Bool
(Glyph -> Glyph -> Bool) -> (Glyph -> Glyph -> Bool) -> Eq Glyph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Glyph -> Glyph -> Bool
== :: Glyph -> Glyph -> Bool
$c/= :: Glyph -> Glyph -> Bool
/= :: Glyph -> Glyph -> Bool
Eq, Eq Glyph
Eq Glyph =>
(Glyph -> Glyph -> Ordering)
-> (Glyph -> Glyph -> Bool)
-> (Glyph -> Glyph -> Bool)
-> (Glyph -> Glyph -> Bool)
-> (Glyph -> Glyph -> Bool)
-> (Glyph -> Glyph -> Glyph)
-> (Glyph -> Glyph -> Glyph)
-> Ord Glyph
Glyph -> Glyph -> Bool
Glyph -> Glyph -> Ordering
Glyph -> Glyph -> Glyph
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Glyph -> Glyph -> Ordering
compare :: Glyph -> Glyph -> Ordering
$c< :: Glyph -> Glyph -> Bool
< :: Glyph -> Glyph -> Bool
$c<= :: Glyph -> Glyph -> Bool
<= :: Glyph -> Glyph -> Bool
$c> :: Glyph -> Glyph -> Bool
> :: Glyph -> Glyph -> Bool
$c>= :: Glyph -> Glyph -> Bool
>= :: Glyph -> Glyph -> Bool
$cmax :: Glyph -> Glyph -> Glyph
max :: Glyph -> Glyph -> Glyph
$cmin :: Glyph -> Glyph -> Glyph
min :: Glyph -> Glyph -> Glyph
Ord, Int -> Glyph -> ShowS
[Glyph] -> ShowS
Glyph -> String
(Int -> Glyph -> ShowS)
-> (Glyph -> String) -> ([Glyph] -> ShowS) -> Show Glyph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Glyph -> ShowS
showsPrec :: Int -> Glyph -> ShowS
$cshow :: Glyph -> String
show :: Glyph -> String
$cshowList :: [Glyph] -> ShowS
showList :: [Glyph] -> ShowS
Show, (forall x. Glyph -> Rep Glyph x)
-> (forall x. Rep Glyph x -> Glyph) -> Generic Glyph
forall x. Rep Glyph x -> Glyph
forall x. Glyph -> Rep Glyph x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Glyph -> Rep Glyph x
from :: forall x. Glyph -> Rep Glyph x
$cto :: forall x. Rep Glyph x -> Glyph
to :: forall x. Rep Glyph x -> Glyph
Generic)

instance FromJSON Glyph
instance ToJSON Glyph

newtype ByCodepoint = ByCodepoint (IntMap Glyph)
  deriving (ByCodepoint -> ByCodepoint -> Bool
(ByCodepoint -> ByCodepoint -> Bool)
-> (ByCodepoint -> ByCodepoint -> Bool) -> Eq ByCodepoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByCodepoint -> ByCodepoint -> Bool
== :: ByCodepoint -> ByCodepoint -> Bool
$c/= :: ByCodepoint -> ByCodepoint -> Bool
/= :: ByCodepoint -> ByCodepoint -> Bool
Eq, Eq ByCodepoint
Eq ByCodepoint =>
(ByCodepoint -> ByCodepoint -> Ordering)
-> (ByCodepoint -> ByCodepoint -> Bool)
-> (ByCodepoint -> ByCodepoint -> Bool)
-> (ByCodepoint -> ByCodepoint -> Bool)
-> (ByCodepoint -> ByCodepoint -> Bool)
-> (ByCodepoint -> ByCodepoint -> ByCodepoint)
-> (ByCodepoint -> ByCodepoint -> ByCodepoint)
-> Ord ByCodepoint
ByCodepoint -> ByCodepoint -> Bool
ByCodepoint -> ByCodepoint -> Ordering
ByCodepoint -> ByCodepoint -> ByCodepoint
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ByCodepoint -> ByCodepoint -> Ordering
compare :: ByCodepoint -> ByCodepoint -> Ordering
$c< :: ByCodepoint -> ByCodepoint -> Bool
< :: ByCodepoint -> ByCodepoint -> Bool
$c<= :: ByCodepoint -> ByCodepoint -> Bool
<= :: ByCodepoint -> ByCodepoint -> Bool
$c> :: ByCodepoint -> ByCodepoint -> Bool
> :: ByCodepoint -> ByCodepoint -> Bool
$c>= :: ByCodepoint -> ByCodepoint -> Bool
>= :: ByCodepoint -> ByCodepoint -> Bool
$cmax :: ByCodepoint -> ByCodepoint -> ByCodepoint
max :: ByCodepoint -> ByCodepoint -> ByCodepoint
$cmin :: ByCodepoint -> ByCodepoint -> ByCodepoint
min :: ByCodepoint -> ByCodepoint -> ByCodepoint
Ord, Int -> ByCodepoint -> ShowS
[ByCodepoint] -> ShowS
ByCodepoint -> String
(Int -> ByCodepoint -> ShowS)
-> (ByCodepoint -> String)
-> ([ByCodepoint] -> ShowS)
-> Show ByCodepoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByCodepoint -> ShowS
showsPrec :: Int -> ByCodepoint -> ShowS
$cshow :: ByCodepoint -> String
show :: ByCodepoint -> String
$cshowList :: [ByCodepoint] -> ShowS
showList :: [ByCodepoint] -> ShowS
Show, (forall x. ByCodepoint -> Rep ByCodepoint x)
-> (forall x. Rep ByCodepoint x -> ByCodepoint)
-> Generic ByCodepoint
forall x. Rep ByCodepoint x -> ByCodepoint
forall x. ByCodepoint -> Rep ByCodepoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ByCodepoint -> Rep ByCodepoint x
from :: forall x. ByCodepoint -> Rep ByCodepoint x
$cto :: forall x. Rep ByCodepoint x -> ByCodepoint
to :: forall x. Rep ByCodepoint x -> ByCodepoint
Generic)

instance FromJSON ByCodepoint
instance ToJSON ByCodepoint

byCodepoint :: Foldable t => t Glyph -> ByCodepoint
byCodepoint :: forall (t :: * -> *). Foldable t => t Glyph -> ByCodepoint
byCodepoint = IntMap Glyph -> ByCodepoint
ByCodepoint (IntMap Glyph -> ByCodepoint)
-> (t Glyph -> IntMap Glyph) -> t Glyph -> ByCodepoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Glyph -> IntMap Glyph -> IntMap Glyph)
-> IntMap Glyph -> t Glyph -> IntMap Glyph
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\g :: Glyph
g@Glyph{Maybe Int
unicode :: Glyph -> Maybe Int
unicode :: Maybe Int
unicode} IntMap Glyph
rest -> IntMap Glyph -> (Int -> IntMap Glyph) -> Maybe Int -> IntMap Glyph
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntMap Glyph
rest (\Int
i -> Int -> Glyph -> IntMap Glyph -> IntMap Glyph
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
i Glyph
g IntMap Glyph
rest) Maybe Int
unicode) IntMap Glyph
forall a. Monoid a => a
mempty

lookupCodepoint :: Char -> ByCodepoint -> Maybe Glyph
lookupCodepoint :: Char -> ByCodepoint -> Maybe Glyph
lookupCodepoint Char
c (ByCodepoint IntMap Glyph
gs) = Int -> IntMap Glyph -> Maybe Glyph
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Char -> Int
ord Char
c) IntMap Glyph
gs

newtype ByIndex = ByIndex (Vector Glyph)
  deriving (ByIndex -> ByIndex -> Bool
(ByIndex -> ByIndex -> Bool)
-> (ByIndex -> ByIndex -> Bool) -> Eq ByIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByIndex -> ByIndex -> Bool
== :: ByIndex -> ByIndex -> Bool
$c/= :: ByIndex -> ByIndex -> Bool
/= :: ByIndex -> ByIndex -> Bool
Eq, Eq ByIndex
Eq ByIndex =>
(ByIndex -> ByIndex -> Ordering)
-> (ByIndex -> ByIndex -> Bool)
-> (ByIndex -> ByIndex -> Bool)
-> (ByIndex -> ByIndex -> Bool)
-> (ByIndex -> ByIndex -> Bool)
-> (ByIndex -> ByIndex -> ByIndex)
-> (ByIndex -> ByIndex -> ByIndex)
-> Ord ByIndex
ByIndex -> ByIndex -> Bool
ByIndex -> ByIndex -> Ordering
ByIndex -> ByIndex -> ByIndex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ByIndex -> ByIndex -> Ordering
compare :: ByIndex -> ByIndex -> Ordering
$c< :: ByIndex -> ByIndex -> Bool
< :: ByIndex -> ByIndex -> Bool
$c<= :: ByIndex -> ByIndex -> Bool
<= :: ByIndex -> ByIndex -> Bool
$c> :: ByIndex -> ByIndex -> Bool
> :: ByIndex -> ByIndex -> Bool
$c>= :: ByIndex -> ByIndex -> Bool
>= :: ByIndex -> ByIndex -> Bool
$cmax :: ByIndex -> ByIndex -> ByIndex
max :: ByIndex -> ByIndex -> ByIndex
$cmin :: ByIndex -> ByIndex -> ByIndex
min :: ByIndex -> ByIndex -> ByIndex
Ord, Int -> ByIndex -> ShowS
[ByIndex] -> ShowS
ByIndex -> String
(Int -> ByIndex -> ShowS)
-> (ByIndex -> String) -> ([ByIndex] -> ShowS) -> Show ByIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByIndex -> ShowS
showsPrec :: Int -> ByIndex -> ShowS
$cshow :: ByIndex -> String
show :: ByIndex -> String
$cshowList :: [ByIndex] -> ShowS
showList :: [ByIndex] -> ShowS
Show, (forall x. ByIndex -> Rep ByIndex x)
-> (forall x. Rep ByIndex x -> ByIndex) -> Generic ByIndex
forall x. Rep ByIndex x -> ByIndex
forall x. ByIndex -> Rep ByIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ByIndex -> Rep ByIndex x
from :: forall x. ByIndex -> Rep ByIndex x
$cto :: forall x. Rep ByIndex x -> ByIndex
to :: forall x. Rep ByIndex x -> ByIndex
Generic)

lookupGlyph :: Int -> ByIndex -> Maybe Glyph
lookupGlyph :: Int -> ByIndex -> Maybe Glyph
lookupGlyph Int
ix (ByIndex Vector Glyph
gs) = Vector Glyph -> Int -> Maybe Glyph
forall (m :: * -> *) a. Monad m => Vector a -> Int -> m a
Vector.indexM Vector Glyph
gs Int
ix

byIndex :: Foldable t => t Glyph -> Either String ByIndex
byIndex :: forall (t :: * -> *).
Foldable t =>
t Glyph -> Either String ByIndex
byIndex = IntMap Glyph -> Either String ByIndex
forall {a}. IsString a => IntMap Glyph -> Either a ByIndex
extract (IntMap Glyph -> Either String ByIndex)
-> (t Glyph -> IntMap Glyph) -> t Glyph -> Either String ByIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Glyph -> IntMap Glyph -> IntMap Glyph)
-> IntMap Glyph -> t Glyph -> IntMap Glyph
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Glyph -> IntMap Glyph -> IntMap Glyph
collect IntMap Glyph
forall a. Monoid a => a
mempty
  where
    collect :: Glyph -> IntMap Glyph -> IntMap Glyph
collect g :: Glyph
g@Glyph{Maybe Int
index :: Glyph -> Maybe Int
index :: Maybe Int
index} IntMap Glyph
next = IntMap Glyph -> (Int -> IntMap Glyph) -> Maybe Int -> IntMap Glyph
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntMap Glyph
next (\Int
i -> Int -> Glyph -> IntMap Glyph -> IntMap Glyph
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
i Glyph
g IntMap Glyph
next) Maybe Int
index
    extract :: IntMap Glyph -> Either a ByIndex
extract IntMap Glyph
m =
      if IntMap Glyph -> [Int]
forall a. IntMap a -> [Int]
IntMap.keys IntMap Glyph
m [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int
0 .. IntMap Glyph -> Int
forall a. IntMap a -> Int
IntMap.size IntMap Glyph
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] then
        ByIndex -> Either a ByIndex
forall a b. b -> Either a b
Right (ByIndex -> Either a ByIndex)
-> (Vector Glyph -> ByIndex) -> Vector Glyph -> Either a ByIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Glyph -> ByIndex
ByIndex (Vector Glyph -> Either a ByIndex)
-> Vector Glyph -> Either a ByIndex
forall a b. (a -> b) -> a -> b
$ [Glyph] -> Vector Glyph
forall a. [a] -> Vector a
Vector.fromList (IntMap Glyph -> [Glyph]
forall a. IntMap a -> [a]
IntMap.elems IntMap Glyph
m)
      else
        a -> Either a ByIndex
forall a b. a -> Either a b
Left a
"Glyph indices aren't contiguous"

data Bounds = Bounds
  { Bounds -> Float
left, Bounds -> Float
top, Bounds -> Float
right, Bounds -> Float
bottom :: Float
  }
  deriving (Bounds -> Bounds -> Bool
(Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool) -> Eq Bounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bounds -> Bounds -> Bool
== :: Bounds -> Bounds -> Bool
$c/= :: Bounds -> Bounds -> Bool
/= :: Bounds -> Bounds -> Bool
Eq, Eq Bounds
Eq Bounds =>
(Bounds -> Bounds -> Ordering)
-> (Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bounds)
-> (Bounds -> Bounds -> Bounds)
-> Ord Bounds
Bounds -> Bounds -> Bool
Bounds -> Bounds -> Ordering
Bounds -> Bounds -> Bounds
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Bounds -> Bounds -> Ordering
compare :: Bounds -> Bounds -> Ordering
$c< :: Bounds -> Bounds -> Bool
< :: Bounds -> Bounds -> Bool
$c<= :: Bounds -> Bounds -> Bool
<= :: Bounds -> Bounds -> Bool
$c> :: Bounds -> Bounds -> Bool
> :: Bounds -> Bounds -> Bool
$c>= :: Bounds -> Bounds -> Bool
>= :: Bounds -> Bounds -> Bool
$cmax :: Bounds -> Bounds -> Bounds
max :: Bounds -> Bounds -> Bounds
$cmin :: Bounds -> Bounds -> Bounds
min :: Bounds -> Bounds -> Bounds
Ord, Int -> Bounds -> ShowS
[Bounds] -> ShowS
Bounds -> String
(Int -> Bounds -> ShowS)
-> (Bounds -> String) -> ([Bounds] -> ShowS) -> Show Bounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bounds -> ShowS
showsPrec :: Int -> Bounds -> ShowS
$cshow :: Bounds -> String
show :: Bounds -> String
$cshowList :: [Bounds] -> ShowS
showList :: [Bounds] -> ShowS
Show, (forall x. Bounds -> Rep Bounds x)
-> (forall x. Rep Bounds x -> Bounds) -> Generic Bounds
forall x. Rep Bounds x -> Bounds
forall x. Bounds -> Rep Bounds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Bounds -> Rep Bounds x
from :: forall x. Bounds -> Rep Bounds x
$cto :: forall x. Rep Bounds x -> Bounds
to :: forall x. Rep Bounds x -> Bounds
Generic)

instance FromJSON Bounds
instance ToJSON Bounds

data Kerning = Kerning
  { Kerning -> Float
advance :: Float
  , Kerning -> Maybe Int
unicode1 :: Maybe Int
  , Kerning -> Maybe Int
unicode2 :: Maybe Int
  , Kerning -> Maybe Int
index1 :: Maybe Int
  , Kerning -> Maybe Int
index2 :: Maybe Int
  }
  deriving (Kerning -> Kerning -> Bool
(Kerning -> Kerning -> Bool)
-> (Kerning -> Kerning -> Bool) -> Eq Kerning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Kerning -> Kerning -> Bool
== :: Kerning -> Kerning -> Bool
$c/= :: Kerning -> Kerning -> Bool
/= :: Kerning -> Kerning -> Bool
Eq, Eq Kerning
Eq Kerning =>
(Kerning -> Kerning -> Ordering)
-> (Kerning -> Kerning -> Bool)
-> (Kerning -> Kerning -> Bool)
-> (Kerning -> Kerning -> Bool)
-> (Kerning -> Kerning -> Bool)
-> (Kerning -> Kerning -> Kerning)
-> (Kerning -> Kerning -> Kerning)
-> Ord Kerning
Kerning -> Kerning -> Bool
Kerning -> Kerning -> Ordering
Kerning -> Kerning -> Kerning
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Kerning -> Kerning -> Ordering
compare :: Kerning -> Kerning -> Ordering
$c< :: Kerning -> Kerning -> Bool
< :: Kerning -> Kerning -> Bool
$c<= :: Kerning -> Kerning -> Bool
<= :: Kerning -> Kerning -> Bool
$c> :: Kerning -> Kerning -> Bool
> :: Kerning -> Kerning -> Bool
$c>= :: Kerning -> Kerning -> Bool
>= :: Kerning -> Kerning -> Bool
$cmax :: Kerning -> Kerning -> Kerning
max :: Kerning -> Kerning -> Kerning
$cmin :: Kerning -> Kerning -> Kerning
min :: Kerning -> Kerning -> Kerning
Ord, Int -> Kerning -> ShowS
[Kerning] -> ShowS
Kerning -> String
(Int -> Kerning -> ShowS)
-> (Kerning -> String) -> ([Kerning] -> ShowS) -> Show Kerning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Kerning -> ShowS
showsPrec :: Int -> Kerning -> ShowS
$cshow :: Kerning -> String
show :: Kerning -> String
$cshowList :: [Kerning] -> ShowS
showList :: [Kerning] -> ShowS
Show, (forall x. Kerning -> Rep Kerning x)
-> (forall x. Rep Kerning x -> Kerning) -> Generic Kerning
forall x. Rep Kerning x -> Kerning
forall x. Kerning -> Rep Kerning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Kerning -> Rep Kerning x
from :: forall x. Kerning -> Rep Kerning x
$cto :: forall x. Rep Kerning x -> Kerning
to :: forall x. Rep Kerning x -> Kerning
Generic)

instance FromJSON Kerning
instance ToJSON Kerning

    -- - `glyphs` is an array of individual glyphs identified by Unicode character index (`unicode`) or glyph index (`index`), depending on whether character set or glyph set mode is used.
    --     - `advance` is the horizontal advance in em's.
    --     - `planeBounds` represents the glyph quad's bounds in em's relative to the baseline and horizontal cursor position.
    --     - `atlasBounds` represents the glyph's bounds in the atlas in pixels.
    -- - If available, `kerning` lists all kerning pairs and their advance adjustment (which needs to be added to the base advance of the first glyph in the pair).