summaryrefslogtreecommitdiff
path: root/lib/Properties.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Properties.hs')
-rw-r--r--lib/Properties.hs37
1 files changed, 21 insertions, 16 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs
index c9c704a..ba78fca 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -24,6 +24,7 @@ import Badges (Badge (Badge),
BadgeArea (BadgePoint, BadgeRect), BadgeToken,
parseToken)
import Data.Data (Proxy (Proxy))
+import Data.Functor ((<&>))
import Data.Maybe (fromMaybe, isJust)
import Data.Set (Set)
import qualified Data.Set as S
@@ -164,27 +165,30 @@ checkLayer = do
"tilelayer" -> mapM_ checkTileLayerProperty (getProperties layer)
"group" -> pure ()
"objectgroup" -> do
- -- TODO: this still retains object group layers, just empties them out.
- -- perhaps actually delete the entire layer, since this still leaves hints
- -- as to where badges are?
- adjust $ \l -> l { layerObjects = Nothing, layerProperties = Nothing }
- unless (layerName layer == "floorLayer") $ do
+ -- all objects which can't define badges, i.e. only texts
+ publicObjects <- askContext <&>
+ fmap (V.filter (\case {ObjectText {} -> True; _ -> False})) . layerObjects
- -- TODO: these two checks can probably be unified
- unlessHasProperty "getBadge"
- $ warn "objectgrouop layer (which aren't the floor layer)\
- \are useless if not used to define badges."
+ -- filter everything out that might define badges, but keep text
+ -- objects, which workadventure apparently supports but doesn't
+ -- really tell anyone about.
+ adjust $ \l -> l { layerObjects = publicObjects
+ , layerProperties = Nothing }
- when (null (layerObjects layer) || layerObjects layer == Just mempty)
- $ warn "empty objectgroup layers (which aren't the floor\
- \layer) are useless."
+ unless (layerName layer == "floorLayer") $
+ unlessHasProperty "getBadge" $
+ when (null publicObjects || publicObjects == Just mempty) $
+ warn "objectgroup layer (which aren't the floor layer) \
+ \are useless if they do not contain the \"getBadge\" \
+ \property and define at least one area for this badge, \
+ \or do not contain at least one text element."
-- individual objects can't have properties
forM_ (fromMaybe mempty (layerObjects layer)) $ \object ->
unless (null (objectProperties object))
- $ warn "Properties cannot be set on individual objects. For setting\
- \badge tokens, use per-layer properties instead."
+ $ warn "Properties cannot be set on individual objects. For \
+ \setting badge tokens, use per-layer properties instead."
forM_ (getProperties layer) checkObjectGroupProperty
ty -> complain $ "unsupported layer type " <> prettyprint ty <> "."
@@ -213,8 +217,9 @@ checkObjectGroupProperty p@(Property name _) = case name of
objectX objectY
objectWidth objectHeight
(objectEllipse == Just True)
- ObjectPolygon {} -> complain "cannot use polygons for badges."
- ObjectPolyline {} -> complain "cannot use polylines for badges."
+ ObjectPolygon {} -> complain "polygons are not supported."
+ ObjectPolyline {} -> complain "polylines are not supported."
+ ObjectText {} -> complain "cannot use texts to define badge areas."
_ -> warn $ "unknown property " <> prettyprint name <> " for objectgroup layers"