summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/Properties.hs135
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