Better support for object properties

Can read multiple and different types.

1 files changed, 34 insertions, 15 deletions

diff --git a/src/Game/Map.hs b/src/Game/Map.hs
index 5faf0f4..31aa043 100644
--- a/src/Game/Map.hs
+++ b/src/Game/Map.hs
@@ -13,7 +13,9 @@ module Game.Map
   )
 where
 
+import Control.Applicative ((<|>))
 import Control.Monad
+import Data.List (find)
 import Data.Maybe (fromMaybe, mapMaybe)
 import Game.Entities.Types (Dir (..))
 import qualified Game.Utils as U
@@ -37,6 +39,10 @@ data Layer
       {name :: String, objects :: [Object]}
   deriving (Show)
 
+data PropertyValue = PropertyValueBool Bool | PropertyValueInt Int | PropertyValueString String
+
+data Property = Property String PropertyValue
+
 -- | The object types in the map.
 data Object
   = PlayerEntity Int Int
@@ -56,10 +62,17 @@ data JsonMapData = JsonMapData
   }
   deriving (Show)
 
-data ObjectBoolProperty = ObjectBoolProperty
-  { name :: String,
-    value :: Bool
-  }
+instance JSON Property where
+  showJSON = undefined
+  readJSON (JSObject obj) = do
+    Property
+      <$> valFromObj "name" obj
+      <*> case get_field obj "type" of
+        Just "bool" -> PropertyValueBool <$> valFromObj "value" obj
+        Just "int" -> PropertyValueInt <$> valFromObj "value" obj
+        Just "string" -> PropertyValueString <$> valFromObj "value" obj
+        _ -> Error "unsupported property value type"
+  readJSON _ = mzero
 
 instance JSON Tileset where
   showJSON = undefined
@@ -82,12 +95,18 @@ instance JSON Layer where
       _ -> Error "unsupported layer type"
   readJSON _ = mzero
 
-getObjectPropertyDir :: JSObject JSValue -> Result Dir
-getObjectPropertyDir obj = case get_field obj "properties" of
-  Just (JSArray [JSObject prop]) -> do
-    p <- ObjectBoolProperty <$> valFromObj "name" prop <*> valFromObj "value" prop
-    pure $ if p.name == "flip" && p.value then DirLeft else DirRight
-  _ -> pure DirRight
+-- Gets the "flip" custom property; if present and set, the entity will face left.
+-- Only takes into account the first "flip" property found.
+getPropertyDir :: JSObject JSValue -> Result Dir
+getPropertyDir obj = do
+  props <- valFromObj "properties" obj <|> pure []
+  pure $ case find flipProp props of
+    Just _ -> DirLeft
+    Nothing -> DirRight
+  where
+    flipProp :: Property -> Bool
+    flipProp (Property "flip" (PropertyValueBool True)) = True
+    flipProp _ = False
 
 instance JSON Object where
   showJSON = undefined
@@ -98,15 +117,15 @@ instance JSON Object where
       Just "Battery" ->
         BatteryEntity <$> valFromObj "x" obj <*> valFromObj "y" obj
       Just "Slime" ->
-        SlimeEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> getObjectPropertyDir obj
+        SlimeEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> getPropertyDir obj
       Just "Robot" ->
-        RobotEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> getObjectPropertyDir obj
+        RobotEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> getPropertyDir obj
       Just "Shooter" ->
-        ShooterEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> getObjectPropertyDir obj
+        ShooterEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> getPropertyDir obj
       Just "Runner" ->
-        RunnerEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> getObjectPropertyDir obj
+        RunnerEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> getPropertyDir obj
       Just "Tracker" ->
-        TrackerEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> getObjectPropertyDir obj
+        TrackerEntity <$> valFromObj "x" obj <*> valFromObj "y" obj <*> getPropertyDir obj
       Just (JSString (JSONString s)) -> Error $ "unsupported entity " ++ show s
       e -> Error $ "unsupported entity in " ++ show e
   readJSON _ = mzero