Skip to content
Snippets Groups Projects
Commit 22ff0a5b authored by Sven G. Brönstrup's avatar Sven G. Brönstrup
Browse files

Lint door stuff

parent fc9f714d
Branches
No related tags found
1 merge request!1Extended scripts support
Pipeline #10144 passed
...@@ -175,6 +175,8 @@ checkTileset = do ...@@ -175,6 +175,8 @@ checkTileset = do
where checkTileProperty :: Property -> LintWriter Tileset where checkTileProperty :: Property -> LintWriter Tileset
checkTileProperty p@(Property name _) = case name of checkTileProperty p@(Property name _) = case name of
"collides" -> isBool p "collides" -> isBool p
-- named tiles are needed for scripting and do not hurt otherwise
"name" -> isString p
_ -> warn $ "unknown tile property " <> prettyprint name _ -> warn $ "unknown tile property " <> prettyprint name
<> " in tile with global id " <> " in tile with global id "
<> showText (tileId tile) <> showText (tileId tile)
...@@ -225,7 +227,10 @@ checkLayer = do ...@@ -225,7 +227,10 @@ checkLayer = do
checkObjectProperty :: Object -> Property -> LintWriter Layer checkObjectProperty :: Object -> Property -> LintWriter Layer
checkObjectProperty obj p@(Property name _) = case name of 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 "allowApi" -> forbidProperty name
"getBadge" -> do "getBadge" -> do
when (1 /= length (getProperties obj)) when (1 /= length (getProperties obj))
...@@ -245,7 +250,59 @@ checkObjectProperty obj p@(Property name _) = case name of ...@@ -245,7 +250,59 @@ checkObjectProperty obj p@(Property name _) = case name of
(Just w, Just h) | w /= 0 && h /= 0 -> (Just w, Just h) | w /= 0 && h /= 0 ->
BadgeRect objectX objectY w h BadgeRect objectX objectY w h
_ -> BadgePoint objectX objectY _ -> 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 <> "." _ -> 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 -- | Checks a single (custom) property of an objectgroup layer
...@@ -384,6 +441,31 @@ checkTileLayerProperty p@(Property name _value) = case name of ...@@ -384,6 +441,31 @@ checkTileLayerProperty p@(Property name _value) = case name of
-- False -> warn "property \"collides\" set to 'false' is useless." -- False -> warn "property \"collides\" set to 'false' is useless."
"getBadge" -> complain "\"getBadge\" must be set on an \"objectgroup\" \ "getBadge" -> complain "\"getBadge\" must be set on an \"objectgroup\" \
\ layer; it does not work on tile layers." \ 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 "name" -> isUnsupported
_ -> _ ->
warn $ "unknown property type " <> prettyprint name warn $ "unknown property type " <> prettyprint name
...@@ -592,6 +674,10 @@ isString = flip unwrapString (const $ pure ()) ...@@ -592,6 +674,10 @@ isString = flip unwrapString (const $ pure ())
isBool :: Property -> LintWriter a isBool :: Property -> LintWriter a
isBool = flip unwrapBool (const $ pure ()) 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 :: Int -> Int -> Property -> LintWriter b
isIntInRange = isOrdInRange @Int unwrapInt isIntInRange = isOrdInRange @Int unwrapInt
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment