make map parser work with more maps

I found yet more properties that weren't really documented or weren't
marked as optional, hurray!

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