module Graphics.MSDF.Atlas.CLI where

import Data.Text (Text)

type Inputs = [Input] -- grouped together with `-and`

data Input = Input
  { Input -> FilePath
font :: FilePath
  , Input -> [(Text, Int)]
variation :: [(Text, Int)] -- optional variations, switching to varfont
  , Input -> Maybe Range
range :: Maybe Range
  , Input -> Maybe Float
fontscale :: Maybe Float
  , Input -> Maybe Text
fontname :: Maybe Text
  }
  deriving (Input -> Input -> Bool
(Input -> Input -> Bool) -> (Input -> Input -> Bool) -> Eq Input
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Input -> Input -> Bool
== :: Input -> Input -> Bool
$c/= :: Input -> Input -> Bool
/= :: Input -> Input -> Bool
Eq, Int -> Input -> ShowS
[Input] -> ShowS
Input -> FilePath
(Int -> Input -> ShowS)
-> (Input -> FilePath) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Input -> ShowS
showsPrec :: Int -> Input -> ShowS
$cshow :: Input -> FilePath
show :: Input -> FilePath
$cshowList :: [Input] -> ShowS
showList :: [Input] -> ShowS
Show)

data Range
  = Charset FilePath
  | Chars SetSpec
  | Glyphs SetSpec
  | Allglyphs
  deriving (Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
/= :: Range -> Range -> Bool
Eq, Int -> Range -> ShowS
[Range] -> ShowS
Range -> FilePath
(Int -> Range -> ShowS)
-> (Range -> FilePath) -> ([Range] -> ShowS) -> Show Range
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Range -> ShowS
showsPrec :: Int -> Range -> ShowS
$cshow :: Range -> FilePath
show :: Range -> FilePath
$cshowList :: [Range] -> ShowS
showList :: [Range] -> ShowS
Show)

data SetSpec
  = Single Char
  | Range Char Char
  | String [Char]
  deriving (SetSpec -> SetSpec -> Bool
(SetSpec -> SetSpec -> Bool)
-> (SetSpec -> SetSpec -> Bool) -> Eq SetSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetSpec -> SetSpec -> Bool
== :: SetSpec -> SetSpec -> Bool
$c/= :: SetSpec -> SetSpec -> Bool
/= :: SetSpec -> SetSpec -> Bool
Eq, Int -> SetSpec -> ShowS
[SetSpec] -> ShowS
SetSpec -> FilePath
(Int -> SetSpec -> ShowS)
-> (SetSpec -> FilePath) -> ([SetSpec] -> ShowS) -> Show SetSpec
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetSpec -> ShowS
showsPrec :: Int -> SetSpec -> ShowS
$cshow :: SetSpec -> FilePath
show :: SetSpec -> FilePath
$cshowList :: [SetSpec] -> ShowS
showList :: [SetSpec] -> ShowS
Show)

data Format
  = PNG
  | BMP
  | TIFF
  | RGBA
  | FL32
  | TEXT
  | TEXTFLOAT
  | BIN
  | BINFLOAT
  | BINFLOATLE
  deriving (Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
/= :: Format -> Format -> Bool
Eq, Eq Format
Eq Format =>
(Format -> Format -> Ordering)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Format)
-> (Format -> Format -> Format)
-> Ord Format
Format -> Format -> Bool
Format -> Format -> Ordering
Format -> Format -> Format
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 :: Format -> Format -> Ordering
compare :: Format -> Format -> Ordering
$c< :: Format -> Format -> Bool
< :: Format -> Format -> Bool
$c<= :: Format -> Format -> Bool
<= :: Format -> Format -> Bool
$c> :: Format -> Format -> Bool
> :: Format -> Format -> Bool
$c>= :: Format -> Format -> Bool
>= :: Format -> Format -> Bool
$cmax :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
min :: Format -> Format -> Format
Ord, Int -> Format -> ShowS
[Format] -> ShowS
Format -> FilePath
(Int -> Format -> ShowS)
-> (Format -> FilePath) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Format -> ShowS
showsPrec :: Int -> Format -> ShowS
$cshow :: Format -> FilePath
show :: Format -> FilePath
$cshowList :: [Format] -> ShowS
showList :: [Format] -> ShowS
Show, Int -> Format
Format -> Int
Format -> [Format]
Format -> Format
Format -> Format -> [Format]
Format -> Format -> Format -> [Format]
(Format -> Format)
-> (Format -> Format)
-> (Int -> Format)
-> (Format -> Int)
-> (Format -> [Format])
-> (Format -> Format -> [Format])
-> (Format -> Format -> [Format])
-> (Format -> Format -> Format -> [Format])
-> Enum Format
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 :: Format -> Format
succ :: Format -> Format
$cpred :: Format -> Format
pred :: Format -> Format
$ctoEnum :: Int -> Format
toEnum :: Int -> Format
$cfromEnum :: Format -> Int
fromEnum :: Format -> Int
$cenumFrom :: Format -> [Format]
enumFrom :: Format -> [Format]
$cenumFromThen :: Format -> Format -> [Format]
enumFromThen :: Format -> Format -> [Format]
$cenumFromTo :: Format -> Format -> [Format]
enumFromTo :: Format -> Format -> [Format]
$cenumFromThenTo :: Format -> Format -> Format -> [Format]
enumFromThenTo :: Format -> Format -> Format -> [Format]
Enum, Format
Format -> Format -> Bounded Format
forall a. a -> a -> Bounded a
$cminBound :: Format
minBound :: Format
$cmaxBound :: Format
maxBound :: Format
Bounded)

