1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
{-# 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
|
