module Codec.Tiled.Object.Text
  ( Text(..)
  , empty
  ) where

import Data.Text qualified as The
import GHC.Generics (Generic)

import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)

data Text = Text
  { Text -> Maybe Bool
bold       :: Maybe Bool     -- ^  Whether to use a bold font (default: false)
  , Text -> Maybe Text
color      :: Maybe The.Text -- ^  Hex-formatted color (#RRGGBB or #AARRGGBB) (default: #000000)
  , Text -> Maybe Text
fontFamily :: Maybe The.Text -- ^  Font family (default: sans-serif)
  , Text -> Maybe Text
hAlign     :: Maybe The.Text -- ^  Horizontal alignment (center, right, justify or left (default))
  , Text -> Maybe Bool
italic     :: Maybe Bool     -- ^  Whether to use an italic font (default: false)
  , Text -> Maybe Bool
kerning    :: Maybe Bool     -- ^  Whether to use kerning when placing characters (default: true)
  , Text -> Maybe Int
pixelSize  :: Maybe Int      -- ^  Pixel size of font (default: 16)
  , Text -> Maybe Bool
strikeout  :: Maybe Bool     -- ^  Whether to strike out the text (default: false)
  , Text -> Text
text       :: The.Text       -- ^  Text
  , Text -> Maybe Bool
underline  :: Maybe Bool     -- ^  Whether to underline the text (default: false)
  , Text -> Maybe Text
vAlign     :: Maybe The.Text -- ^  Vertical alignment (center, bottom or top (default))
  , Text -> Maybe Bool
wrap       :: Maybe Bool     -- ^  Whether the text is wrapped within the object bounds (default: false)
  }
  deriving (Text -> Text -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Text -> Text -> Bool
$c/= :: Text -> Text -> Bool
== :: Text -> Text -> Bool
$c== :: Text -> Text -> Bool
Eq, Int -> Text -> ShowS
[Text] -> ShowS
Text -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Text] -> ShowS
$cshowList :: [Text] -> ShowS
show :: Text -> String
$cshow :: Text -> String
showsPrec :: Int -> Text -> ShowS
$cshowsPrec :: Int -> Text -> ShowS
Show, forall x. Rep Text x -> Text
forall x. Text -> Rep Text x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Text x -> Text
$cfrom :: forall x. Text -> Rep Text x
Generic)

instance FromJSON Text where
  parseJSON :: Value -> Parser Text
parseJSON = forall a. (Generic a, GFromJSON Zero (Rep a)) => Value -> Parser a
genericParseJSON

instance ToJSON Text where
  toJSON :: Text -> Value
toJSON = forall a. (Generic a, GToJSON' Value Zero (Rep a)) => a -> Value
genericToJSON

empty :: Text
empty :: Text
empty = Text
  { bold :: Maybe Bool
bold       = forall a. Maybe a
Nothing
  , color :: Maybe Text
color      = forall a. Maybe a
Nothing
  , fontFamily :: Maybe Text
fontFamily = forall a. Maybe a
Nothing
  , hAlign :: Maybe Text
hAlign     = forall a. Maybe a
Nothing
  , italic :: Maybe Bool
italic     = forall a. Maybe a
Nothing
  , kerning :: Maybe Bool
kerning    = forall a. Maybe a
Nothing
  , pixelSize :: Maybe Int
pixelSize  = forall a. Maybe a
Nothing
  , strikeout :: Maybe Bool
strikeout  = forall a. Maybe a
Nothing
  , text :: Text
text       = Text
""
  , underline :: Maybe Bool
underline  = forall a. Maybe a
Nothing
  , vAlign :: Maybe Text
vAlign     = forall a. Maybe a
Nothing
  , wrap :: Maybe Bool
wrap       = forall a. Maybe a
Nothing
  }