data Dimensions
  = Fixed Int Int
  | Auto Constraint
  deriving (Dimensions -> Dimensions -> Bool
(Dimensions -> Dimensions -> Bool)
-> (Dimensions -> Dimensions -> Bool) -> Eq Dimensions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dimensions -> Dimensions -> Bool
== :: Dimensions -> Dimensions -> Bool
$c/= :: Dimensions -> Dimensions -> Bool
/= :: Dimensions -> Dimensions -> Bool
Eq, Int -> Dimensions -> ShowS
[Dimensions] -> ShowS
Dimensions -> FilePath
(Int -> Dimensions -> ShowS)
-> (Dimensions -> FilePath)
-> ([Dimensions] -> ShowS)
-> Show Dimensions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dimensions -> ShowS
showsPrec :: Int -> Dimensions -> ShowS
$cshow :: Dimensions -> FilePath
show :: Dimensions -> FilePath
$cshowList :: [Dimensions] -> ShowS
showList :: [Dimensions] -> ShowS
Show)

data Constraint
  = PoTS
  | PoTR
  | Square
  | Square2
  | Square4 -- default
  deriving (Constraint -> Constraint -> Bool
(Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool) -> Eq Constraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Constraint -> Constraint -> Bool
== :: Constraint -> Constraint -> Bool
$c/= :: Constraint -> Constraint -> Bool
/= :: Constraint -> Constraint -> Bool
Eq, Int -> Constraint -> ShowS
[Constraint] -> ShowS
Constraint -> FilePath
(Int -> Constraint -> ShowS)
-> (Constraint -> FilePath)
-> ([Constraint] -> ShowS)
-> Show Constraint
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Constraint -> ShowS
showsPrec :: Int -> Constraint -> ShowS
$cshow :: Constraint -> FilePath
show :: Constraint -> FilePath
$cshowList :: [Constraint] -> ShowS
showList :: [Constraint] -> ShowS
Show)

data Uniform
  = UniformCols Int
  | UniformCell Int Int
  | UniformCellConstraint Constraint
  | UniformOrigin OriginConstraint
  deriving (Uniform -> Uniform -> Bool
(Uniform -> Uniform -> Bool)
-> (Uniform -> Uniform -> Bool) -> Eq Uniform
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Uniform -> Uniform -> Bool
== :: Uniform -> Uniform -> Bool
$c/= :: Uniform -> Uniform -> Bool
/= :: Uniform -> Uniform -> Bool
Eq, Int -> Uniform -> ShowS
[Uniform] -> ShowS
Uniform -> FilePath
(Int -> Uniform -> ShowS)
-> (Uniform -> FilePath) -> ([Uniform] -> ShowS) -> Show Uniform
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Uniform -> ShowS
showsPrec :: Int -> Uniform -> ShowS
$cshow :: Uniform -> FilePath
show :: Uniform -> FilePath
$cshowList :: [Uniform] -> ShowS
showList :: [Uniform] -> ShowS
Show)

data OriginConstraint
  = Off
  | On
  | Horizontal
  | Vertical
  deriving (OriginConstraint -> OriginConstraint -> Bool
(OriginConstraint -> OriginConstraint -> Bool)
-> (OriginConstraint -> OriginConstraint -> Bool)
-> Eq OriginConstraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OriginConstraint -> OriginConstraint -> Bool
== :: OriginConstraint -> OriginConstraint -> Bool
$c/= :: OriginConstraint -> OriginConstraint -> Bool
/= :: OriginConstraint -> OriginConstraint -> Bool
Eq, Int -> OriginConstraint -> ShowS
[OriginConstraint] -> ShowS
OriginConstraint -> FilePath
(Int -> OriginConstraint -> ShowS)
-> (OriginConstraint -> FilePath)
-> ([OriginConstraint] -> ShowS)
-> Show OriginConstraint
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OriginConstraint -> ShowS
showsPrec :: Int -> OriginConstraint -> ShowS
$cshow :: OriginConstraint -> FilePath
show :: OriginConstraint -> FilePath
$cshowList :: [OriginConstraint] -> ShowS
showList :: [OriginConstraint] -> ShowS
Show)

