From c74a9c7fcb6a9f03351f6ff35ea035d1e03f63a4 Mon Sep 17 00:00:00 2001 From: stuebinm Date: Wed, 17 Nov 2021 02:59:34 +0100 Subject: make map parser work with more maps I found yet more properties that weren't really documented or weren't marked as optional, hurray! --- lib/Properties.hs | 16 ++++++++++++++-- lib/Tiled2.hs | 30 +++++++++++++++++++++++++----- 2 files changed, 39 insertions(+), 7 deletions(-) (limited to 'lib') diff --git a/lib/Properties.hs b/lib/Properties.hs index 2ef587c..bdb7911 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -3,7 +3,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} --- | Contains checks for custom properties of the map json +-- | Contains checks for custom ties of the map json module Properties (checkMap, checkTileset, checkLayer) where @@ -15,7 +15,7 @@ import Tiled2 (HasProperties (adjustProperties, getProperties), Tiledmap (..), Tileset (..)) import Util (layerIsEmpty, prettyprint) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isJust) import LintConfig (LintConfig (..)) import LintWriter (LintWriter, adjust, askContext, askFileDepth, complain, dependsOn, forbid, lintConfig, @@ -97,6 +97,8 @@ checkTileset = do unless (tilesetImageheight tileset < 4096 && tilesetImagewidth tileset < 4096) $ warn "Tilesets should not be larger than 4096×4096 pixels in total" + when (isJust (tilesetSource tileset)) + $ complain "Tilesets must be embedded and cannot be loaded from external files." -- TODO: check copyright! requireProperty "copyright" mapM_ checkTilesetProperty (fromMaybe [] $ tilesetProperties tileset) @@ -111,8 +113,16 @@ checkTilesetProperty (Property name _value) = case name of checkLayer :: LintWriter Layer checkLayer = do layer <- askContext + when (isJust (layerImage layer)) + $ complain "imagelayer are not supported." + unless (layerType layer == "tilelayer") + $ complain "only tilelayer are supported." mapM_ checkLayerProperty (getProperties layer) + case layerLayers layer of + Nothing -> pure () + Just layers -> error "walint doesn't support grouplayers for now" + -- | Checks a single (custom) property of a layer @@ -147,6 +157,8 @@ checkLayerProperty p@(Property name _value) = case name of "audioLoop" -> do isBool p requireProperty "playAudio" + "playAudioLoop" -> + warn "'playAudioLoop' is deprecated; please use 'audioLoop' instead." "audioVolume" -> do isBool p requireProperty "playAudio" 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 -- cgit v1.2.3