summaryrefslogtreecommitdiff
path: root/lib/Tiled2.hs
diff options
context:
space:
mode:
authorstuebinm2021-11-17 02:59:34 +0100
committerstuebinm2021-11-17 02:59:34 +0100
commitc74a9c7fcb6a9f03351f6ff35ea035d1e03f63a4 (patch)
tree6a83d87cb133c8ebb89ec34f56da40726dbf61f2 /lib/Tiled2.hs
parent919f57bfb30ef2adda996bf708ba6d1f70c42945 (diff)
make map parser work with more maps
I found yet more properties that weren't really documented or weren't marked as optional, hurray!
Diffstat (limited to '')
-rw-r--r--lib/Tiled2.hs30
1 files changed, 25 insertions, 5 deletions
diff --git a/lib/Tiled2.hs b/lib/Tiled2.hs
index 2c5f55e..7924d3e 100644
--- a/lib/Tiled2.hs
+++ b/lib/Tiled2.hs
@@ -61,7 +61,7 @@ data Property = Property Text PropertyValue
-- | The value of a custom tiled property.
-- It is strongly typed via a tag in the json representation,
-- and needs a custom ToJSON and FromJSON instance because of that.
-data PropertyValue = StrProp Text | BoolProp Bool
+data PropertyValue = StrProp Text | BoolProp Bool | IntProp Int
deriving (Eq, Generic, Show)
instance IsString PropertyValue where
@@ -77,7 +77,10 @@ instance FromJSON Property where
A.String "bool" -> do
val <- o .: "value"
pure $ Property name (BoolProp val)
- ty -> fail $ "properties can only have type string or bool, but encountered " <> show ty
+ A.String "int" -> do
+ val <- o .: "value"
+ pure $ Property name (IntProp val)
+ ty -> fail $ "properties can only have types string, int, bool, but encountered type" <> show ty
parseJSON invalid = typeMismatch "Property" invalid
instance ToJSON Property where
@@ -90,6 +93,18 @@ instance ToJSON Property where
, "name" .= name
, "value" .= bool
]
+ IntProp int -> object [ "type" .= A.String "int"
+ , "name" .= name
+ , "value" .= int]
+
+data Point = Point { pointX :: Int
+ , pointY :: Int
+ } deriving (Eq, Generic, Show)
+
+instance FromJSON Point where
+ parseJSON = genericParseJSON (aesonOptions 5)
+instance ToJSON Point where
+ toJSON = genericToJSON (aesonOptions 5)
data Object = Object { objectId :: Int
-- ^ Incremental id - unique across all objects
@@ -115,9 +130,9 @@ data Object = Object { objectId :: Int
-- ^ GID, only if object comes from a Tilemap
, objectEllipse :: Maybe Bool
-- ^ Used to mark an object as an ellipse
- , objectPolygon :: Maybe (Vector (Double, Double))
+ , objectPolygon :: Maybe (Vector Point)
-- ^ A list of x,y coordinates in pixels
- , objectPolyline :: Maybe (Vector (Double, Double))
+ , objectPolyline :: Maybe (Vector Point)
-- ^ A list of x,y coordinates in pixels
, objectText :: Maybe Value
-- ^ String key-value pairs
@@ -160,6 +175,10 @@ data Layer = Layer { layerWidth :: Maybe Double
, layerParallaxy :: Maybe Float
, layerTintColor :: Maybe Color
, layerTransparentColor :: Maybe Color
+ , layerImage :: Maybe Text
+ , layerLayers :: Maybe [Layer]
+ , layerStartX :: Maybe Int
+ , layerStartY :: Maybe Int
} deriving (Eq, Generic, Show)
instance FromJSON Layer where
@@ -210,6 +229,7 @@ data Tile = Tile { tileId :: Int
, tileImagewidth :: Maybe Int
, tileProbability :: Maybe Float
, tileType :: Maybe Text
+ , tileTerrain :: Maybe [Int]
} deriving (Eq, Generic, Show)
instance FromJSON Tile where
@@ -278,7 +298,7 @@ instance ToJSON Tileset where
-- | The full monty.
data Tiledmap = Tiledmap { tiledmapVersion :: Value
-- ^ The JSON format version
- , tiledmapTiledversion :: String
+ , tiledmapTiledversion :: Maybe String
-- ^ The Tiled version used to save the file
, tiledmapWidth :: Int
-- ^ Number of tile columns