1 files changed, 134 insertions, 1 deletions

diff --git a/lib/Properties.hs b/lib/Properties.hs
index 05020f5..970424a 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)
@@ -228,6 +230,13 @@ checkObjectProperty obj p@(Property name _) = case name of
   "url" -> unwrapURI (Proxy @"website") p
     (dependsOn . Link)
     (const $ forbid "using \"url\" to open local html files is disallowed.")
+  "url" -> do
+    pure ()
+    unwrapURI (Proxy @"website") p
+      (dependsOn . Link)
+      (dependsOn . Local)
+    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))
@@ -247,9 +256,80 @@ checkObjectProperty obj p@(Property name _) = case name of
               (Just w, Just h) | w /= 0 && h /= 0 ->
                  BadgeRect objectX objectY w h
               _ -> BadgePoint objectX objectY
-  _ -> warn $ "unknown object property " <> prettyprint name <> "."
+
+  -- | 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
+    suggestProperty "door"
+  "persist" -> do
+    isBool p
+    suggestProperty "door"
+  "openLayer" -> do
+    isString p
+    suggestProperty "door"
+  "closeLayer" -> do
+    isString p
+    suggestProperty "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\"."
+
+    suggestProperty "door"
+  "closeSound" -> do
+    isString p
+
+    unwrapURI (Proxy @"audio") p
+      (dependsOn . Link)
+      (dependsOn . Local)
+
+    unless (containsProperty obj "soundRadius") $
+      -- Do not suggest again if already suggested for openSound
+      unless (containsProperty obj "openSound") $
+        suggest "set \"soundRadius\" to a limit the door sound to a certain area\"."
+
+    suggestProperty "door"
+
+  -- | these properties are used by the extended script to allow doors
+  "bell" -> do
+    isBool p
+    unless (objectType obj == "variable") $
+      complain "Bell variables must be of type \"variable\""
+    when (null (objectName obj) || objectName obj == Just mempty) $
+      complain "Bell variables objects must have a name given"
+  "bellSound" -> do
+    isString p
+
+    unwrapURI (Proxy @"audio") p
+      (dependsOn . Link)
+      (dependsOn . Local)
+
+    suggestProperty "bell"
+
+  -- | Applies to doors and bells as well
+  "soundRadius" -> do
+    isInt p
+    -- requireAnyProperty "door" "bell"
 
 
+  _ -> warn $ "unknown object property " <> prettyprint name <> "."
+  where
+    suggestProperty req = do
+      unless (containsProperty obj req) $
+        suggest( "property " <> prettyprint req <> " is suggested for property " <> prettyprint name <> ".")
+
 -- | Checks a single (custom) property of an objectgroup layer
 checkObjectGroupProperty :: Property -> LintWriter Layer
 checkObjectGroupProperty (Property name _) =
@@ -386,6 +466,55 @@ 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 "doorVariable"
+    "autoClose" -> do
+      isBool p
+      requireProperty "doorVariable"
+    "code" -> do
+      isString p
+      requireProperty "doorVariable"
+    "openTriggerMessage" -> do
+      isString p
+      requireProperty "doorVariable"
+    "closeTriggerMessage" -> do
+      isString p
+      requireProperty "doorVariable"
+
+    -- | these properties are used by the extended script to allow bells
+
+    "bellVariable" -> do
+      isString p
+      requireProperty "zone"
+    "bellButtonText" -> do
+      isString p
+      requireProperty "bellVariable"
+    "bellPopup" -> do
+      isString p
+      requireProperty "bellVariable"
+
+    -- | these properties are used by the extended script to allow action zones¶
+    "bindVariable" -> do
+      isString p
+      requireProperty "zone"
+    "enterValue" -> do
+      isString p
+      requireProperty "bindVariable"
+    "leaveValue" -> do
+      isString p
+      requireProperty "bindVariable"
+
+
+    -- name on tile layer unsupported
     "name" -> isUnsupported
     _ ->
         warn $ "unknown property type " <> prettyprint name
@@ -596,6 +725,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