From 9110064fe62f98dd3ecc5fb4c3915a843492b8fb Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 23 Oct 2023 23:18:34 +0200
Subject: a year went by

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
---
 walint/LayerData.hs | 42 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 42 insertions(+)
 create mode 100644 walint/LayerData.hs

(limited to 'walint/LayerData.hs')

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
-- 
cgit v1.2.3