Skip to content
Snippets Groups Projects
Select Git revision
  • d2078f17fe1dad747cc2f14380517bb8402e1347
  • main default protected
  • 75389691-a67c-422a-91e9-aa58bfb5-main-patch-32205
  • test-pipe
  • extended-scripts
  • structured-badges
  • guix-pipeline
  • cabal-pipeline
8 results

Properties.hs

Blame
  • stuebinm's avatar
    stuebinm authored
    (mostly to do with the scripting API, but also some old ones which are
    already deprecated / not even mentioned in the documentation anymore)
    d2078f17
    History
    Properties.hs 13.63 KiB
    {-# LANGUAGE LambdaCase        #-}
    {-# LANGUAGE MultiWayIf        #-}
    {-# LANGUAGE NamedFieldPuns    #-}
    {-# LANGUAGE OverloadedStrings #-}
    
    -- | Contains checks for custom ties of the map json
    module Properties (checkMap, checkTileset, checkLayer) where
    
    
    import           Control.Monad (unless, when)
    import           Data.Text     (Text, isPrefixOf)
    import           Tiled2        (HasProperties (adjustProperties, getProperties),
                                    IsProperty (asProperty), Layer (..),
                                    Property (..), PropertyValue (..),
                                    Tiledmap (..), Tileset (..))
    import           Util          (layerIsEmpty, prettyprint, showText)
    
    import           Data.Maybe    (fromMaybe, isJust)
    import           LintConfig    (LintConfig (..))
    import           LintWriter    (LintWriter, adjust, askContext, askFileDepth,
                                    complain, dependsOn, forbid, lintConfig,
                                    offersEntrypoint, suggest, warn)
    import           Paths         (RelPath (..), parsePath)
    import           Types         (Dep (Link, Local, LocalMap, MapLink))
    
    
    -- | Checks an entire map for "general" lints.
    --
    -- Note that it does /not/ call checkMapProperty; this is handled
    -- seperately in CheckMap.hs, since these lints go into a different
    -- field of the resulting json.
    checkMap :: LintWriter Tiledmap
    checkMap = do
      tiledmap <- askContext
    
      -- test other things
      mapM_ checkMapProperty (fromMaybe [] $ tiledmapProperties tiledmap)
    
      -- some layers should exist
      hasLayerNamed "start" (const True)
        "The map must have one layer named \"start\""
      hasLayerNamed "floorLayer" ((==) "objectgroup" . layerType)
        "The map must have one layer named \"floorLayer\" of type \"objectgroup\""
      hasLayer (flip containsProperty "exitUrl" . getProperties)
        "The map must contain at least one layer with the property \"exitUrl\" set"
    
      -- reject maps not suitable for workadventure
      unless (tiledmapOrientation tiledmap == "orthogonal")
        $ complain "The map's orientation must be set to \"orthogonal\""
      unless (tiledmapTileheight tiledmap == 32 && tiledmapTilewidth tiledmap == 32)
        $ complain "The map's tile size must be 32 by 32 pixels"
      where
        hasLayerNamed name p = hasLayer (\l -> layerName l == name && p l)
        hasLayer p err = do
          tiledmap <- askContext
          unless (any p (tiledmapLayers tiledmap))
            $ complain err
    
    
    -- | Checks a single property of a map.
    --
    -- Doesn't really do all that much, but could in theory be expanded into a
    -- longer function same as checkLayerProperty.
    checkMapProperty :: Property -> LintWriter Tiledmap
    checkMapProperty (Property name _value) = case name of
      "script" -> do
        -- this is kind of stupid, since if we also inject script this
        -- will be overriden anyways, but it also doesn't really hurt I guess
        -- TODO: perhaps include an explanation in the lint, or allow
        -- exactly that one value?