diff options
| -rw-r--r-- | lib/Properties.hs | 23 | ||||
| -rw-r--r-- | lib/Tiled.hs | 36 |
2 files changed, 43 insertions, 16 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs index db4908e..592aac4 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -297,7 +297,7 @@ checkTileLayerProperty p@(Property name _value) = case name of "playAudioLoop" -> deprecatedUseInstead "audioLoop" "audioVolume" -> do - isBool p + isOrdInRange unwrapFloat 0 1 p requireProperty "playAudio" "openWebsite" -> do uselessEmptyLayer @@ -502,6 +502,12 @@ unwrapInt (Property name value) f = case value of _ -> complain $ "type error: property " <> prettyprint name <> " should be of type int." +unwrapFloat :: Property -> (Float -> LintWriter a) -> LintWriter a +unwrapFloat (Property name value) f = case value of + FloatProp float -> f float + _ -> complain $ "type error: property " <> prettyprint name + <> " should be of type float." + unwrapPath :: Text -> (RelPath -> LintWriter a) -> LintWriter a unwrapPath str f = case parsePath str of OkRelPath p@(Path up _ _) -> do @@ -548,7 +554,16 @@ isString = flip unwrapString (const $ pure ()) isBool :: Property -> LintWriter a isBool = flip unwrapBool (const $ pure ()) -isIntInRange :: Int -> Int -> Property -> LintWriter a -isIntInRange l r p@(Property name _) = unwrapInt p $ \int -> +isIntInRange :: Int -> Int -> Property -> LintWriter b +isIntInRange = isOrdInRange @Int unwrapInt + +isOrdInRange :: (Ord a, Show a) + => (Property -> (a -> LintWriter b) -> LintWriter b) + -> a + -> a + -> Property + -> LintWriter b +isOrdInRange unwrapa l r p@(Property name _) = unwrapa p $ \int -> if l < int && int < r then pure () - else complain $ "Property " <> prettyprint name <> " should be between" <> showText l <> " and " <> showText r<>"." + else complain $ "Property " <> prettyprint name <> " should be between " + <> showText l <> " and " <> showText r<>"." diff --git a/lib/Tiled.hs b/lib/Tiled.hs index f1d7ec6..a092b67 100644 --- a/lib/Tiled.hs +++ b/lib/Tiled.hs @@ -62,7 +62,7 @@ data Property = Property Text PropertyValue -- | The value of a custom tiled property. -- It is strongly typed via a tag in the json representation, -- and needs a custom ToJSON and FromJSON instance because of that. -data PropertyValue = StrProp Text | BoolProp Bool | IntProp Int +data PropertyValue = StrProp Text | BoolProp Bool | IntProp Int | FloatProp Float deriving (Eq, Generic, Show) instance IsString PropertyValue where @@ -81,22 +81,34 @@ instance FromJSON Property where A.String "int" -> do val <- o .: "value" pure $ Property name (IntProp val) + A.String "float" -> do + val <- o .: "value" + pure $ Property name (FloatProp val) ty -> fail $ "properties can only have types string, int, bool, but encountered type" <> show ty parseJSON invalid = typeMismatch "Property" invalid instance ToJSON Property where toJSON (Property name val) = case val of - StrProp str -> object [ "type" .= A.String "string" - , "name" .= name - , "value" .= str - ] - BoolProp bool -> object [ "type" .= A.String "bool" - , "name" .= name - , "value" .= bool - ] - IntProp int -> object [ "type" .= A.String "int" - , "name" .= name - , "value" .= int] + StrProp str -> object + [ "type" .= A.String "string" + , "name" .= name + , "value" .= str + ] + BoolProp bool -> object + [ "type" .= A.String "bool" + , "name" .= name + , "value" .= bool + ] + IntProp int -> object + [ "type" .= A.String "int" + , "name" .= name + , "value" .= int + ] + FloatProp float -> object + [ "type" .= A.String "float" + , "name" .= name + , "value" .= float + ] data Point = Point { pointX :: Double , pointY :: Double |