diff options
author | stuebinm | 2023-10-23 23:18:34 +0200 |
---|---|---|
committer | stuebinm | 2023-10-24 01:21:52 +0200 |
commit | 9110064fe62f98dd3ecc5fb4c3915a843492b8fb (patch) | |
tree | 6a8e3d54bef365bf1c6c4f72a7a75dd5d1f05d40 /walint/LayerData.hs | |
parent | a4461ce5d73a617e614e259bfe30b4e895c38a19 (diff) |
This does many meta-things, but changes no functionality:
- get rid of stack, and use just cabal with a stackage snapshot instead
(why did I ever think stack was a good idea?)
- update the stackage snapshot to something halfway recent
- thus making builds work on nixpkgs-23.05 (current stable)
- separating out packages into their own cabal files
- use the GHC2021 set of extensions as default
- very slight code changes to make things build again
- update readme accordingly
- stylish-haskell run
Diffstat (limited to 'walint/LayerData.hs')
-rw-r--r-- | walint/LayerData.hs | 42 |
1 files changed, 42 insertions, 0 deletions
diff --git a/walint/LayerData.hs b/walint/LayerData.hs new file mode 100644 index 0000000..82efbfc --- /dev/null +++ b/walint/LayerData.hs @@ -0,0 +1,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 |