module Codec.Tiled.Object where

import Data.Text (Text)
import Data.Vector (Vector)
import GHC.Generics (Generic)

import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)
import Codec.Tiled.Object.Point (Point)
import Codec.Tiled.Object.Text qualified as Object (Text)
import Codec.Tiled.Property (Property)
import Data.Tiled.GID (GID)

data Object = Object
  { Object -> Maybe Bool
ellipse    :: Maybe Bool              -- ^ Used to mark an object as an ellipse
  , Object -> Maybe GID
gid        :: Maybe GID               -- ^ Global tile ID, only if object represents a tile
  , Object -> Double
height     :: Double                  -- ^ Height in pixels.
  , Object -> Int
id         :: Int                     -- ^ Incremental ID, unique across all objects
  , Object -> Text
name       :: Text                    -- ^ String assigned to name field in editor
  , Object -> Maybe Bool
point      :: Maybe Bool              -- ^ Used to mark an object as a point
  , Object -> Maybe (Vector Point)
polygon    :: Maybe (Vector Point)    -- ^ Array of Points, in case the object is a polygon
  , Object -> Maybe (Vector Point)
polyline   :: Maybe (Vector Point)    -- ^ Array of Points, in case the object is a polyline
  , Object -> Maybe (Vector Property)
properties :: Maybe (Vector Property) -- ^ Array of Properties
  , Object -> Double
rotation   :: Double                  -- ^ Angle in degrees clockwise
  , Object -> Maybe FilePath
template   :: Maybe FilePath          -- ^ Reference to a template file, in case object is a template instance
  , Object -> Maybe Text
text       :: Maybe Object.Text       -- ^ Only used for text objects
  , Object -> Text
type_      :: Text                    -- ^ String assigned to type field in editor
  , Object -> Bool
visible    :: Bool                    -- ^ Whether object is shown in editor.
  , Object -> Double
width      :: Double                  -- ^ Width in pixels.
  , Object -> Double
x          :: Double                  -- ^ X coordinate in pixels
  , Object -> Double
y          :: Double                  -- ^ Y coordinate in pixels
  }
  deriving (Object -> Object -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Object -> Object -> Bool
$c/= :: Object -> Object -> Bool
== :: Object -> Object -> Bool
$c== :: Object -> Object -> Bool
Eq, Int -> Object -> ShowS
[Object] -> ShowS
Object -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Object] -> ShowS
$cshowList :: [Object] -> ShowS
show :: Object -> FilePath
$cshow :: Object -> FilePath
showsPrec :: Int -> Object -> ShowS
$cshowsPrec :: Int -> Object -> ShowS
Show, forall x. Rep Object x -> Object
forall x. Object -> Rep Object x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Object x -> Object
$cfrom :: forall x. Object -> Rep Object x
Generic)

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

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