Add support for group placements

src/Dodge/LevelGen/Data.hs

@@ -9,7 +9,7 @@ import Control.Lens
 import Control.Monad.State
 import System.Random
 
-data PSType = PutCrit Creature
+data PSType = PutCrit {_unPutCrit :: Creature}
     | PutLS LightSource Picture
     | PutButton Button
     | PutFlIt Item
@@ -34,10 +34,12 @@ data Placement
     = SinglePlacement {_placementSpot :: PlacementSpot }
     | GroupedPlacement
         {_groupPlacementID :: Int
-        ,_groupPlacementFunc :: [PlacementSpot] -> PlacementSpot -> PlacementSpot
+        ,_groupPlacementFunc :: [PSType] -> PSType -> World -> World
         ,_placementSpot :: PlacementSpot
         }
         
+sPS p a = SinglePlacement . PS p a
+
 makeLenses ''PSType
 makeLenses ''PlacementSpot
 makeLenses ''Placement

src/Dodge/LevelGen/SwarmPlacement.hs

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