justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Remove all AI code from AI file

Browse Source
This commit is contained in:
justin
2021-05-15 14:59:35 +02:00
parent e658fdcd0b
commit 0798cc0b0e
13 changed files with 121 additions and 122 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/ImpulseRat.hs
+68 -31
View File
@@ -1,6 +1,7 @@
module Dodge.Creature.ImpulseRat
where
import Dodge.Data
import Dodge.Base
import Dodge.Creature.ChooseTarget
import Dodge.Creature.State.Data
import Dodge.Creature.Rationality.Data
@@ -9,50 +10,86 @@ 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
encircle :: Creature -> IM.IntMap Creature -> Creature -> Point2
encircle tcr crs cr
| length crs <= 1 = ypos
| otherwise = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 30) ) *.* safeNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
ypos = _crPos tcr
f x = 150 * sigmoid (x-10)
cenp = (1 / fromIntegral (length crs)) *.* foldr1 (+.+) (map _crPos $ IM.elems crs)
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
lineOrth :: Creature -> IM.IntMap Creature -> Creature -> Point2
lineOrth tcr crs cr = p
where
ypos = _crPos tcr
cpos = _crPos cr
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
holdForm :: Creature -> IM.IntMap Creature -> Creature -> Point2
holdForm ycr crs cr = p
where
ypos = _crPos ycr
cpos = _crPos cr
ps = map _crPos $ IM.elems crs
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
p | dist cen ypos < 20 = ypos
| otherwise = ypos +.+ cpos -.- cen
lineUp :: Creature -> IM.IntMap Creature -> Creature -> Point2
lineUp ycr crs cr = p
where
ypos = _crPos ycr
cpos = _crPos cr
ps = map _crPos $ IM.elems crs
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
p = (0.05 *.* ypos) +.+ (0.95 *.* errorClosestPointOnLine 500 cen ypos cpos)
-- 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)
spreadOut :: Creature -> IM.IntMap Creature -> Creature -> Point2
spreadOut ycr crs cr = p
where
ypos = _crPos ycr
cpos = _crPos cr
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 > 90 = 1
| otherwise = 1.5
flockChaseTarget
:: (Creature -> IM.IntMap Creature -> Creature -> Creature) -- ^ Update with target
-> (IM.IntMap Creature -> Creature -> Creature) -- ^ Update without target
-> World
-> Creature
-> Creature
flockChaseTarget updT upd w cr = case _crTarget cr of
Nothing -> upd crs cr
Just tcr -> updT tcr crs cr
where
is = _swarm $ _crGroup cr
crs = IM.restrictKeys (_creatures w) is
flockPointTarget
:: (Creature -> IM.IntMap Creature -> Creature -> Point2)
-> (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> World
-> Creature
-> Creature
chaseTarget' f targFunc w cr = case targFunc cr w of
flockPointTarget 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
p = f crTarg crs cr
chaseTarget
:: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
src/Dodge/Creature/Rationality.hs
+4 -5
View File
@@ -71,10 +71,10 @@ followImpulse cr w imp = case imp of
ArbitraryImpulseFunction f -> (id, f w cr)
ArbitraryImpulse f -> followImpulse cr w (f cr w)
ImpulseUseTargetCID f -> case cr ^? crTarget . _Just of
Just tcid -> followImpulse cr w (f tcid)
Just tcr -> followImpulse cr w (f $ _crID tcr)
_ -> (id,cr)
ImpulseUseTarget f -> case cr ^? crTarget . _Just of
Just tcid -> followImpulse cr w (f $ _creatures w IM.! tcid)
Just tcr -> followImpulse cr w (f tcr)
_ -> (id,cr)
ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
_ -> (id , cr)
@@ -156,14 +156,13 @@ performAction cr w ac = case ac of
| hasLOS cpos p w -> ([TurnToward p (pi/4),MoveForward 3] , Just (PathTo p))
| otherwise -> ([], Nothing)
LeadTarget p -> case cr ^? crTarget . _Just of
Just tcid -> let tcr = _creatures w IM.! tcid
in ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing)
Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing)
_ -> ([], Nothing)
FleeFrom cid -> case w ^? creatures . ix cid of
Just tcr -> ([MoveForward 3, TurnToward ((2 *.* _crPos cr) -.- _crPos tcr) (pi/4)], Nothing)
_ -> ([], Nothing)
UseTargetCID f -> case cr ^? crTarget . _Just of
Just tcid -> performAction cr w (f tcid)
Just tcr -> performAction cr w (f $ _crID tcr)
_ -> ([],Nothing)
UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
ArbitraryAction f -> performAction cr w (f cr w)
src/Dodge/Creature/SetTarget.hs
+2 -1
View File
@@ -7,10 +7,11 @@ import Dodge.Data
import Dodge.Creature.AlertLevel.Data
import Control.Lens
import qualified Data.IntMap.Strict as IM
targetYouWhenCognizant
:: World
-> Creature
-> Creature
targetYouWhenCognizant w cr = case cr ^? crAwarenessLevel . ix 0 of
Just (Cognizant _) -> cr & crTarget .~ Just 0
Just (Cognizant _) -> cr & crTarget .~ Just (_creatures w IM.! 0)
_ -> cr & crTarget .~ Nothing
src/Dodge/Creature/SwarmCrit.hs
+6 -3
View File
@@ -29,12 +29,15 @@ import System.Random
swarmCrit :: Creature
swarmCrit = defaultCreature
{ _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget' lineUp targetYouLOS
{ _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
[ flockPointTarget encircle targetYouLOS
, \ _ -> crMeleeCooldown . _Just %~ (max 0 . subtract 1)
]
, _crHP = 1
, _crRad = 4
, _crRad = 2
, _crPict = basicCrPict yellow
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 4
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 2
, _crFaction = ColorFaction yellow
, _crMeleeCooldown = Just 0
}
src/Dodge/Creature/Test.hs
+5 -2
View File
@@ -28,6 +28,9 @@ crIsReloading (w,cr) = case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of
Just t -> t > 0
_ -> False
crCanSeeCr :: Creature -> (World, Creature) -> Bool
crCanSeeCr tcr (w,cr) = hasLOS (_crPos cr) (_crPos tcr) w
crCanSeeCID :: Int -> (World, Creature) -> Bool
crCanSeeCID cid (w,cr) = hasLOS (_crPos cr) (_crPos $ _creatures w IM.! cid) w
@@ -39,12 +42,12 @@ crHasTarget (_,cr) = isJust $ cr ^? crTarget . _Just
crHasTargetLOS :: (World,Creature) -> Bool
crHasTargetLOS (w,cr) = case cr ^? crTarget . _Just of
Just i -> crCanSeeCID i (w,cr)
Just i -> crCanSeeCr i (w,cr)
Nothing -> False
crSafeDistFromTarg :: Float -> (World,Creature) -> Bool
crSafeDistFromTarg d (w,cr) = case cr ^? crTarget . _Just of
Just i -> dist (_crPos cr) (_crPos $ _creatures w IM.! i) > d
Just tcr -> dist (_crPos cr) (_crPos tcr) > d
Nothing -> True
crStratConMatches :: Strategy -> (World,Creature) -> Bool