From 858cdc8e4b8cfae8a4df88de63a02641a227cc70 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Fri, 19 Nov 2021 00:18:27 +0100
Subject: deal with group layers
I have no idea why these even exist, but apparently they do, so here's
some code to deal with them in a hopefully useful manner …
---
lib/CheckMap.hs | 41 +++++++++++++++++++++++++++++++++++++----
lib/Properties.hs | 5 -----
2 files changed, 37 insertions(+), 9 deletions(-)
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 962da22..5b486aa 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -22,11 +22,14 @@ import GHC.Generics (Generic)
import LintConfig (LintConfig')
-import LintWriter (filterLintLevel, invertLintResult, lintToDep,
+import LintWriter (LintResult (..), filterLintLevel,
+ invertLintResult, lintToDep,
resultToAdjusted, resultToDeps,
resultToLints, resultToOffers, runLintWriter)
import Properties (checkLayer, checkMap, checkTileset)
-import Tiled2 (HasName (getName), Layer, LoadResult (..),
+import Tiled2 (HasName (getName),
+ Layer (layerLayers, layerName),
+ LoadResult (..),
Tiledmap (tiledmapLayers, tiledmapTilesets),
Tileset, loadTiledmap)
import Types (Dep, Hint (hintLevel, hintMsg), Level (..),
@@ -95,23 +98,53 @@ runLinter config tiledmap depth = MapResult
, mapresultAdjusted = Just adjustedMap
}
where
- layer = checkThing tiledmapLayers checkLayer
+ layer = checkLayerRec config depth (V.toList $ tiledmapLayers tiledmap)
tileset = checkThing tiledmapTilesets checkTileset
generalResult = runLintWriter config tiledmap depth checkMap
checkThing getter checker = V.toList . V.map runCheck $ getter tiledmap
where runCheck thing = runLintWriter config thing depth checker
+
-- | "inverts" a LintResult, i.e. groups it by lints instead of
-- layers / maps
invertThing thing = M.unionsWith (<>) $ fmap invertLintResult thing
adjustedMap = (resultToAdjusted generalResult)
- { tiledmapLayers = V.fromList . fmap resultToAdjusted $ layer
+ { tiledmapLayers = V.fromList $ fmap resultToAdjusted layer
, tiledmapTilesets = V.fromList . fmap resultToAdjusted $ tileset
}
+-- | Recursively checks a layer.
+--
+-- This is apparently necessary because someone thought it would be a good
+-- idea to have group layers, even if their entire semantics appear to be
+-- "they're group layers"; they don't seem to /do/ anything …
+checkLayerRec :: LintConfig' -> Int -> [Layer] -> [LintResult Layer]
+checkLayerRec config depth = concatMap $ \parent ->
+ case layerLayers parent of
+ Nothing ->
+ [runLintWriter config parent depth checkLayer]
+ Just sublayers ->
+ let
+ -- before linting, append the group's top-level name to that of sublayers
+ results = checkLayerRec config depth $ sublayers
+ <&> \l -> l { layerName = layerName parent <> "/" <> layerName l }
+ -- get the original sublayer names
+ names = fmap layerName sublayers
+ -- pass the adjusted sublayers on to linting the parent layer,
+ -- but restore the actual names of sublayers
+ result = runLintWriter config
+ (parent { layerLayers = Just
+ $ zipWith (\n l -> (resultToAdjusted l) { layerName = n })
+ names results
+ }
+ ) depth checkLayer
+ in result:results
+
+
+
-- human-readable lint output, e.g. for consoles
instance PrettyPrint (Level, MapResult) where
prettyprint (level, mapResult) = if complete == ""
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 2928152..9f995b0 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -121,11 +121,6 @@ checkLayer = do
ty -> unless (layerName layer == "floorLayer" && ty == "objectgroup")
$ complain "only tilelayer are supported."
- case layerLayers layer of
- Nothing -> pure ()
- Just _ -> complain "walint doesn't support grouplayers for now"
-
-
-- | Checks a single (custom) property of a layer
--
--
cgit v1.2.3