Add support for group placements

2021-05-14 19:46:52 +02:00
parent 0b26761be5
commit 2b09bf2072
18 changed files with 307 additions and 266 deletions
@@ -0,0 +1,25 @@
+module Dodge.LevelGen.SwarmPlacement
+    ( swarmPS
+    )
+    where
+import Dodge.Data
+import Dodge.LevelGen.Data
+import Dodge.Creature.State.Data
+
+import qualified Data.Set as S
+import Control.Lens
+
+swarmPS :: Int -> Point2 -> Float -> Creature -> Placement
+swarmPS i p a cr = GroupedPlacement
+    { _groupPlacementID = i
+    , _groupPlacementFunc = setSwarm
+    , _placementSpot = PS p a $ PutCrit cr
+    }
+
+setSwarm :: [PSType] -> PSType -> World -> World
+setSwarm psts (PutCrit cr) w
+    = w & creatures . ix cid . crGroup .~ theSwarm
+  where
+    cid = _crID cr
+    theSwarm = Swarm swarmSet
+    swarmSet = S.fromList $ map (_crID . _unPutCrit) psts