Delete cruft, add Reader monad to some internal ai

src/Dodge/LevelGen/Data.hs

@@ -8,7 +8,6 @@ import Picture
 import Control.Lens
 import Control.Monad.State
 import System.Random
-
 data PSType = PutCrit {_unPutCrit :: Creature}
     | PutLS LightSource Picture
     | PutButton Button
@@ -34,12 +33,13 @@ data Placement
     = SinglePlacement {_placementSpot :: PlacementSpot }
     | GroupedPlacement
         {_groupPlacementID :: Int
-        ,_groupPlacementFunc :: [PSType] -> PSType -> World -> World
+--        ,_groupPlacementUpdate :: World -> Placement -> (World, Placement)
+        ,_groupUpdate :: World -> [Placement] -> World
+--        ,_groupPlacementFunc :: [PSType] -> PSType -> World -> World
         ,_placementSpot :: PlacementSpot
         }
-        
+sPS :: Point2 -> Float -> PSType -> Placement
 sPS p a = SinglePlacement . PS p a
-
 makeLenses ''PSType
 makeLenses ''PlacementSpot
 makeLenses ''Placement

src/Dodge/LevelGen/SwarmPlacement.hs

@@ -3,23 +3,54 @@ module Dodge.LevelGen.SwarmPlacement
     )
     where
 import Dodge.Data
+import Dodge.Base
 import Dodge.LevelGen.Data
 import Dodge.Creature.State.Data
+import Geometry
 
+import Data.List
 import qualified Data.IntSet as IS
+import qualified Data.IntMap as IM
 import Control.Lens
 
 swarmPS :: Int -> Point2 -> Float -> Creature -> Placement
 swarmPS i p a cr = GroupedPlacement
     { _groupPlacementID = i
-    , _groupPlacementFunc = setSwarm
+    , _groupUpdate = setSwarm
+--    , _groupPlacementFunc = setSwarm i
     , _placementSpot = PS p a $ PutCrit cr
     }
-
-setSwarm :: [PSType] -> PSType -> World -> World
-setSwarm psts (PutCrit cr) w
-    = w & creatures . ix cid . crGroup .~ theSwarm
+setSwarm :: World -> [Placement] -> World
+setSwarm w ps = updateCrs w' & creatureGroups %~ IM.insert gid theGroupParams
   where
-    cid = _crID cr
-    theSwarm = Swarm swarmSet
-    swarmSet = IS.fromList $ map (_crID . _unPutCrit) psts
+    (w', crs) = mapAccumR updateCrit w ps
+    is = IS.fromList $ map _crID crs
+    cpos = centroid $ map _crPos crs
+    gid = newKey (_creatureGroups w')
+    theGroupParams = CrGroupParams
+        { _crGroupParamID = gid
+        , _crGroupIDs = is
+        , _crGroupCenter = cpos
+        , _crGroupUpdate = crGroupUpdateCenter
+        }
+    updateCrs w'' = IS.foldl' (\w''' cid -> w''' & creatures . ix cid %~ setSwarmStatus) w'' is
+    setSwarmStatus = crGroup .~ Swarm {_swarm = is, _crGroupID = gid}
+
+crGroupUpdateCenter :: World -> CrGroupParams -> Maybe CrGroupParams
+crGroupUpdateCenter w cgp 
+    | IM.null crs = Nothing
+    | otherwise = Just $ cgp & crGroupCenter .~
+        centroid (IM.map _crPos crs)
+  where
+    crs = IM.restrictKeys (_creatures w) (_crGroupIDs cgp)
+
+updateCrit :: World -> Placement -> (World, Creature)
+updateCrit w pl = (w & creatures %~ IM.insert cid cr
+    , cr
+    )
+  where 
+    p = _psPos $ _placementSpot pl
+    rot = _psRot $ _placementSpot pl
+    scr = _unPutCrit $ _psType $ _placementSpot pl
+    cid = newKey (_creatures w)
+    cr = scr {_crPos = p,_crOldPos = p,_crDir = rot,_crID = cid}