57 lines
1.8 KiB
Haskell
57 lines
1.8 KiB
Haskell
module Dodge.LevelGen.SwarmPlacement
|
|
( swarmPS
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Creature.State.Data
|
|
--import Geometry
|
|
import Geometry.ConvexPoly
|
|
import qualified IntMapHelp as IM
|
|
|
|
import Data.List
|
|
import qualified Data.IntSet as IS
|
|
import Control.Lens
|
|
|
|
swarmPS :: Int -> Point2 -> Float -> Creature -> Placement
|
|
swarmPS i p a cr = GroupedPlacement
|
|
{ _groupPlacementID = i
|
|
, _groupUpdate = setSwarm
|
|
-- , _groupPlacementFunc = setSwarm i
|
|
, _placementSpot = PS p a $ PutCrit cr
|
|
}
|
|
setSwarm :: World -> [Placement] -> World
|
|
setSwarm w ps = updateCrs w' & creatureGroups %~ IM.insert gid theGroupParams
|
|
where
|
|
(w', crs) = mapAccumR updateCrit w ps
|
|
is = IS.fromList $ map _crID crs
|
|
cpos = centroid $ map _crPos crs
|
|
gid = IM.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 = IM.newKey (_creatures w)
|
|
cr = scr {_crPos = p,_crOldPos = p,_crDir = rot,_crID = cid}
|