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

Continue ai refactor

Browse Source
This commit is contained in:
jgk
2021-05-06 14:07:51 +02:00
parent 75c36e2c95
commit 436043b169
12 changed files with 94 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/AIs.hs
+1 -1
View File
@@ -796,7 +796,7 @@ launcherAI inRange outRange w (f,g) cr =
(TurnTo p:_) -> ( (f,g') , replaceImpulse [] . crTurnTo p $ cr)
(TurnByFor a 0:_) -> ( (f,g') , replaceImpulse [] . over crDir (+a) $ cr)
(TurnByFor a i:_) -> ( (f,g') , replaceImpulse [TurnByFor a (i-1)] . over crDir (+a) $ cr)
(SetPosture pture:_) -> ((f,g), replaceImpulse [] $ set (crState . stance . posture) pture cr)
(SetPosture pture:_) -> ((f,g), replaceImpulse [] $ set (crStance . posture) pture cr)
(MoveByFor p 0:_) -> ((f,g'), replaceImpulse [] . crMvBy p $ cr)
(MoveByFor p i:_) -> ((f,g'), replaceImpulse [MoveByFor p (i-1)] . crMvBy p $ cr)
(Fire:_) | pointHitsWalls cpos (cpos +.+ 40 *.* unitVectorAtAngle (_crDir cr))
src/Dodge/Creature.hs
+12
View File
@@ -17,6 +17,7 @@ import Dodge.Creature.YourControl
import Dodge.Creature.Inanimate
import Dodge.Creature.State
import Dodge.Creature.Picture
import Dodge.Creature.Rationality
import Dodge.Item
import Dodge.Picture.Layer
import Dodge.Creature.Picture
@@ -65,6 +66,17 @@ smallChaseCrit = defaultCreature
}
chaseCrit :: Creature
chaseCrit = defaultCreature
{ _crUpdate = stateUpdate $ impulsiveAI $ applyBasicImpulse
, _crHP = 300
, _crPict = basicCrPict green
, _crState = defaultState
{_goals = [[Wait]]
,_faction = ChaseCritters
}
, _crInv = IM.empty
}
chaseCrit' :: Creature
chaseCrit' = defaultCreature
{ _crUpdate = stateUpdate chaseAI
, _crHP = 300
, _crPict = basicCrPict green
src/Dodge/Creature/Action.hs
+2 -2
View File
@@ -76,7 +76,7 @@ crMvBy p' cr = stepForward (magV p) $ over crPos (+.+ p) cr
where
p = (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p'
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
aimingFactor | (_posture $ _stance $ _crState cr) == Aiming
aimingFactor | (_posture $ _crStance cr) == Aiming
= fromMaybe 1 $ it ^? itAimingSpeed
| otherwise = 1
it = _crInv cr IM.! _crInvSel cr
@@ -85,7 +85,7 @@ stepForward
:: Float -- ^ Speed
-> Creature
-> Creature
stepForward speed cr = over (crState . stance . carriage) f cr
stepForward speed cr = over (crStance . carriage) f cr
where
f (w@Walking {}) = w {_stepToAdd = ceiling speed}
f s = s
src/Dodge/Creature/ChooseTarget.hs
+9
View File
@@ -0,0 +1,9 @@
module Dodge.Creature.ChooseTarget
where
import Dodge.Data
import Dodge.Base
targetYouLOS :: Creature -> World -> Maybe Creature
targetYouLOS cr w
| hasLOS (_crPos cr) (_crPos $ you w) w = Just $ you w
| otherwise = Nothing
src/Dodge/Creature/ImpulseRat.hs
+26
View File
@@ -0,0 +1,26 @@
module Dodge.Creature.ImpulseRat
where
import Dodge.Data
import Dodge.Creature.ChooseTarget
import Dodge.Creature.Rationality.Data
import Geometry
chaseImpulse'
:: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> Creature
-> World
-> [Impulse]
chaseImpulse' targFunc cr w = case targFunc cr w of
Nothing -> []
Just crTarg -> chaseTarg cr crTarg
chaseTarg :: Creature -> Creature -> [Impulse]
chaseTarg cr crT
| dist tpos cpos < combinedRad + 5
&& abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
= [Melee (_crID crT)]
| otherwise = [MoveForward 3 , TurnToward 0.05 tpos]
where
cpos = _crPos cr
tpos = _crPos crT
combinedRad = _crRad cr + _crRad crT
src/Dodge/Creature/Rationality.hs
+15 -8
View File
@@ -5,10 +5,18 @@ import Dodge.Creature.Rationality.Data
import Dodge.Creature.Action
import Dodge.Creature.Action.UseItem
import System.Random
import Control.Lens
impulsiveAI
:: (Impulse -> World -> Creature -> (World -> World, Creature))
-> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
impulsiveAI = undefined
impulsiveAI impulseFunc w (f,g) cr
= (\(f''' ,cr) -> ((f''',g),Just cr))
$ foldr
(\imp (f' , cr') -> let (f'', cr'') = impulseFunc imp w cr' in (f'' . f', cr''))
(id, cr)
(_crImpulse $ _crRationality cr)
applyBasicImpulse
:: Impulse
@@ -16,11 +24,10 @@ applyBasicImpulse
-> Creature
-> (World -> World , Creature)
applyBasicImpulse imp w cr = case imp of
Move p = (id, creatureMove p cr)
Turn a = (id, creatureTurn a cr)
UseItem = (crUseItem cr, cr)
SwitchToItem i = (id, cr & crInvSel .~ i)
Wait t = (id, cr & crRationality . crImpulse . waitTime -~ 1
_ = (id, cr)
DropItem = undefined
Move p -> (id, creatureMove p cr)
Turn a -> (id, creatureTurn a cr)
UseItem -> (crUseItem cr, cr)
SwitchToItem i -> (id, cr & crInvSel .~ i)
_ -> (id, cr)
DropItem -> undefined
src/Dodge/Creature/Rationality/Data.hs
+6 -5
View File
@@ -9,20 +9,21 @@ import Control.Lens
data Rationality
= NonRat
| ImpulseRat
{_crImpulse :: Impulse }
{_crImpulse :: [Impulse] }
| ActionRat
{_crImpulse :: Impulse
{_crImpulse :: [Impulse]
,_crAction :: Action
}
| StrategyRat
{_crImpulse :: Impulse
{_crImpulse :: [Impulse]
,_crAction :: Action
,_crStrategy :: Strategy
}
data Impulse
= Move Point2
| MoveForward Float
| Turn Float
| TurnToward Float Point2
| UseItem
| SwitchToItem Int
| DropItem
@@ -30,8 +31,8 @@ data Impulse
| UseWorldObject Int
| Bark -- placeholder for various communication types
| UseIntrinsicAbility
| Melee Int
| ChangePosture Posture
| Wait {_waitTime :: Int}
data Action
= Attack Int
src/Dodge/Creature/State.hs
+6 -6
View File
@@ -99,7 +99,7 @@ sumDamage cr dm x = x + _dmAmount dm
movementSideEff :: Creature -> World -> World
movementSideEff cr w
| hasJetPack
= case cr ^? crState . stance . carriage of
= case cr ^? crStance . carriage of
Just (Boosting v)
-> makeFlameletTimed
(oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi))
@@ -110,7 +110,7 @@ movementSideEff cr w
$ set randGen g
w
_ -> w
| otherwise = case cr ^? crState . stance . carriage of
| otherwise = case cr ^? crStance . carriage of
Just (Walking x y) -> takeStep x y w
_ -> w
where hasJetPack = any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
@@ -154,12 +154,12 @@ updateMovement g cr
| isFrictionless cr
= (over crPos (+.+ momentum) $ setOldPos cr, g')
| otherwise
= case cr ^? crState . stance . carriage of
= case cr ^? crStance . carriage of
Just (Walking x y)
-> (set (crState . stance . carriage) (Walking ((x+y)`mod`120) 0)
-> (set (crStance . carriage) (Walking ((x+y)`mod`120) 0)
$ setOldPos
cr, g)
_ -> (set (crState . stance . carriage) (Walking 0 0)
_ -> (set (crStance . carriage) (Walking 0 0)
$ setOldPos
cr, g)
where
@@ -170,7 +170,7 @@ updateMovement g cr
(randAng,g') = randomR (0,2*pi) g
isFrictionless :: Creature -> Bool
isFrictionless cr = case cr ^? crState . stance . carriage of
isFrictionless cr = case cr ^? crStance . carriage of
Just (Boosting _) -> True
Just (Floating) -> True
_ -> False
src/Dodge/Creature/State/Data.hs
-1
View File
@@ -11,7 +11,6 @@ import Control.Lens
data CreatureState = CrSt
{ _goals :: [[Impulse]]
, _stance :: Stance
, _faction :: Faction
, _crDamage :: [DamageType]
, _crPastDamage :: [[DamageType]]
src/Dodge/Creature/YourControl.hs
+11 -11
View File
@@ -37,45 +37,45 @@ wasdWithAiming w speed aimSpeed i cr
-- = over crPos (+.+ (speed *.* mov))
= over crPos (+.+ (speed *.* unitVectorAtAngle mouseDir))
. set crDir mouseDir
$ set (crState . stance . carriage) (Boosting mov)
$ set (crStance . carriage) (Boosting mov)
cr
| any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving && isAiming
= set crDir mouseDir
$ set (crState . stance . carriage) Floating
$ set (crStance . carriage) Floating
cr
| any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving
= over crPos (+.+ (speed *.* mov))
. over crDir (flip fromMaybe dir)
$ set (crState . stance . carriage) (Boosting mov)
$ set (crStance . carriage) (Boosting mov)
cr
| any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isAiming
= set (crState . stance . carriage) Floating
= set (crStance . carriage) Floating
$ set crDir mouseDir
cr
| any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
= set (crState . stance . carriage) Floating
= set (crStance . carriage) Floating
cr
| isAiming
= stepForward aimSpeed
$ over crPos (+.+ (aimSpeed *.* mov))
$ set crDir mouseDir
$ set (crState . stance . carriage) (Walking 0 0)
$ set (crStance . carriage) (Walking 0 0)
cr
| isMoving
= stepForward speed
$ over crPos (+.+ (speed *.* mov))
$ over crDir (`fromMaybe` dir)
$ set (crState . stance . carriage) (Walking 0 0)
$ set (crStance . carriage) (Walking 0 0)
cr
| otherwise
= over crDir (`fromMaybe` dir)
$ set (crState . stance . carriage) Standing
$ set (crStance . carriage) Standing
cr
where
(mov',dir') = wasdComp (view keys w) w
(mov,dir) = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir')
isMoving = mov' /= (0,0)
isAiming = _posture (_stance $ _crState cr) == Aiming
isAiming = _posture (_crStance cr) == Aiming
mouseDir = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment of
Just (Just ItScope{_scopePos = p}) -> normalizeAngle $ argV
@@ -100,9 +100,9 @@ wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks
mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
mouseActionsCr keys cr
| rbPressed
= set ( crState . stance . posture) Aiming cr
= set ( crStance . posture) Aiming cr
| otherwise
= set ( crState . stance . posture) AtEase cr
= set ( crStance . posture) AtEase cr
where lbPressed = SDL.ButtonLeft `S.member` keys
rbPressed = SDL.ButtonRight `S.member` keys
src/Dodge/Data.hs
+3
View File
@@ -18,6 +18,7 @@ import Dodge.Picture.Layer.Data
import Dodge.Creature.Data
import Dodge.Creature.State.Data
import Dodge.Creature.Stance.Data
import Dodge.Creature.Rationality.Data
import Dodge.Data.Menu
import Dodge.Data.SoundOrigin
import Dodge.Data.DamageType
@@ -148,6 +149,8 @@ data Creature = Creature
, _crState :: CreatureState
, _crCorpse :: Picture
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
, _crStance :: Stance
, _crRationality :: Rationality
}
data WorldState
= DoorNumOpen Int
src/Dodge/Default.hs
+3 -1
View File
@@ -10,6 +10,7 @@ import Dodge.Item.Weapon.ExtraEffect
import Dodge.Data
import Dodge.Creature.Stance.Data
import Dodge.Creature.State.Data
import Dodge.Creature.Rationality.Data
import Dodge.Data.Menu
import Dodge.SoundLogic
import Dodge.Base
@@ -88,10 +89,11 @@ defaultCreature = Creature
, _crState = defaultState
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10
, _crApplyDamage = defaultApplyDamage
, _crStance = Stance {_carriage=Walking 0 0,_posture=AtEase}
, _crRationality = ImpulseRat []
}
defaultState = CrSt
{ _goals = []
, _stance = Stance {_carriage=Walking 0 0,_posture=AtEase}
, _faction = NoFaction
, _crDamage = []
, _crPastDamage = []