Skip to content
Snippets Groups Projects
Commit 417087b1 authored by stuebinm's avatar stuebinm
Browse files

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)
parent 515dae1c
Branches
No related tags found
No related merge requests found
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment