LayerData.hs

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