module Codec.Tiled.Tileset
  ( Tileset(..)
  , 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.Property (Property)
import Codec.Tiled.Tileset.Grid (Grid)
import Codec.Tiled.Tileset.Terrain (Terrain)
import Codec.Tiled.Tileset.Tile (Tile)
import Codec.Tiled.Tileset.TileOffset (TileOffset)
import Codec.Tiled.Tileset.Transformations (Transformations)
import Codec.Tiled.Tileset.WangSet (WangSet)
import Data.Tiled.GID (GID)

data Tileset = Tileset
  { Tileset -> Maybe Text
backgroundColor  :: Maybe Text              -- ^ Hex-formatted color (#RRGGBB or #AARRGGBB) (optional)
  , Tileset -> Int
columns          :: Int                     -- ^ The number of tile columns in the tileset
  , Tileset -> Maybe GID
firstGid         :: Maybe GID               -- ^ GID corresponding to the first tile in the set
  , Tileset -> Maybe Grid
grid             :: Maybe Grid              -- ^ (optional)
  , Tileset -> FilePath
image            :: FilePath                -- ^ Image used for tiles in this set
  , Tileset -> Int
imageHeight      :: Int                     -- ^ Height of source image in pixels
  , Tileset -> Int
imageWidth       :: Int                     -- ^ Width of source image in pixels
  , Tileset -> Int
margin           :: Int                     -- ^ Buffer between image edge and first tile (pixels)
  , Tileset -> Text
name             :: Text                    -- ^ Name given to this tileset
  , Tileset -> Maybe Text
objectAlignment  :: Maybe Text              -- ^ Alignment to use for tile objects (unspecified (default), @topleft@, @top@, @topright@, @left@, @center@, @right@, @bottomleft@, @bottom@ or @bottomright@)
  , Tileset -> Maybe (Vector Property)
properties       :: Maybe (Vector Property) -- ^ Array of Properties
  , Tileset -> Maybe FilePath
source           :: Maybe FilePath          -- ^ The external file that contains this tilesets data
  , Tileset -> Int
spacing          :: Int                     -- ^ Spacing between adjacent tiles in image (pixels)
  , Tileset -> Maybe (Vector Terrain)
terrains         :: Maybe (Vector Terrain)  -- ^ Array of Terrains (optional)
  , Tileset -> Int
tileCount        :: Int                     -- ^ The number of tiles in this tileset
  , Tileset -> Maybe Text
tiledVersion     :: Maybe Text              -- ^ The Tiled version used to save the file
  , Tileset -> Int
tileHeight       :: Int                     -- ^ Maximum height of tiles in this set
  , Tileset -> Maybe TileOffset
tileOffset       :: Maybe TileOffset        -- ^ (optional)
  , Tileset -> Maybe (Vector Tile)
tiles            :: Maybe (Vector Tile)     -- ^ Array of Tiles (optional)
  , Tileset -> Int
tileWidth        :: Int                     -- ^ Maximum width of tiles in this set
  , Tileset -> Maybe Transformations
transformations  :: Maybe Transformations   -- ^ Allowed transformations (optional)
  , Tileset -> Maybe Text
transparentColor :: Maybe Text              -- ^ Hex-formatted color (#RRGGBB) (optional)
  , Tileset -> Maybe Text
type_            :: Maybe Text              -- ^ @tileset@ (for tileset files)
  , Tileset -> Maybe Text
version          :: Maybe Text              -- ^ The JSON format version
  , Tileset -> Maybe (Vector WangSet)
wangSets         :: Maybe (Vector WangSet)  -- ^ Array of Wang sets
  }
  deriving (Tileset -> Tileset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tileset -> Tileset -> Bool
$c/= :: Tileset -> Tileset -> Bool
== :: Tileset -> Tileset -> Bool
$c== :: Tileset -> Tileset -> Bool
Eq, Int -> Tileset -> ShowS
[Tileset] -> ShowS
Tileset -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Tileset] -> ShowS
$cshowList :: [Tileset] -> ShowS
show :: Tileset -> FilePath
$cshow :: Tileset -> FilePath
showsPrec :: Int -> Tileset -> ShowS
$cshowsPrec :: Int -> Tileset -> ShowS
Show, forall x. Rep Tileset x -> Tileset
forall x. Tileset -> Rep Tileset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tileset x -> Tileset
$cfrom :: forall x. Tileset -> Rep Tileset x
Generic)

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

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

empty :: Tileset
empty :: Tileset
empty =  Tileset
  { backgroundColor :: Maybe Text
backgroundColor  = forall a. Maybe a
Nothing
  , columns :: Int
columns          = Int
0
  , firstGid :: Maybe GID
firstGid         = forall a. Maybe a
Nothing
  , grid :: Maybe Grid
grid             = forall a. Maybe a
Nothing
  , image :: FilePath
image            = FilePath
""
  , imageHeight :: Int
imageHeight      = Int
0
  , imageWidth :: Int
imageWidth       = Int
0
  , margin :: Int
margin           = Int
0
  , name :: Text
name             = Text
""
  , objectAlignment :: Maybe Text
objectAlignment  = forall a. Maybe a
Nothing
  , properties :: Maybe (Vector Property)
properties       = forall a. Maybe a
Nothing
  , source :: Maybe FilePath
source           = forall a. Maybe a
Nothing
  , spacing :: Int
spacing          = Int
0
  , terrains :: Maybe (Vector Terrain)
terrains         = forall a. Maybe a
Nothing
  , tileCount :: Int
tileCount        = Int
0
  , tiledVersion :: Maybe Text
tiledVersion     = forall a. Maybe a
Nothing
  , tileHeight :: Int
tileHeight       = Int
0
  , tileOffset :: Maybe TileOffset
tileOffset       = forall a. Maybe a
Nothing
  , tiles :: Maybe (Vector Tile)
tiles            = forall a. Maybe a
Nothing
  , tileWidth :: Int
tileWidth        = Int
0
  , transformations :: Maybe Transformations
transformations  = forall a. Maybe a
Nothing
  , transparentColor :: Maybe Text
transparentColor = forall a. Maybe a
Nothing
  , type_ :: Maybe Text
type_            = forall a. Maybe a
Nothing
  , version :: Maybe Text
version          = forall a. Maybe a
Nothing
  , wangSets :: Maybe (Vector WangSet)
wangSets         = forall a. Maybe a
Nothing
  }