summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorstuebinm2021-12-14 20:11:13 +0100
committerstuebinm2021-12-14 20:11:13 +0100
commit417087b147e193a92b21afa2932c367c42aab25b (patch)
tree6894d868b26e536f90024572b6da4fa9b72b2bde
parent515dae1ccc3f2e6cfffa5b953fdde13f7eb196a9 (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)
-rw-r--r--lib/Properties.hs31
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