{-# 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