From 22ff0a5b31900bc761a25a10db7dcbb197f44e94 Mon Sep 17 00:00:00 2001
From: Sven G. Brönstrup
Date: Sun, 19 Dec 2021 17:13:50 +0100
Subject: Lint door stuff

---
 lib/Properties.hs | 88 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 87 insertions(+), 1 deletion(-)

diff --git a/lib/Properties.hs b/lib/Properties.hs
index a326e30..65f1822 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -175,6 +175,8 @@ checkTileset = do
       where checkTileProperty :: Property -> LintWriter Tileset
             checkTileProperty p@(Property name _) = case name of
               "collides" -> isBool p
+              -- named tiles are needed for scripting and do not hurt otherwise
+              "name" -> isString p
               _ -> warn $ "unknown tile property " <> prettyprint name
                         <> " in tile with global id "
                         <> showText (tileId tile)
@@ -225,7 +227,10 @@ checkLayer = do
 
 checkObjectProperty :: Object -> Property -> LintWriter Layer
 checkObjectProperty obj p@(Property name _) = case name of
-  "url" -> pure ()
+  "url" -> do
+    pure ()
+    unless (objectType obj == "website")
+      $ complain "\"url\" can only be set for objects of type \"website\""
   "allowApi" -> forbidProperty name
   "getBadge" -> do
     when (1 /= length (getProperties obj))
@@ -245,7 +250,59 @@ checkObjectProperty obj p@(Property name _) = case name of
               (Just w, Just h) | w /= 0 && h /= 0 ->
                  BadgeRect objectX objectY w h
               _ -> BadgePoint objectX objectY
+
+  -- | these properties are used by the extended script to allow doors
+  "door" -> do
+    isBool p
+    unless (objectType obj == "variable") $
+      complain "Door variables must be of type \"variable\""
+    when (null (objectName obj) || objectName obj == Just mempty) $
+      complain "Door variables objects must have a name given"
+
+  "default" -> do
+    isBool p
+    requireProperty "door"
+  "persist" -> do
+    isBool p
+    requireProperty "door"
+  "openLayer" -> do
+    isString p
+    requireProperty "door"
+  "closeLayer" -> do
+    isString p
+    requireProperty "door"
+  "openSound" -> do
+    isString p
+
+    unwrapURI (Proxy @"audio") p
+      (dependsOn . Link)
+      (dependsOn . Local)
+
+    unless (containsProperty obj "soundRadius")
+     $ suggest "set \"soundRadius\" to a limit the door sound to a certain area\"."
+
+    requireProperty "door"
+  "closeSound" -> do
+    isString p
+
+    unwrapURI (Proxy @"audio") p
+      (dependsOn . Link)
+      (dependsOn . Local)
+
+    requireProperty "door"
+  "soundRadius" -> do
+    isInt p
+
+    unless (containsProperty obj "soundRadius")
+     $ suggest "set \"soundRadius\" to a limit the door sound to a certain area\"."
+
+    requireProperty "door"
+
   _ -> warn $ "unknown object property " <> prettyprint name <> "."
+  where
+    requireProperty req = do
+      unless (containsProperty obj req) $
+        complain( "property " <> prettyprint req <> " is required by property " <> prettyprint name <> ".")
 
 
 -- | Checks a single (custom) property of an objectgroup layer
@@ -384,6 +441,31 @@ checkTileLayerProperty p@(Property name _value) = case name of
     --     False -> warn "property \"collides\" set to 'false' is useless."
     "getBadge" -> complain "\"getBadge\" must be set on an \"objectgroup\" \
                            \ layer; it does not work on tile layers."
+
+    -- | these properties are used by the extended script to allow doors
+    "zone" -> do
+      isString p
+      uselessEmptyLayer
+    "doorVariable" -> do
+      isString p
+      requireProperty "zone"
+    "autoOpen" -> do
+      isBool p
+      requireProperty "zone"
+    "autoClose" -> do
+      isBool p
+      requireProperty "zone"
+    "code" -> do
+      isString p
+      requireProperty "zone"
+    "openTriggerMessage" -> do
+      isString p
+      requireProperty "zone"
+    "closeTriggerMessage" -> do
+      isString p
+      requireProperty "zone"
+
+    -- name on tile layer unsupported
     "name" -> isUnsupported
     _ ->
         warn $ "unknown property type " <> prettyprint name
@@ -592,6 +674,10 @@ isString = flip unwrapString (const $ pure ())
 isBool :: Property -> LintWriter a
 isBool = flip unwrapBool (const $ pure ())
 
+-- | just asserts that this is a int
+isInt:: Property -> LintWriter a
+isInt = flip unwrapInt (const $ pure ())
+
 isIntInRange :: Int -> Int -> Property -> LintWriter b
 isIntInRange = isOrdInRange @Int unwrapInt
 
-- 
cgit v1.2.3