summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorstuebinm2021-09-20 01:56:15 +0200
committerstuebinm2021-09-20 01:58:21 +0200
commit5b8ed8ad906e92bce5b8576b29ae6f2cc46d8696 (patch)
treefd942bccad82ee72b9a81d8579da6f197790333c
parent968038c403e71b98a8f55a4d79e64beca8349ab3 (diff)
lint map things that aren't custom properties
-rw-r--r--lib/CheckMap.hs13
-rw-r--r--lib/Properties.hs35
2 files changed, 36 insertions, 12 deletions
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 08932b4..ffd94ec 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -17,12 +17,10 @@ import qualified Data.Vector as V
import GHC.Generics (Generic)
import LintWriter (LintResult (..), LintWriter,
- lintsToDeps, resultToLints,
- runLintWriter)
-import Properties (checkLayerProperty,
- checkMapProperty)
+ lintsToDeps, runLintWriter)
+import Properties (checkLayerProperty, checkMap)
import Tiled2 (Layer (layerName, layerProperties),
- Tiledmap (tiledmapLayers, tiledmapProperties),
+ Tiledmap (tiledmapLayers),
loadTiledmap)
import Types (Dep, Level (..), Lint (..), hint,
lintLevel)
@@ -57,7 +55,7 @@ loadAndLintMap path = loadTiledmap path >>= pure . \case
runLinter :: Tiledmap -> MapResult ()
runLinter tiledmap = MapResult
{ mapresultLayer = Just layerMap
- , mapresultGeneral = propertyLints -- no general lints for now
+ , mapresultGeneral = generalLints -- no general lints for now
, mapresultDepends = concatMap (lintsToDeps . snd) layer
}
where
@@ -67,8 +65,7 @@ runLinter tiledmap = MapResult
where runCheck l = (layerName l, LintResult $ runWriterT (checkLayer l))
-- lints collected from properties
- propertyLints = runLintWriter
- $ mapM_ (checkMapProperty tiledmap) (tiledmapProperties tiledmap)
+ generalLints = runLintWriter (checkMap tiledmap)
-- | collect lints on a single map layer
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 0805a4d..4dada7d 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -3,13 +3,13 @@
{-# LANGUAGE OverloadedStrings #-}
-- | Contains checks for custom properties of the map json
-module Properties (checkLayerProperty, checkMapProperty) where
+module Properties (checkLayerProperty, checkMap) where
import Control.Monad (unless, when)
import Data.Text (Text, isPrefixOf)
-import Tiled2 (Layer (layerProperties), Property (..),
- PropertyValue (..), Tiledmap)
+import Tiled2 (Layer (..), Property (..), PropertyValue (..),
+ Tiledmap (..))
import Util (layerIsEmpty, prettyprint)
import LintWriter (LintWriter, complain, dependsOn, forbid, info,
@@ -122,7 +122,34 @@ checkMapProperty map (Property name value) = case name of
-- | this property is forbidden and should not be used
isForbidden = forbid $ "property " <> prettyprint name <> " should not be used"
-
+-- | Checks an entire map for "general" lints.
+--
+-- Note that it does /not/ call checkMapProperty; this is handled
+-- seperately in CheckMap.hs, since these lints go into a different
+-- field of the resulting json.
+checkMap :: Tiledmap -> LintWriter ()
+checkMap tiledmap = do
+ -- check properties
+ mapM_ (checkMapProperty tiledmap) (tiledmapProperties tiledmap)
+ -- some layers should exist
+ hasLayerNamed "start" (const True)
+ "The map must have one layer named \"start\""
+ hasLayerNamed "floorLayer" ((==) "objectgroup" . layerType)
+ "The map must have one layer named \"floorLayer\" of type \"objectgroup\""
+ hasLayer (flip containsProperty "exitUrl" . layerProperties)
+ "The map must contain at least one layer with the property \"exitUrl\" set"
+
+ -- reject maps not suitable for workadventure
+ unless (tiledmapOrientation tiledmap == "orthogonal")
+ $ complain "The map's orientation must be set to \"orthogonal\""
+ unless (tiledmapTileheight tiledmap == 32 && tiledmapTilewidth tiledmap == 32)
+ $ complain "The map's tile size must be 32 by 32 pixels"
+ where
+ layers = tiledmapLayers tiledmap
+ hasLayerNamed name pred = hasLayer (\l -> layerName l == name && pred l)
+ hasLayer pred err =
+ unless (any pred layers)
+ $ complain err