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:
jgk
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/AIs.hs
-58
View File
@@ -35,64 +35,6 @@ import Control.Concurrent
import System.Random
import Foreign.ForeignPtr
----
---- -- generalised swarm ai, works out where you go from the position of your flock
---- swarmAI :: (Point -> IM.IntMap Creature -> Point -> Point) -> Int -> World -> World
---- swarmAI f cid w =
---- let cr = _creatures w IM.! cid
---- cpos = _crPos cr
---- damageYou = over (creatures . ix 0 . crHP) (\hp -> hp - 10) . soundOnce hitSound
---- ypos = _crPos $ you w
---- flockers = IM.filter (flip (canSeePoint cid) w . _crPos)
---- $ IM.filter (factionIs $ _faction $ _crState cr)
---- $ _creatures w
---- tp = f ypos flockers cpos
---- combinedRad = _crRad cr + _crRad (you w)
---- replaceGoal newImpulses = over (creatures . ix cid . crState . goals)
---- (\gs -> newImpulses ++ tail gs)
---- addGoal newImpulses = over (creatures . ix cid . crState . goals)
---- (\gs -> newImpulses ++ gs)
---- replaceImpulse newActions = over (creatures . ix cid . crState . goals)
---- (\((_:as):ass) -> (newActions ++ as):ass)
---- addImpulse newActions = over (creatures . ix cid . crState . goals)
---- (\(as:ass) -> (newActions++as):ass)
---- in if _crHP cr <= 0 then killCr cid w else
---- case head $ _goals $ _crState cr of
---- [] | canSee cid (_yourID w) w
---- -> replaceGoal [[MoveToFor tp 10]] w
---- | otherwise -> w
---- (MoveToFor p x:_)
---- | dist ypos cpos < combinedRad + 5
---- && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4 -- THIS WON'T WORK
---- -- think about when crdir is 0.1 and yposdir is (2pi - epsilon)
----
---- && x == 0
---- -> over (creatures . ix cid . crPos)
---- (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos)))
---- $ replaceImpulse [MeleeAttack 5]
---- $ damageYou
---- w
---- | canSee cid (_yourID w) w && dist cpos ypos < 50
---- -> mvForward 2 cid $ turnTowardSpeed 0.5 ypos cid
---- $ replaceImpulse [MoveToFor ypos (max 0 (x-1))] w
---- | x == 0 && canSee cid (_yourID w) w
---- -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid
---- $ replaceImpulse [MoveToFor tp 0] w
---- | x == 0 -> replaceImpulse [MoveToFor p 10] w
---- | canSee cid (_yourID w) w
---- -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid
---- $ replaceImpulse [MoveToFor p (x-1)] w
---- | dist cpos p < 20 -> w
---- | otherwise -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid w
---- (MeleeAttack x:_)
---- | x == 0 -> replaceImpulse [WaitFor 5] w
---- | otherwise -> replaceImpulse [MeleeAttack (x-1)] w
---- (WaitFor x:gls)| x == 0 -> replaceImpulse [] w
---- | canSee cid (_yourID w) w
---- -> turnTowardSpeed 0.05 ypos cid
---- $ replaceImpulse [WaitFor (x-1)] w
---- | otherwise -> replaceImpulse [WaitFor (x-1)] w
----
---- encircleAI' :: Int -> World -> World
---- encircleAI' cid w =
src/Dodge/Base.hs
+10 -11
View File
@@ -95,16 +95,19 @@ allWalls w = IM.unions $ concatMap IM.elems $ IM.elems $ _wallsZone w
creaturesNearPoint :: Point2 -> World -> IM.IntMap Creature
creaturesNearPoint p w = IM.unions [f b $ f a $ _creaturesZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
where (x,y) = zoneOfPoint p
f i m = case IM.lookup i m of Just val -> val
_ -> IM.empty
where
(x,y) = crZoneOfPoint p
f i m = case IM.lookup i m of
Just val -> val
_ -> IM.empty
cloudsNearPoint :: Point2 -> World -> IM.IntMap Cloud
cloudsNearPoint p w = IM.unions [f b $ f a $ _cloudsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
where (x,y) = zoneOfPoint p
f i m = case IM.lookup i m of Just val -> val
_ -> IM.empty
where
(x,y) = cloudZoneOfPoint p
f i m = case IM.lookup i m of
Just val -> val
_ -> IM.empty
-- possible BUG, occurs when used in thingsHitLongLine
creaturesAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Creature
--creaturesAlongLine a b w = IM.unions [f y $ f x $ _creaturesZone w | (x,y) <- zoneOfLine a b]
@@ -115,9 +118,6 @@ creaturesAlongLine a b w = IM.foldrWithKey' g IM.empty kps
kps = zoneOfLineIntMap a b
f i m = case IM.lookup i m of Just val -> val
_ -> IM.empty
{- | Expands a line out to a given thickness. -}
lineGeom :: Float -> Point2 -> Point2 -> [Point2]
lineGeom t x y
@@ -148,7 +148,6 @@ insertInZoneWith
insertInZoneWith x y fun obj = IM.insertWith f x $ IM.singleton y obj
where
f _ = IM.insertWith fun y obj
{- | I believe this overwrites the value if it already exists, but not sure. -}
insertIMInZone
:: Int -- ^ First key
src/Dodge/Base/Zone.hs
+13 -1
View File
@@ -12,14 +12,26 @@ import Data.Bifunctor
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
zoneSize :: Float
zoneSize = 25
zoneSize = 50
--zoneSize = 100
floorHun :: Float -> Int
floorHun x = floor $ x / zoneSize
sizeZoneOfPoint :: Float -> Point2 -> (Int,Int)
sizeZoneOfPoint s (x,y) = (f x, f y)
where
f = floor . (/ s)
zoneOfPoint :: Point2 -> (Int,Int)
zoneOfPoint (x,y) = (floorHun x, floorHun y)
cloudZoneOfPoint :: Point2 -> (Int,Int)
cloudZoneOfPoint = sizeZoneOfPoint 20
crZoneOfPoint :: Point2 -> (Int,Int)
crZoneOfPoint = sizeZoneOfPoint 15
zoneNearPoint :: Point2 -> [(Int,Int)]
zoneNearPoint (x',y') = [(a,b) | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
where
src/Dodge/Creature.hs
+4 -1
View File
@@ -78,7 +78,10 @@ smallChaseCrit = defaultCreature
}
chaseCrit :: Creature
chaseCrit = defaultCreature
{ _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS
{ _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
[ chaseTarget targetYouLOS
, \ _ -> crMeleeCooldown . _Just %~ (max 0 . subtract 1)
]
, _crHP = 300
, _crPict = basicCrPict green
, _crInv = IM.empty
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
src/Dodge/Data.hs
+1 -1
View File
@@ -161,7 +161,7 @@ data Creature = Creature
, _crAwarenessLevel :: IM.IntMap AwarenessLevel
, _crFaction :: Faction
, _crGroup :: CrGroup
, _crTarget :: Maybe Int
, _crTarget :: Maybe Creature
}
data WorldState
= DoorNumOpen Int
src/Dodge/Floor.hs
+1 -1
View File
@@ -52,7 +52,7 @@ roomTreex = do
[[StartRoom]
,[Corridor]
,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
& rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,201] ]++)
& rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200] ]++)
]
,[Corridor]
,[Corridor]
src/Dodge/Update.hs
+6 -4
View File
@@ -74,12 +74,14 @@ update' w = case _menuLayers w of
where
zoneCreatures = set creaturesZone (IM.foldr creatureInZone IM.empty (_creatures w))
creatureInZone cr = insertIMInZone x y cid cr
where (x,y) = zoneOfPoint $ _crPos cr
cid = _crID cr
where
(x,y) = crZoneOfPoint $ _crPos cr
cid = _crID cr
zoneClouds = set cloudsZone (IM.foldr cloudInZone IM.empty (_clouds w))
cloudInZone cr = insertIMInZone x y cid cr
where (x,y) = zoneOfPoint $ _clPos cr
cid = _clID cr
where
(x,y) = cloudZoneOfPoint $ _clPos cr
cid = _clID cr
doubleArgumentFor f x = f x x
updateTriggers :: World -> World
src/Dodge/Update/Camera.hs
+1 -3
View File
@@ -165,11 +165,9 @@ farWallDist cpos w = min (halfWidth w / (horizontalMax+50) ) (halfHeight w / (ve
tRays = rotF [(y, maxViewDistance) | y <- zs]
bRays = rotF [(y,-maxViewDistance) | y <- zs]
rotF = map (h . (+.+) cpos . rotateV (_cameraRot w))
zs = takeWhile (< maxViewDistance) [-maxViewDistance,negate $ 0.8*maxViewDistance..]
zs = takeWhile (< maxViewDistance) [-maxViewDistance,negate $ 0.75*maxViewDistance..]
maxViewDistance = 800
dirRays :: Float -> [Point2]
dirRays dir = take 11 $ iterate (rotateV (0.5 * pi / 10)) $ rotateV (dir-pi*0.25) (600,0)