summaryrefslogtreecommitdiff
path: root/lib/LayerData.hs
blob: 82efbfcbdc6af50f20197364813cdbe2292eb1c3 (plain)
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