fixed parsing of tiled objects

(points behave slightly differntly than I thought)

3 files changed, 22 insertions, 31 deletions

diff --git a/lib/Properties.hs b/lib/Properties.hs
index c057b63..a326e30 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -211,7 +211,7 @@ checkLayer = do
       forM_ (getProperties layer) checkObjectGroupProperty
 
       unless (layerName layer == "floorLayer") $
-        when (null publicObjects || publicObjects == Just mempty) $
+        when (null (layerObjects layer) || layerObjects layer == Just mempty) $
           warn "objectgroup layer (which aren't the floorLayer) \
                \are useless if they are empty."
 
@@ -234,16 +234,17 @@ checkObjectProperty obj p@(Property name _) = case name of
     unwrapString p $ \str ->
       unwrapBadgeToken str $ \token -> do
         case obj of
-          ObjectPoint {..} ->
-            offersBadge (Badge token (BadgePoint objectX objectY))
-          ObjectRectangle {..} ->
-            if isJust objectEllipse
-            then offersBadge
-              $ Badge token (BadgeRect objectX objectY objectWidth objectHeight)
-            else complain "ellipses are not supported."
           ObjectPolygon {} -> complain "polygons are not supported."
           ObjectPolyline {} -> complain "polylines are not supported."
           ObjectText {} -> complain "cannot use texts to define badge areas."
+          ObjectRectangle {..} ->
+            if objectEllipse == Just True
+            then complain "ellipses are not supported."
+            else offersBadge
+            $ Badge token $ case (objectWidth, objectHeight) of
+              (Just w, Just h) | w /= 0 && h /= 0 ->
+                 BadgeRect objectX objectY w h
+              _ -> BadgePoint objectX objectY
   _ -> warn $ "unknown object property " <> prettyprint name <> "."
 
 
diff --git a/lib/Tiled.hs b/lib/Tiled.hs
index fa876ee..c5abb21 100644
--- a/lib/Tiled.hs
+++ b/lib/Tiled.hs
@@ -121,32 +121,19 @@ instance ToJSON Point where
 
 -- | all kinds of objects that can occur in object layers, even
 -- | those that we don't want to allow.
-data Object = ObjectPoint
+data Object = ObjectRectangle
   { objectId         :: Int
   , objectName       :: Maybe String
   , objectProperties :: Maybe (Vector Property)
   , objectVisible    :: Maybe Bool
   , objectX          :: Double
   , objectY          :: Double
-  , objectHeight     :: Double
-  , objectWidth      :: Double
   , objectRotation   :: Double
   , objectGid        :: Maybe GlobalId
-  , objectType       :: Text
-  , objectPoint      :: Bool
-  }
-  | ObjectRectangle
-  { objectId         :: Int
-  , objectName       :: Maybe String
-  , objectProperties :: Maybe (Vector Property)
-  , objectVisible    :: Maybe Bool
-  , objectX          :: Double
-  , objectY          :: Double
-  , objectRotation   :: Double
-  , objectGid        :: Maybe GlobalId
-  , objectWidth      :: Double
-  , objectHeight     :: Double
+  , objectWidth      :: Maybe Double
+  , objectHeight     :: Maybe Double
   , objectEllipse    :: Maybe Bool
+  , objectPoint      :: Maybe Bool
   , objectType       :: Text
   }
   | ObjectPolygon
@@ -158,8 +145,8 @@ data Object = ObjectPoint
   , objectY          :: Double
   , objectRotation   :: Double
   , objectGid        :: Maybe GlobalId
-  , objectWidth      :: Double
-  , objectHeight     :: Double
+  , objectWidth      :: Maybe Double
+  , objectHeight     :: Maybe Double
   , objectType       :: Text
   , objectPolygon    :: Vector Point
   }
@@ -172,9 +159,9 @@ data Object = ObjectPoint
   , objectY          :: Double
   , objectRotation   :: Double
   , objectGid        :: Maybe GlobalId
-  , objectWidth      :: Double
+  , objectWidth      :: Maybe Double
+  , objectHeight     :: Maybe Double
   , objectType       :: Text
-  , objectHeight     :: Double
   , objectPolyline   :: Vector Point
   }
   | ObjectText
@@ -187,8 +174,8 @@ data Object = ObjectPoint
   , objectRotation   :: Double
   , objectGid        :: Maybe GlobalId
   , objectText       :: A.Value
-  , objectWidth      :: Double
-  , objectHeight     :: Double
+  , objectWidth      :: Maybe Double
+  , objectHeight     :: Maybe Double
   , objectEllipse    :: Maybe Bool
   , objectType       :: Text
   } deriving (Eq, Generic, Show)
diff --git a/lib/Types.hs b/lib/Types.hs
index 978ada2..3ec9ebc 100644
--- a/lib/Types.hs
+++ b/lib/Types.hs
@@ -93,6 +93,9 @@ instance ToJSON Lint where
   toJSON (Offers l) = A.object
     [ "msg" .= prettyprint l
     , "level" .= A.String "Entrypoint Info" ]
+  toJSON (Badge _) = A.object
+    [ "msg" .= A.String "found a badge"
+    , "level" .= A.String "Badge Info"]
 
 instance ToJSON Hint where
   toJSON (Hint l m) = A.object