From a4476a3e6d44e8e2ae054a8aec68836b2e813c60 Mon Sep 17 00:00:00 2001
From: stuebinm <stuebinm@disroot.org>
Date: Mon, 20 Sep 2021 02:17:13 +0200
Subject: [PATCH] lint embedded tilesets
---
lib/CheckMap.hs | 6 ++++--
lib/LintWriter.hs | 7 ++-----
lib/Properties.hs | 15 +++++++++++++--
lib/Tiled2.hs | 4 ++--
4 files changed, 21 insertions(+), 11 deletions(-)
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index ffd94ec..0de9094 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -17,7 +17,8 @@ import qualified Data.Vector as V
import GHC.Generics (Generic)
import LintWriter (LintResult (..), LintWriter,
- lintsToDeps, runLintWriter)
+ lintResultToDeps, lintToDep,
+ runLintWriter)
import Properties (checkLayerProperty, checkMap)
import Tiled2 (Layer (layerName, layerProperties),
Tiledmap (tiledmapLayers),
@@ -56,7 +57,8 @@ runLinter :: Tiledmap -> MapResult ()
runLinter tiledmap = MapResult
{ mapresultLayer = Just layerMap
, mapresultGeneral = generalLints -- no general lints for now
- , mapresultDepends = concatMap (lintsToDeps . snd) layer
+ , mapresultDepends = concatMap (lintResultToDeps . snd) layer
+ <> mapMaybe lintToDep generalLints
}
where
layerMap :: Map Text (LintResult ())
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index 02815e3..120a0f5 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -40,8 +40,8 @@ lintToDep = \case
Depends dep -> Just dep
_ -> Nothing
-lintsToDeps :: LintResult a -> [Dep]
-lintsToDeps (LintResult a) = case a of
+lintResultToDeps :: LintResult a -> [Dep]
+lintResultToDeps (LintResult a) = case a of
Left (Depends dep) -> [dep]
Left _ -> []
Right (_, lints) -> mapMaybe lintToDep lints
@@ -70,9 +70,6 @@ forbid = lint Forbidden
suggest = lint Suggestion
complain = lint Error
-dependsLocal = dependsOn . Local
-dependsLink = dependsOn . Link
-dependsMapService = dependsOn . MapLink
-- TODO: all these functions should probably also just operate on LintWriter
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 4dada7d..395bc87 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -9,7 +9,7 @@ module Properties (checkLayerProperty, checkMap) where
import Control.Monad (unless, when)
import Data.Text (Text, isPrefixOf)
import Tiled2 (Layer (..), Property (..), PropertyValue (..),
- Tiledmap (..))
+ Tiledmap (..), Tileset (..))
import Util (layerIsEmpty, prettyprint)
import LintWriter (LintWriter, complain, dependsOn, forbid, info,
@@ -131,6 +131,7 @@ checkMap :: Tiledmap -> LintWriter ()
checkMap tiledmap = do
-- check properties
mapM_ (checkMapProperty tiledmap) (tiledmapProperties tiledmap)
+ mapM_ checkTileset (tiledmapTilesets tiledmap)
-- some layers should exist
hasLayerNamed "start" (const True)
"The map must have one layer named \"start\""
@@ -151,7 +152,17 @@ checkMap tiledmap = do
unless (any pred layers)
$ complain err
-
+-- | check an embedded tile set.
+--
+-- Important to collect dependency files
+checkTileset :: Tileset -> LintWriter ()
+checkTileset tileset = do
+ -- TODO: can tilesets be non-local dependencies?
+ dependsOn $ Local (tilesetImage tileset)
+
+ -- reject tilesets unsuitable for workadventure
+ unless (tilesetTilewidth tileset == 32 && tilesetTileheight tileset == 32)
+ $ complain $ "Tileset " <> tilesetName tileset <> " must have tile size 32 by 32"
-- | does this layer have the given property?
containsProperty :: [Property] -> Text -> Bool
diff --git a/lib/Tiled2.hs b/lib/Tiled2.hs
index 79033f0..f1cca2e 100644
--- a/lib/Tiled2.hs
+++ b/lib/Tiled2.hs
@@ -293,9 +293,9 @@ instance ToJSON Tile where
data Tileset = Tileset { tilesetFirstgid :: GlobalId
-- ^ GID corresponding to the first tile in the set
- , tilesetImage :: String
+ , tilesetImage :: Text
-- ^ Image used for tiles in this set
- , tilesetName :: String
+ , tilesetName :: Text
-- ^ Name given to this tileset
, tilesetTilewidth :: Int
-- ^ Maximum width of tiles in this set
--
GitLab