Implement simple swarm mechanics

src/Dodge/AIs.hs

@@ -36,35 +36,6 @@ import System.Random
 import Foreign.ForeignPtr
 
 
-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
 ----  
 ----  -- generalised swarm ai, works out where you go from the position of your flock
 ----  swarmAI :: (Point -> IM.IntMap Creature -> Point -> Point) -> Int -> World -> World

src/Dodge/Creature.hs

@@ -278,6 +278,7 @@ startInventory = IM.fromList (zip [0..20]
     ,spawnGun lamp
     ,lasGun
     ,autoGun
+    ,flamer
     --,poisonSprayer
     ,launcher
     --,lasGun

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
     }

src/Dodge/Floor.hs

@@ -8,6 +8,7 @@ import Picture
 import Dodge.Data
 import Dodge.Room
 import Dodge.Creature.State.Data
+import Dodge.Creature.SwarmCrit
 import Dodge.Room.Procedural
 import Dodge.Room.RoadBlock
 import Dodge.Room.Data
@@ -51,7 +52,7 @@ roomTreex = do
             [[StartRoom]
             ,[Corridor]
             ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
-                & rmPS %~ ([swarmPS 0 (x,y) 0 smallChaseCrit | x <- [-20,-19.5.. 20] , y <- [200,200.5..202] ]++)
+                & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,200.5..202] ]++)
              ]
             ,[Corridor]
             ,[Corridor]

src/Dodge/LevelGen/SwarmPlacement.hs

@@ -6,7 +6,7 @@ import Dodge.Data
 import Dodge.LevelGen.Data
 import Dodge.Creature.State.Data
 
-import qualified Data.Set as S
+import qualified Data.IntSet as IS
 import Control.Lens
 
 swarmPS :: Int -> Point2 -> Float -> Creature -> Placement
@@ -22,4 +22,4 @@ setSwarm psts (PutCrit cr) w
   where
     cid = _crID cr
     theSwarm = Swarm swarmSet
-    swarmSet = S.fromList $ map (_crID . _unPutCrit) psts
+    swarmSet = IS.fromList $ map (_crID . _unPutCrit) psts

src/Dodge/Update.hs

@@ -187,9 +187,9 @@ crCrSpring :: Creature -> Creature -> World -> World
 crCrSpring c1 c2 w 
     | id1 == id2 = w
     | vec == (0,0) = w
-    | diff < comRad = over (creatures . ix id1 . crPos) (+.+ overlap1)
+    | diff >= comRad = w
+    | otherwise = over (creatures . ix id1 . crPos) (+.+ overlap1)
                         $ over (creatures . ix id2 . crPos) (-.- overlap2) w
-    | otherwise = w
   where 
     id1  = _crID c1
     id2  = _crID c2