diff options
| -rw-r--r-- | lib/Properties.hs | 135 |
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 |