From c5657fe855198c55313d128c42e13f80f47f2ef8 Mon Sep 17 00:00:00 2001 From: jgk Date: Fri, 14 May 2021 20:28:53 +0200 Subject: [PATCH] Implement simple swarm mechanics --- src/Dodge/AIs.hs | 29 ------------- src/Dodge/Creature.hs | 1 + src/Dodge/Creature/ImpulseRat.hs | 64 ++++++++++++++++++++++++++++ src/Dodge/Creature/State/Data.hs | 4 +- src/Dodge/Creature/SwarmCrit.hs | 3 +- src/Dodge/Floor.hs | 3 +- src/Dodge/LevelGen/SwarmPlacement.hs | 4 +- src/Dodge/Update.hs | 4 +- 8 files changed, 75 insertions(+), 37 deletions(-) diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index 907a22728..bdac6df20 100644 --- a/src/Dodge/AIs.hs +++ b/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 diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index efb761059..185d02f31 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -278,6 +278,7 @@ startInventory = IM.fromList (zip [0..20] ,spawnGun lamp ,lasGun ,autoGun + ,flamer --,poisonSprayer ,launcher --,lasGun diff --git a/src/Dodge/Creature/ImpulseRat.hs b/src/Dodge/Creature/ImpulseRat.hs index 6e48d6965..26d420245 100644 --- a/src/Dodge/Creature/ImpulseRat.hs +++ b/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 diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs index 00055afc5..7dbd8af01 100644 --- a/src/Dodge/Creature/State/Data.hs +++ b/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 diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index a4ea506cc..68ee1bd59 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/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 } diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 58f131672..539967ff5 100644 --- a/src/Dodge/Floor.hs +++ b/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] diff --git a/src/Dodge/LevelGen/SwarmPlacement.hs b/src/Dodge/LevelGen/SwarmPlacement.hs index faf9cfb37..944108239 100644 --- a/src/Dodge/LevelGen/SwarmPlacement.hs +++ b/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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 54afef142..f24120f23 100644 --- a/src/Dodge/Update.hs +++ b/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