diff options
author | stuebinm | 2021-12-14 20:11:13 +0100 |
---|---|---|
committer | stuebinm | 2021-12-14 20:11:13 +0100 |
commit | 417087b147e193a92b21afa2932c367c42aab25b (patch) | |
tree | 6894d868b26e536f90024572b6da4fa9b72b2bde /lib | |
parent | 515dae1ccc3f2e6cfffa5b953fdde13f7eb196a9 (diff) |
deal with group layer in existence checks properly
(before it would fail to find e.g. the start layer if it wasn't a
top-level layer)
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Properties.hs | 31 |
1 files changed, 20 insertions, 11 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs index b27cce1..c1ade06 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -50,19 +50,20 @@ import Uris (SubstError (..), applySubst) checkMap :: LintWriter Tiledmap checkMap = do tiledmap <- askContext - let unlessLayer = unlessElement (tiledmapLayers tiledmap) + let layers = collectLayers tiledmap + let unlessLayer = unlessElement layers -- test custom map properties mapM_ checkMapProperty (fromMaybe mempty $ tiledmapProperties tiledmap) -- can't have these with the rest of layer/tileset lints since they're -- not specific to any one of them - refuseDoubledNames (tiledmapLayers tiledmap) + refuseDoubledNames layers refuseDoubledNames (tiledmapTilesets tiledmap) refuseDoubledNames (getProperties tiledmap) -- some layers should exist - unlessElementNamed (tiledmapLayers tiledmap) "start" + unlessElementNamed layers "start" $ complain "The map must have one layer named \"start\"." unlessLayer (\l -> getName l == "floorLayer" && layerType l == "objectgroup") $ complain "The map must have one layer named \"floorLayer\" of type \"objectgroup\"." @@ -79,9 +80,17 @@ checkMap = do $ suggest "document the map's copyright via the \"mapCopyright\" property." -- TODO: this doesn't catch collisions with the default start layer! - whenLayerCollisions (\(Property name _) -> name == "exitUrl" || name == "startLayer") + whenLayerCollisions layers (\(Property name _) -> name == "exitUrl" || name == "startLayer") $ \cols -> warn $ "collisions between entry and / or exit layers: " <> prettyprint cols + where + -- recursively find all layers (to deal with nested group layers) + collectLayers :: Tiledmap -> V.Vector Layer + collectLayers tiledmap = tiledmapLayers tiledmap <> + V.fromList (concatMap groupmembers (tiledmapLayers tiledmap)) + where groupmembers :: Layer -> [Layer] + groupmembers layer = concatMap groupmembers layers <> layers + where layers = fromMaybe [] $ layerLayers layer -- | Checks a single property of a map. checkMapProperty :: Property -> LintWriter Tiledmap @@ -122,7 +131,7 @@ checkTileset = do when (isJust (tilesetSource tileset)) $ complain "Tilesets must be embedded and cannot be loaded from external files." - -- TODO: check copyright! + unlessHasProperty "tilesetCopyright" $ forbid "property \"tilesetCopyright\" for tilesets must be set." @@ -423,12 +432,12 @@ containsProperty props name = any -- | should the layers fulfilling the given predicate collide, then perform andthen. whenLayerCollisions - :: (Property -> Bool) - -> (Set Collision -> LintWriter Tiledmap) - -> LintWriter Tiledmap -whenLayerCollisions f andthen = do - tiledmap <- askContext - let collisions = layerOverlaps . V.filter (any f . getProperties) $ tiledmapLayers tiledmap + :: V.Vector Layer + -> (Property -> Bool) + -> (Set Collision -> LintWriter a) + -> LintWriter a +whenLayerCollisions layers f andthen = do + let collisions = layerOverlaps . V.filter (any f . getProperties) $ layers unless (null collisions) $ andthen collisions |