module Codec.Tiled.Tileset.Tile
  ( Tile(..)
  , empty
  ) where

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

import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)
import Codec.Tiled.Layer (Layer)
import Codec.Tiled.Property (Property)
import Codec.Tiled.Tileset.Frame (Frame)

data Tile = Tile
  { Tile -> Maybe (Vector Frame)
animation   :: Maybe (Vector Frame)    -- ^ Array of Frames
  , Tile -> Int
id          :: Int                     -- ^ Local ID of the tile
  , Tile -> Maybe FilePath
image       :: Maybe FilePath          -- ^ Image representing this tile (optional)
  , Tile -> Int
imageHeight :: Int                     -- ^ Height of the tile image in pixels
  , Tile -> Int
imageWidth  :: Int                     -- ^ Width of the tile image in pixels
  , Tile -> Maybe Layer
objectGroup :: Maybe Layer             -- ^ Layer with type objectgroup, when collision shapes are specified (optional)
  , Tile -> Maybe Double
probability :: Maybe Double            -- ^ Percentage chance this tile is chosen when competing with others in the editor (optional)
  , Tile -> Maybe (Vector Property)
properties  :: Maybe (Vector Property) -- ^ Array of Properties
  , Tile -> Maybe (Vector Int)
terrain     :: Maybe (Vector Int)      -- ^ Index of terrain for each corner of tile (optional)
  , Tile -> Maybe Text
type_       :: Maybe Text              -- ^ The type of the tile (optional)
  }
  deriving (Tile -> Tile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tile -> Tile -> Bool
$c/= :: Tile -> Tile -> Bool
== :: Tile -> Tile -> Bool
$c== :: Tile -> Tile -> Bool
Eq, Int -> Tile -> ShowS
[Tile] -> ShowS
Tile -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Tile] -> ShowS
$cshowList :: [Tile] -> ShowS
show :: Tile -> FilePath
$cshow :: Tile -> FilePath
showsPrec :: Int -> Tile -> ShowS
$cshowsPrec :: Int -> Tile -> ShowS
Show, forall x. Rep Tile x -> Tile
forall x. Tile -> Rep Tile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tile x -> Tile
$cfrom :: forall x. Tile -> Rep Tile x
Generic)

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

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

empty :: Tile
empty :: Tile
empty = Tile
  { animation :: Maybe (Vector Frame)
animation   = forall a. Maybe a
Nothing
  , id :: Int
id          = Int
0
  , image :: Maybe FilePath
image       = forall a. Maybe a
Nothing
  , imageHeight :: Int
imageHeight = Int
0
  , imageWidth :: Int
imageWidth  = Int
0
  , objectGroup :: Maybe Layer
objectGroup = forall a. Maybe a
Nothing
  , probability :: Maybe Double
probability = forall a. Maybe a
Nothing
  , properties :: Maybe (Vector Property)
properties  = forall a. Maybe a
Nothing
  , terrain :: Maybe (Vector Int)
terrain     = forall a. Maybe a
Nothing
  , type_ :: Maybe Text
type_       = forall a. Maybe a
Nothing
  }