{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | This module provides Haskell types for Tiled's JSON exports, which you can -- read about at http://doc.mapeditor.org/en/latest/reference/json-map-format/. -- That said - as of the writing of this module the JSON documentation does not -- cover some of the types and records that are available in the format. For -- those you should read the TMX documentation at -- http://doc.mapeditor.org/en/latest/reference/tmx-map-format/ module Data.Aeson.Tiled ( -- * Tiled map editor types, their aeson instances and map loading module Data.Aeson.Tiled -- * Re-exports for working with Tiled types , module Data.Map , module Data.Vector ) where import Control.Applicative ((<|>)) import Control.Monad (forM) import Data.Aeson hiding (Object) import qualified Data.Aeson as A import Data.Aeson.Types (Parser, typeMismatch) import qualified Data.ByteString.Lazy.Char8 as C8 import Data.Map (Map) import qualified Data.Map as M import Data.Text (Text) import Data.Vector (Vector) import GHC.Generics (Generic) -- | A globally indexed identifier. newtype GlobalId = GlobalId { unGlobalId :: Int } deriving (Ord, Eq, Enum, Num, Generic, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey) -- | A locally indexed identifier. newtype LocalId = LocalId { unLocalId :: Int } deriving (Ord, Eq, Enum, Num, Generic, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey) data Object = Object { objectId :: Int -- ^ Incremental id - unique across all objects , objectWidth :: Int -- ^ Width in pixels. Ignored if using a gid. , objectHeight :: Int -- ^ Height in pixels. Ignored if using a gid. , objectName :: String -- ^ String assigned to name field in editor , objectType :: String -- ^ String assigned to type field in editor , objectProperties :: Map Text Text -- ^ String key-value pairs , objectVisible :: Bool -- ^ Whether object is shown in editor. , objectX :: Int -- ^ x coordinate in pixels , objectY :: Int -- ^ y coordinate in pixels , objectRotation :: Float -- ^ Angle in degrees clockwise , objectGid :: GlobalId -- ^ GID, only if object comes from a Tilemap , objectEllipse :: Bool -- ^ Used to mark an object as an ellipse , objectPolygon :: Vector (Int, Int) -- ^ A list of x,y coordinates in pixels , objectPolyline :: Vector (Int, Int) -- ^ A list of x,y coordinates in pixels , objectText :: Map Text Text -- ^ String key-value pairs } deriving (Eq, Generic, Show) instance FromJSON Object where parseJSON (A.Object o) = Object <$> o .: "id" <*> o .: "width" <*> o .: "height" <*> o .: "name" <*> o .: "type" <*> o .: "properties" <*> o .: "visible" <*> o .: "x" <*> o .: "y" <*> o .: "rotation" <*> o .: "gid" <*> o .: "ellipse" <*> o .: "polygon" <*> o .: "polyline" <*> o .: "text" parseJSON invalid = typeMismatch "Object" invalid instance ToJSON Object where toJSON Object{..} = object [ "id" .= objectId , "width" .= objectWidth , "height" .= objectHeight , "name" .= objectName , "type" .= objectType , "properties" .= objectProperties , "visible" .= objectVisible , "x" .= objectX , "y" .= objectY , "rotation" .= objectRotation , "gid" .= objectGid , "ellipse" .= objectEllipse , "polygon" .= objectPolygon , "polyline" .= objectPolyline , "text" .= objectText ] data Layer = Layer { layerWidth :: Int -- ^ Column count. Same as map width for fixed-size maps. , layerHeight :: Int -- ^ Row count. Same as map height for fixed-size maps. , layerName :: String -- ^ Name assigned to this layer , layerType :: String -- ^ “tilelayer”, “objectgroup”, or “imagelayer” , layerVisible :: Bool -- ^ Whether layer is shown or hidden in editor , layerX :: Int -- ^ Horizontal layer offset in tiles. Always 0. , layerY :: Int -- ^ Vertical layer offset in tiles. Always 0. , layerData :: Maybe (Vector GlobalId) -- ^ Array of GIDs. tilelayer only. , layerObjects :: Maybe (Vector Object) -- ^ Array of Objects. objectgroup only. , layerProperties :: Map Text Text -- ^ string key-value pairs. , layerOpacity :: Float -- ^ Value between 0 and 1 , layerDraworder :: String -- ^ “topdown” (default) or “index”. objectgroup only. } deriving (Eq, Generic, Show) instance FromJSON Layer where parseJSON (A.Object o) = Layer <$> (o .: "width" <|> pure 0) <*> (o .: "height" <|> pure 0) <*> o .: "name" <*> o .: "type" <*> o .: "visible" <*> o .: "x" <*> o .: "y" <*> (o .: "data" <|> pure Nothing) <*> (o .: "objects" <|> pure Nothing) <*> (o .: "properties" <|> pure mempty) <*> o .: "opacity" <*> (o .: "draworder" <|> pure "topdown") parseJSON invalid = typeMismatch "Layer" invalid instance ToJSON Layer where toJSON Layer{..} = object [ "width" .= layerWidth , "height" .= layerHeight , "name" .= layerName , "type" .= layerType , "visible" .= layerVisible , "x" .= layerX , "y" .= layerY , "data" .= layerData , "objects" .= layerObjects , "properties" .= layerProperties , "opacity" .= layerOpacity , "draworder" .= layerDraworder ] data Terrain = Terrain { terrainName :: String -- ^ Name of terrain , terrainTile :: LocalId -- ^ Local ID of tile representing terrain } deriving (Eq, Generic, Show) instance FromJSON Terrain where parseJSON (A.Object o) = Terrain <$> o .: "name" <*> o .: "tile" parseJSON invalid = typeMismatch "Terrain" invalid instance ToJSON Terrain where toJSON Terrain{..} = object [ "name" .= terrainName , "tile" .= terrainTile ] data Frame = Frame { frameDuration :: Int , frameTileId :: LocalId } deriving (Eq, Generic, Show) instance FromJSON Frame where parseJSON (A.Object o) = Frame <$> o .: "duration" <*> o .: "tileId" parseJSON invalid = typeMismatch "Frame" invalid instance ToJSON Frame where toJSON Frame{..} = object [ "duration" .= frameDuration , "tileId" .= frameTileId ] data Tile = Tile { tileId :: LocalId , tileProperties :: Map Text Text , tileImage :: Maybe Value , tileObjectGroup :: Maybe (Vector Object) , tileAnimation :: Maybe (Vector Frame) } deriving (Eq, Generic, Show) instance FromJSON Tile where parseJSON (A.Object o) = Tile 0 <$> (o .: "properties" <|> pure mempty) <*> (o .: "image" <|> pure Nothing) <*> (o .: "objectGroup" <|> pure mempty) <*> (o .: "animation" <|> pure mempty) parseJSON invalid = typeMismatch "Tile" invalid instance ToJSON Tile where toJSON Tile{..} = object [ "properties" .= tileProperties , "image" .= tileImage , "objectGroup" .= tileObjectGroup , "animation" .= tileAnimation ] data Tileset = Tileset { tilesetFirstgid :: GlobalId -- ^ GID corresponding to the first tile in the set , tilesetImage :: String -- ^ Image used for tiles in this set , tilesetName :: String -- ^ Name given to this tileset , tilesetTilewidth :: Int -- ^ Maximum width of tiles in this set , tilesetTileheight :: Int -- ^ Maximum height of tiles in this set , tilesetImagewidth :: Int -- ^ Width of source image in pixels , tilesetImageheight :: Int -- ^ Height of source image in pixels , tilesetProperties :: Map Text Text -- ^ String key-value pairs , tilesetPropertytypes :: Map Text Text -- ^ String key-value pairs , tilesetMargin :: Int -- ^ Buffer between image edge and first tile (pixels) , tilesetSpacing :: Int -- ^ Spacing between adjacent tiles in image (pixels) , tilesetTileproperties :: Map GlobalId (Map Text Text) -- ^ Per-tile properties, indexed by gid as string , tilesetTerrains :: Vector Terrain -- ^ Array of Terrains (optional) , tilesetColumns :: Int -- ^ The number of tile columns in the tileset , tilesetTilecount :: Int -- ^ The number of tiles in this tileset , tilesetTiles :: Map LocalId Tile -- ^ Tiles (optional) } deriving (Eq, Generic, Show) newtype TransitiveTilesetMap = TransitiveTilesetMap (Map LocalId Value) deriving (Show, Eq, Generic, FromJSON) parseTiles :: A.Object -> Parser (Map LocalId Tile) parseTiles o = do TransitiveTilesetMap localId2Value <- o .: "tiles" localIdAndTiles <- forM (M.toList localId2Value) $ \(lid, val) -> do tile <- parseJSON val return (lid, tile{ tileId = lid }) return $ M.fromList localIdAndTiles instance FromJSON Tileset where parseJSON (A.Object o) = Tileset <$> o .: "firstgid" <*> o .: "image" <*> o .: "name" <*> o .: "tilewidth" <*> o .: "tileheight" <*> o .: "imagewidth" <*> o .: "imageheight" <*> (o .: "properties" <|> pure mempty) <*> (o .: "propertytypes" <|> pure mempty) <*> o .: "margin" <*> o .: "spacing" <*> (o .: "tileproperties" <|> pure mempty) <*> (o .: "terrains" <|> pure mempty) <*> o .: "columns" <*> o .: "tilecount" <*> (parseTiles o <|> pure mempty) parseJSON invalid = typeMismatch "Tileset" invalid instance ToJSON Tileset where toJSON Tileset{..} = object [ "firstgid" .= tilesetFirstgid , "image" .= tilesetImage , "name" .= tilesetName , "tilewidth" .= tilesetTilewidth , "tileheight" .= tilesetTileheight , "imagewidth" .= tilesetImagewidth , "imageheight" .= tilesetImageheight , "properties" .= tilesetProperties , "propertytypes" .= tilesetPropertytypes , "margin" .= tilesetMargin , "spacing" .= tilesetSpacing , "tileproperties" .= tilesetTileproperties , "terrains" .= tilesetTerrains , "columns" .= tilesetColumns , "tilecount" .= tilesetTilecount , "tiles" .= tilesetTiles ] -- | The full monty. data Tiledmap = Tiledmap { tiledmapVersion :: Float -- ^ The JSON format version , tiledmapTiledversion :: String -- ^ The Tiled version used to save the file , tiledmapWidth :: Int -- ^ Number of tile columns , tiledmapHeight :: Int -- ^ Number of tile rows , tiledmapTilewidth :: Int -- ^ Map grid width. , tiledmapTileheight :: Int -- ^ Map grid height. , tiledmapOrientation :: String -- ^ Orthogonal, isometric, or staggered , tiledmapLayers :: Vector Layer -- ^ Array of Layers , tiledmapTilesets :: Vector Tileset -- ^ Array of Tilesets , tiledmapBackgroundcolor :: Maybe String -- ^ Hex-formatted color (#RRGGBB or #AARRGGBB) (optional) , tiledmapRenderorder :: String -- ^ Rendering direction (orthogonal maps only) , tiledmapProperties :: Map Text Text -- ^ String key-value pairs , tiledmapNextobjectid :: Int -- ^ Auto-increments for each placed object } deriving (Eq, Generic, Show) instance FromJSON Tiledmap where parseJSON (A.Object o) = Tiledmap <$> o .: "version" <*> o .: "tiledversion" <*> o .: "width" <*> o .: "height" <*> o .: "tilewidth" <*> o .: "tileheight" <*> o .: "orientation" <*> o .: "layers" <*> o .: "tilesets" <*> (o .: "backgroundcolor" <|> pure Nothing) <*> o .: "renderorder" <*> (o .: "properties" <|> pure mempty) <*> o .: "nextobjectid" parseJSON invalid = typeMismatch "Tiledmap" invalid instance ToJSON Tiledmap where toJSON Tiledmap{..} = object [ "version" .= tiledmapVersion , "tiledversion" .= tiledmapTiledversion , "width" .= tiledmapWidth , "height" .= tiledmapHeight , "tilewidth" .= tiledmapTilewidth , "tileheight" .= tiledmapTileheight , "orientation" .= tiledmapOrientation , "layers" .= tiledmapLayers , "tilesets" .= tiledmapTilesets , "backgroundcolor" .= tiledmapBackgroundcolor , "renderorder" .= tiledmapRenderorder , "properties" .= tiledmapProperties , "nextobjectid" .= tiledmapNextobjectid ] -- | Load a Tiled map from the given 'FilePath'. loadTiledmap :: FilePath -> IO (Either String Tiledmap) loadTiledmap = fmap eitherDecode . C8.readFile