diff options
Diffstat (limited to 'lib/Properties.hs')
| -rw-r--r-- | lib/Properties.hs | 37 |
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" |