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