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