summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorstuebinm2021-11-14 21:26:46 +0100
committerstuebinm2021-11-14 21:26:46 +0100
commit8fc10996e17ba164dc8e29d77efd03113a1f63f0 (patch)
tree7dc755cc80981388f82b96e11b0555177a26bde0
parentbb5277dc5b492e0e27777f7eb42c54b45c66835a (diff)
config options: implement script-related options
-rw-r--r--lib/LintConfig.hs2
-rw-r--r--lib/Properties.hs15
-rw-r--r--lib/Tiled2.hs5
3 files changed, 20 insertions, 2 deletions
diff --git a/lib/LintConfig.hs b/lib/LintConfig.hs
index 28559bd..5596005 100644
--- a/lib/LintConfig.hs
+++ b/lib/LintConfig.hs
@@ -38,6 +38,8 @@ data LintConfig f = LintConfig
-- ^ Maximum warn level allowed before the lint fails
, configDontCopyAssets :: HKD f Bool
-- ^ Don't copy map assets (mostly useful for development)
+ , configAllowScripts :: HKD f Bool
+ -- ^ Allow defining custom scripts in maps
} deriving (Generic)
type LintConfig' = LintConfig Identity
diff --git a/lib/Properties.hs b/lib/Properties.hs
index e6a3384..50fec53 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -15,7 +15,7 @@ import Tiled2 (HasProperties (adjustProperties, getProperties),
import Util (layerIsEmpty, prettyprint)
import Data.Maybe (fromMaybe)
-import LintConfig (LintConfig (configAssemblyTag))
+import LintConfig (LintConfig (..))
import LintWriter (LintWriter, adjust, askContext, askFileDepth,
complain, dependsOn, forbid, lintConfig,
offersEntrypoint, suggest, warn)
@@ -62,7 +62,18 @@ checkMap = do
-- longer function same as checkLayerProperty.
checkMapProperty :: Property -> LintWriter Tiledmap
checkMapProperty (Property name _value) = case name of
- "script" -> isForbidden
+ "script" -> do
+ -- this is kind of stupid, since if we also inject script this
+ -- will be overriden anyways, but it also doesn't really hurt I guess
+ -- TODO: perhaps include an explanation in the lint, or allow
+ -- exactly that one value?
+ lintConfig configAllowScripts >>= \case
+ False -> isForbidden
+ True -> pure ()
+ lintConfig configScriptInject >>= \case
+ Nothing -> pure ()
+ Just url -> setProperty "script" url
+
_ -> complain $ "unknown map property " <> prettyprint name
where
-- | this property is forbidden and should not be used
diff --git a/lib/Tiled2.hs b/lib/Tiled2.hs
index 873e22d..5b37f20 100644
--- a/lib/Tiled2.hs
+++ b/lib/Tiled2.hs
@@ -332,6 +332,11 @@ instance HasProperties Tileset where
adjustProperties f tileset = tileset
{ tilesetProperties = f (getProperties tileset) }
+instance HasProperties Tiledmap where
+ getProperties = fromMaybe [] . tiledmapProperties
+ adjustProperties f tiledmap = tiledmap
+ { tiledmapProperties = f (getProperties tiledmap) }
+
class HasName a where
getName :: a -> Text
instance HasName Layer where