Implement simple swarm mechanics

src/Dodge/Creature/ImpulseRat.hs

@@ -2,11 +2,58 @@ module Dodge.Creature.ImpulseRat
     where
 import Dodge.Data
 import Dodge.Creature.ChooseTarget
+import Dodge.Creature.State.Data
 import Dodge.Creature.Rationality.Data
 import Geometry
 
+import qualified Data.IntMap as IM
 import Control.Lens
 
+lineOrth :: Point2 -> IM.IntMap Creature -> Point2 -> Point2
+lineOrth ypos crs cpos = p
+    where ps = map _crPos $ IM.elems crs 
+          cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
+          p | dist cen ypos < 20 = ypos
+            | otherwise = errorClosestPointOnLine 500 ypos (ypos +.+ vNormal (cen -.- ypos)) cpos
+
+lineUp :: Point2 -> IM.IntMap Creature -> Point2 -> Point2
+lineUp ypos crs cpos = p
+    where ps = map _crPos $ IM.elems crs 
+          cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
+          p = (0.05 *.* ypos) +.+ (0.95 *.* errorClosestPointOnLine 500 cen ypos cpos)
+
+holdForm :: Point2 -> IM.IntMap Creature -> Point2 -> Point2
+holdForm ypos crs cpos = p
+    where ps = map _crPos $ IM.elems crs 
+          cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
+          p | dist cen ypos < 20 = ypos
+            | otherwise = ypos +.+ cpos -.- cen
+
+-- not nice, a kind of encircle
+spreadOut :: Point2 -> IM.IntMap Creature -> Point2 -> Point2
+spreadOut ypos crs cpos = p
+    where ps = map _crPos $ IM.elems crs 
+          cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
+          p | dist cen ypos < 30 = ypos
+            | otherwise = ypos +.+ (spreadFactor *.* cpos -.- cen)
+          spreadFactor | dist ypos cpos > 200 = 1
+                       | otherwise = 5
+chaseTarget'
+    :: (Point2 -> IM.IntMap Creature -> Point2 -> Point2)
+    -> (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
+    -> World 
+    -> Creature 
+    -> Creature 
+chaseTarget' f targFunc w cr = case targFunc cr w of
+    Nothing -> cr
+    Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg' p cr crTarg
+      where
+        ypos = _crPos crTarg
+        cpos = _crPos cr
+        is = _swarm $ _crGroup cr
+        crs = IM.restrictKeys (_creatures w) is
+        p = f ypos crs cpos
+
 chaseTarget
     :: (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
     -> World 
@@ -16,6 +63,23 @@ chaseTarget targFunc w cr = case targFunc cr w of
     Nothing -> cr
     Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg
 
+chaseTarg' :: Point2 -> Creature -> Creature -> [Impulse]
+chaseTarg' p cr crT
+    | dist tpos cpos < combinedRad + 5 
+            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+            && _crMeleeCooldown cr == Just 0
+        = [Melee (_crID crT)]
+    | dist tpos cpos < combinedRad + 5 
+            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+        = [ TurnToward tpos 0.05 ]
+    | abs ((_crDir cr) - argV (p -.- cpos)) < pi/4
+                = [MoveForward 2.5 , TurnToward p 0.2, RandomTurn 0.2 ]
+    | otherwise = [MoveForward 2.5 , TurnToward p 0.05, RandomTurn 0.2 ]
+  where
+    cpos = _crPos cr
+    tpos = _crPos crT
+    combinedRad = _crRad cr + _crRad crT
+
 chaseTarg :: Creature -> Creature -> [Impulse]
 chaseTarg cr crT
     | dist tpos cpos < combinedRad + 5 

src/Dodge/Creature/State/Data.hs

@@ -9,7 +9,7 @@ import Dodge.Creature.Stance.Data
 import Picture.Data
 
 import Control.Lens
-import qualified Data.Set as S
+import qualified Data.IntSet as IS
 
 data CreatureState = CrSt 
     { _goals    :: [[Impulse]]
@@ -42,7 +42,7 @@ data Faction
 
 data CrGroup
     = LoneWolf
-    | Swarm { _swarm :: S.Set Int }
+    | Swarm { _swarm :: IS.IntSet }
 
 makeLenses ''CreatureState
 makeLenses ''CrSpState

src/Dodge/Creature/SwarmCrit.hs

@@ -29,11 +29,12 @@ import System.Random
 
 swarmCrit :: Creature
 swarmCrit = defaultCreature
-    { _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS
+    { _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget' lineUp targetYouLOS
     , _crHP = 1
     , _crRad = 4
     , _crPict = basicCrPict yellow
     , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
     , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 4
     , _crFaction = ColorFaction yellow
+    , _crMeleeCooldown = Just 0
     }