summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorstuebinm2021-11-17 02:59:34 +0100
committerstuebinm2021-11-17 02:59:34 +0100
commitc74a9c7fcb6a9f03351f6ff35ea035d1e03f63a4 (patch)
tree6a83d87cb133c8ebb89ec34f56da40726dbf61f2
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!
-rw-r--r--lib/Properties.hs16
-rw-r--r--lib/Tiled2.hs30
2 files changed, 39 insertions, 7 deletions
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