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

Types.hs

Blame
  • LayerData.hs 1.61 KiB
    {-# LANGUAGE OverloadedStrings #-}
    
    module LayerData where
    
    import           Universum         hiding (maximum, uncons)
    
    import           Control.Monad.Zip (mzipWith)
    import           Data.Set          (insert)
    import           Data.Tiled        (GlobalId (unGlobalId), Layer (..))
    import           Data.Vector       (maximum, uncons)
    import qualified Text.Show         as TS
    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 TS.Show Collision where
      show c = toString $ 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