From a4476a3e6d44e8e2ae054a8aec68836b2e813c60 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 20 Sep 2021 02:17:13 +0200
Subject: 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(-)

(limited to 'lib')

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
-- 
cgit v1.2.3