Skip to content
Snippets Groups Projects
Select Git revision
  • d0ff3930f31afdde421a65e0a6e356ea48cd5824
  • master default protected
  • claims-in-idtoke
  • jwt_encode_inconsistencies
  • recovery-code-pwhash
  • incremental-sync
  • redis-rate-limits
  • typehints
  • v1.2.x
  • v1.x.x
  • v1.1.x
  • feature_invite_validuntil_minmax
  • Dockerfile
  • v1.0.x
  • roles-recursive-cte
  • v2.3.1
  • v2.3.0
  • v2.2.0
  • v2.1.0
  • v2.0.1
  • v2.0.0
  • v1.2.0
  • v1.1.2
  • v1.1.1
  • v1.0.2
  • v1.1.0
  • v1.0.1
  • v1.0.0
  • v0.3.0
  • v0.2.0
  • v0.1.5
  • v0.1.4
  • v0.1.2
33 results

models.py

Blame
  • Forked from uffd / uffd
    Source project has a limited visibility.
    LayerData.hs 1.59 KiB
    {-# LANGUAGE OverloadedStrings #-}
    
    module LayerData where
    
    
    import           Control.Monad.Zip (mzipWith)
    import           Data.Set          (Set, insert)
    import           Data.Text         (Text)
    import qualified Data.Text         as T
    import           Data.Vector       (Vector, uncons)
    import           Tiled             (GlobalId (unGlobalId), Layer (..))
    import           Util              (PrettyPrint (..))
    
    -- | A collision between two layers of the given names.
    -- Wrapped in a newtype so that Eq can ignore the order of the two
    newtype Collision = Collision { fromCollision ::  (Text, Text) }
      deriving Ord
    
    instance Eq Collision where
      (Collision (a,b)) == (Collision (a',b')) = ((a,b) == (a',b')) || ((a,b) == (b',a'))
    
    instance PrettyPrint Collision where
      prettyprint (Collision (a,b)) = a <> " and " <> b
    
    instance Show Collision where
      show c = T.unpack $ prettyprint c
    
    -- | Finds pairwise tile collisions between the given layers.
    layerOverlaps :: Vector Layer -> Set Collision
    layerOverlaps layers = case uncons layers of
      Nothing -> mempty
      Just (l, ls) ->
       fst . foldr overlapBetween (mempty, l) $ ls
       where overlapBetween :: Layer -> (Set Collision, Layer) -> (Set Collision, Layer)
             overlapBetween layer (acc, oldlayer) =
              (if collides then insert collision acc else acc, layer)
              where
               collision = Collision (layerName layer, layerName oldlayer)
               collides = case (layerData layer, layerData oldlayer) of
                 (Just d1, Just d2) ->
                   0 /= maximum (mzipWith (\a b -> unGlobalId a * unGlobalId b) d1 d2)
                 _ -> False