diff options
| -rw-r--r-- | lib/Properties.hs | 88 |
1 files changed, 87 insertions, 1 deletions
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 |