type Outputs = [Output]

data Output
  = ImageOut FilePath
  | JSON FilePath
  | CSV FilePath
  | ARFont FilePath
  | ShadronPreview FilePath Text
  deriving (Output -> Output -> Bool
(Output -> Output -> Bool)
-> (Output -> Output -> Bool) -> Eq Output
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Output -> Output -> Bool
== :: Output -> Output -> Bool
$c/= :: Output -> Output -> Bool
/= :: Output -> Output -> Bool
Eq, Int -> Output -> ShowS
[Output] -> ShowS
Output -> FilePath
(Int -> Output -> ShowS)
-> (Output -> FilePath) -> ([Output] -> ShowS) -> Show Output
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Output -> ShowS
showsPrec :: Int -> Output -> ShowS
$cshow :: Output -> FilePath
show :: Output -> FilePath
$cshowList :: [Output] -> ShowS
showList :: [Output] -> ShowS
Show)

data Glyph = Glyph
  { Glyph -> Maybe Float
size :: Maybe Float -- pixels per em
  , Glyph -> Maybe Float
minsize :: Maybe Float
  , Glyph -> Maybe Float
emrange :: Maybe Float
  , Glyph -> Maybe Int
pxrange :: Maybe Int
  , Glyph -> Maybe (Float, Float)
aemrange :: Maybe (Float, Float)
  , Glyph -> OriginConstraint
pxalign :: OriginConstraint
  , Glyph -> Maybe Float
empadding :: Maybe Float
  , Glyph -> Maybe Int
pxpadding :: Maybe Int
  , Glyph -> Maybe Float
outerempadding :: Maybe Float
  , Glyph -> Maybe Int
outerpxpadding :: Maybe Int
  , Glyph -> Maybe (LBTR Float)
aempadding :: Maybe (LBTR Float)
  , Glyph -> Maybe (LBTR Int)
apxpadding :: Maybe (LBTR Int)
  , Glyph -> Maybe (LBTR Float)
aouterempadding :: Maybe (LBTR Float)
  , Glyph -> Maybe (LBTR Int)
aouterpxpadding :: Maybe (LBTR Int)
  }
  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, Int -> Glyph -> ShowS
[Glyph] -> ShowS
Glyph -> FilePath
(Int -> Glyph -> ShowS)
-> (Glyph -> FilePath) -> ([Glyph] -> ShowS) -> Show Glyph
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Glyph -> ShowS
showsPrec :: Int -> Glyph -> ShowS
$cshow :: Glyph -> FilePath
show :: Glyph -> FilePath
$cshowList :: [Glyph] -> ShowS
showList :: [Glyph] -> ShowS
Show)

data LBTR a = LBTR
  { forall a. LBTR a -> a
left, forall a. LBTR a -> a
bottom, forall a. LBTR a -> a
right, forall a. LBTR a -> a
top :: a
  }
  deriving (LBTR a -> LBTR a -> Bool
(LBTR a -> LBTR a -> Bool)
-> (LBTR a -> LBTR a -> Bool) -> Eq (LBTR a)
forall a. Eq a => LBTR a -> LBTR a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => LBTR a -> LBTR a -> Bool
== :: LBTR a -> LBTR a -> Bool
$c/= :: forall a. Eq a => LBTR a -> LBTR a -> Bool
/= :: LBTR a -> LBTR a -> Bool
Eq, Int -> LBTR a -> ShowS
[LBTR a] -> ShowS
LBTR a -> FilePath
(Int -> LBTR a -> ShowS)
-> (LBTR a -> FilePath) -> ([LBTR a] -> ShowS) -> Show (LBTR a)
forall a. Show a => Int -> LBTR a -> ShowS
forall a. Show a => [LBTR a] -> ShowS
forall a. Show a => LBTR a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> LBTR a -> ShowS
showsPrec :: Int -> LBTR a -> ShowS
$cshow :: forall a. Show a => LBTR a -> FilePath
show :: LBTR a -> FilePath
$cshowList :: forall a. Show a => [LBTR a] -> ShowS
showList :: [LBTR a] -> ShowS
Show)