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

AI refactor

Browse Source
This commit is contained in:
jgk
2021-05-07 16:50:59 +02:00
parent 436043b169
commit 1aa59cc205
16 changed files with 295 additions and 340 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/AIs.hs
+2 -152
View File
@@ -1,6 +1,5 @@
module Dodge.AIs
( chaseAI
, basicShooterAI
( basicShooterAI
, twitchMissAI
, launcherAI
, chargeAI
@@ -62,70 +61,6 @@ replaceImpulse newActions = over (crState . goals) (\((_:as):ass) -> (newActions
addImpulse :: [Impulse] -> Creature -> Creature
addImpulse newActions = over (crState . goals) (\(as:ass) -> (newActions++as):ass)
chaseAI = expandToAI chaseAI'
chaseAI' :: World -> StdGen -> Creature -> (World -> World, StdGen, Creature)
chaseAI' w g' cr =
let cid = _crID cr
cpos = _crPos cr
hitCr i = over (creatures . ix i . crState . crDamage) addDam
. soundOnce (fromIntegral hitSound)
addDam dams = (( Blunt 100 cpos ypos ypos ) : dams )
ypos = _crPos $ you w
combinedRad = _crRad cr + _crRad (you w)
(a,g) = randomR (-0.2,0.2) g'
(wtime,g1) = randomR (15,25) g'
randomTurn = over crDir (+a)
isCrowded = (length $ IM.elems $ IM.filter isCloseFaction (_creatures w)) > 2
isCloseFaction cr' = _faction (_crState cr') == _faction (_crState cr)
&& dist cpos (_crPos cr') < 25
in case head $ _goals $ _crState cr of
[] -> (id, g', replaceGoal [] cr)
(Wait:_)
| dist cpos ypos < 900 && hasLOS cpos ypos w
-> (id, g', addGoal [[WaitFor wtime,MoveTo ypos]] cr)
| dist cpos ypos < 900 && hasLOSIndirect cpos ypos w
-> (id, g', addGoal [[WaitFor wtime,PathTo ypos]] cr)
| otherwise -> (id, g', cr)
(WaitFor x:gls)
| x == 0 -> (id, g', replaceImpulse [] cr)
| hasLOS cpos ypos w
-> (id, g', replaceImpulse [WaitFor (x-1)] $ crTurnTowardSpeed 0.05 ypos cr)
| otherwise -> (id, g', replaceImpulse [WaitFor (x-1)] cr )
(MoveTo p:gls)
| dist ypos cpos < combinedRad + 5 && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4
-> ( hitCr 0 , g'
, replaceImpulse [MeleeAttack 5]
$ over crPos (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos))) cr
)
| hasLOS cpos ypos w ->
( id , g , replaceImpulse [MoveTo ypos]
$ crMvForward 2.5 $ randomTurn $ crTurnTowardSpeed 0.05 p cr)
| dist p cpos < 10 -> ( id, g' , replaceImpulse [] cr)
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
-> ( id ,g' , crTurnTowardSpeed 0.05 p cr)
| otherwise -> ( id, g' , crMvForward 2.5 $ crTurnTowardSpeed 0.05 p cr)
(MoveToFor p x:gls)
| hasLOS cpos ypos w ->
( id , g , replaceImpulse [MoveTo ypos]
$ crMvForward 2.5 $ randomTurn $ crTurnTowardSpeed 0.05 p cr
)
| dist p cpos < 10 -> ( id , g , replaceImpulse [] cr)
| x == 0 -> ( id , g , replaceImpulse [] cr)
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 ->
( id , g , replaceImpulse [MoveToFor p (max 0 (x-1))] $ crTurnTowardSpeed 0.05 p cr)
| otherwise ->
( id , g , replaceImpulse [MoveToFor p (max 0 (x-1))]
$ crMvForward 2.5 $ crTurnTowardSpeed 0.05 p cr)
(PathTo p:_)
| dist p cpos < 10 -> ( id , g , replaceImpulse [] cr)
| hasLOS cpos p w -> ( id , g , addImpulse [MoveToFor p 10] cr)
| otherwise -> case pointTowardsImpulse cpos p w of
Just q -> ( id , g , addImpulse [MoveToFor q 10] cr)
_ -> ( id , g , replaceImpulse [] cr)
(MeleeAttack x:_)
| x == 0 -> ( id , g , replaceImpulse [WaitFor wtime] cr )
| otherwise -> ( id , g , replaceImpulse [MeleeAttack (x-1)] cr )
factionIs :: Faction -> Creature -> Bool
@@ -318,88 +253,6 @@ placeCrFaction cr fact p op rot w = over creatures addCr w
)
crs
---- meleeAI' :: Int -> World -> World
---- meleeAI' 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
---- combinedRad = _crRad cr + _crRad (you w)
---- (a,g) = randomR (-0.2,0.2) $ _randGen w
---- (wtime,g1) = randomR (15,25) $ _randGen w
---- randomTurn = set randGen g . over (creatures . ix cid . crDir) (+a)
---- randomTurn2 = set randGen g . over (creatures . ix cid . crDir) (+(signum a))
---- isCrowded = (length $ IM.elems $ IM.filter isCloseFaction (_creatures w)) > 2
---- isCloseFaction cr' = _faction (_crState cr') == ChaseCritters
---- && dist cpos (_crPos cr') < 25
---- 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 ypos 10]] w
---- | canSeeIndirect cid (_yourID w) w
---- -> addGoal [[PathTo ypos]] w
---- | otherwise -> replaceGoal [] 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
---- (MoveToFor p x:gls)
---- | dist ypos cpos < combinedRad + 5
---- && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4 -- same error as above
---- -- && x == 0
---- -> over (creatures . ix cid . crPos)
---- (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos)))
---- $ replaceImpulse [MeleeAttack 5]
---- $ damageYou
---- w
---- | x == 0 && isCrowded -> replaceImpulse [] $ randomTurn2 w
---- | canSee cid (_yourID w) w -> replaceGoal [[MoveToFor ypos (max 0 (x-1))]]
---- $ mvForward 2.5 cid $ randomTurn $ turnTowardSpeed 0.05 p cid w
---- | dist p cpos < 10 -> replaceImpulse [] w
---- | x == 0 -> replaceImpulse [] w
---- -- | not (canSeePoint cid p w) -> replaceImpulse [PathTo p] w
---- -- | not (canSeePoint cid p w) -> replaceImpulse [] w
---- | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
---- -> replaceImpulse [MoveToFor p (max 0 (x-1))] $ turnTowardSpeed 0.05 p cid w
---- | otherwise -> replaceImpulse [MoveToFor p (max 0 (x-1))]
---- $ mvForward 2.5 cid $ turnTowardSpeed 0.05 p cid w
---- (PathTo p:_)
---- | dist p cpos < 10 -> replaceImpulse [] w
---- | canSeePoint cid p w -> addImpulse [MoveToFor p 10] w
---- | otherwise ->
---- case pointTowardsImpulse' cpos p w of
---- Right q -> addImpulse [MoveToFor q 10]
---- -- $ drawCircleAtForCol q 10 magenta
---- -- $ drawLineForCol ((cpos : (concat $ maybeToList $ makePathBetweenPs
---- -- cpos p w)) ++ [p]) 50 red
---- w
---- --Left s -> error s
---- _ -> replaceImpulse [] w
---- (MeleeAttack x:_)
---- | x == 0 -> replaceImpulse [WaitFor wtime] w
---- | otherwise -> replaceImpulse [MeleeAttack (x-1)] w
---- (TrackYou:_) -> addGoal [[WaitFor wtime,PathTo ypos]] $ set randGen g1 w
---- (InitTrackYou:_)| canSeeIndirect cid (_yourID w) w -> replaceGoal [[TrackYou]] w
---- | otherwise -> w
---- (Guard p p':_) | canSeeIndirect cid (_yourID w) w
---- -> addGoal [[WaitFor wtime,PathTo ypos]] $ set randGen g1 w
---- | dist cpos p > 10
---- -> addGoal [[PathTo p]] w
---- | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
---- -> turnTowardSpeed 0.05 p' cid w
---- | otherwise -> w
---- (InitGuard :_) -> replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] w
-- be aware that the crit can be removed -- don't just refer to its id in the
-- world->world part
miniAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
@@ -1481,10 +1334,7 @@ basicShooterAI w (f,g) cr =
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
addImpulse newActions
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
-- autoFireTweak p | _wpIsAuto wp = Just
-- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]]
in --if _crHP cr <= 0 then killCr w f cr else
case head $ _goals $ _crState cr of
in case head $ _goals $ _crState cr of
[] | canSeeFire cpos ypos w -> ( ( f , g1 )
, replaceGoal [[AimAt ypos aimtime]] cr
)
src/Dodge/Creature.hs
+22 -14
View File
@@ -6,6 +6,9 @@ module Dodge.Creature
import Dodge.Creature.Stance.Data
import Dodge.Creature.State.Data
import Dodge.Creature.Impulse.Data
import Dodge.Creature.ImpulseRat
import Dodge.Creature.ActionRat
import Dodge.Creature.Rationality.Data
import Dodge.Data
import Dodge.AIs
import Dodge.Default
@@ -18,6 +21,7 @@ import Dodge.Creature.Inanimate
import Dodge.Creature.State
import Dodge.Creature.Picture
import Dodge.Creature.Rationality
import Dodge.Creature.ChooseTarget
import Dodge.Item
import Dodge.Picture.Layer
import Dodge.Creature.Picture
@@ -53,7 +57,7 @@ spawnerCrit = defaultCreature
}
smallChaseCrit :: Creature
smallChaseCrit = defaultCreature
{ _crUpdate = stateUpdate chaseAI
{ _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS
, _crHP = 1
, _crRad = 4
, _crPict = basicCrPict green
@@ -66,18 +70,7 @@ 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
{ _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS
, _crHP = 300
, _crPict = basicCrPict green
, _crState = defaultState
@@ -85,10 +78,11 @@ chaseCrit' = defaultCreature
,_faction = ChaseCritters
}
, _crInv = IM.empty
, _crMeleeCooldown = Just 0
}
armourChaseCrit :: Creature
armourChaseCrit = defaultCreature
{ _crUpdate = stateUpdate chaseAI
{ _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS
, _crHP = 300
, _crPict = basicCrPict green
, _crState = defaultState {_goals = [[Wait]]}
@@ -97,6 +91,20 @@ armourChaseCrit = defaultCreature
,(1,medkit 200)
]
}
miniGunCrit' :: Creature
miniGunCrit' = defaultCreature
{ _crPict = basicCrPict red
, _crUpdate = stateUpdate $ impulsiveAI $ actionUpdateAI $ shootAtTarget targetYouLOS
, _crInv = IM.fromList [(0,miniGun)]
, _crInvSel = 0
, _crRad = 10
, _crState = defaultState
, _crHP = 500
, _crRationality = ActionRat
{ _crImpulse = []
, _crAction = [AimAtCloseSlow 0 (0,0) 0.05 0.2 (pi/4) ]
}
}
miniGunCrit :: Creature
miniGunCrit = defaultCreature
{ _crPict = basicCrPict red
src/Dodge/Creature/Action.hs
+55 -86
View File
@@ -30,20 +30,11 @@ import System.Random
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
moveForwardSpeed
:: Float -- ^ Speed
-> Int -- ^ Creature id
-> World
-> World
moveForwardSpeed x n w = over (creatures . ix n . crPos) (+.+ p) w
where
p = (*.*) x $ unitVectorAtAngle $ _crDir $ _creatures w IM.! n
crStrafeLeft
:: Float -- ^ Speed
-> Creature
-> Creature
crStrafeLeft speed cr = stepForward s2 $ over crPos (+.+ p) cr
crStrafeLeft speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr
where
p = (*.*) s2 $ unitVectorAtAngle $ (_crDir cr + pi/2)
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
@@ -53,42 +44,12 @@ crStrafeRight
:: Float -- ^ Speed
-> Creature
-> Creature
crStrafeRight speed cr = stepForward s2 $ over crPos (+.+ p) cr
crStrafeRight speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr
where
p = (*.*) s2 $ unitVectorAtAngle $ (_crDir cr - pi/2)
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
s2 = (speed * equipFactor)
crMvForward
:: Float -- ^ Speed
-> Creature
-> Creature
crMvForward speed cr = over crPos (+.+ p) cr
where
p = (*.*) (speed * equipFactor) $ unitVectorAtAngle $ _crDir cr
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
crMvBy
:: Point2 -- ^ Movement translation vector
-> Creature
-> Creature
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 $ _crStance cr) == Aiming
= fromMaybe 1 $ it ^? itAimingSpeed
| otherwise = 1
it = _crInv cr IM.! _crInvSel cr
stepForward
:: Float -- ^ Speed
-> Creature
-> Creature
stepForward speed cr = over (crStance . carriage) f cr
where
f (w@Walking {}) = w {_stepToAdd = ceiling speed}
f s = s
turnTo
@@ -233,32 +194,7 @@ turnToward p n w
where
cr = _creatures w IM.! n
dirToTarget = argV (p -.- _crPos cr)
{- Move a creature forward in the direction it is facing. -}
moveForward
:: Int -- ^ Creature id
-> World
-> World
moveForward n w = over (creatures . ix n . crPos) (+.+ p) w
where
p = unitVectorAtAngle $ _crDir $ _creatures w IM.! n
{- Move a creature forward, faster if it is facing a target point -}
moveToward
:: Point2 -- ^ Target point
-> Int -- ^ Creature id
-> World
-> World
moveToward p n w
| angle < 10 = moveForwardSpeed 0.1 n w
| angle < 20 = moveForwardSpeed 0.02 n w
| angle < 40 = moveForwardSpeed 0.01 n w
| otherwise = w
where
angle = errorAngleVV 5 (p -.- curPos) (unitVectorAtAngle (_crDir (_creatures w IM.! n)))
curPos = _crPos (_creatures w IM.! n)
{- Translate a creature. -}
{- | Translate a creature. -}
moveBy
:: Int -- ^ Creature id
-> Point2 -- ^ Translation
@@ -280,7 +216,7 @@ reloadWeapon cid w =
$ set ( itRef . wpReloadState) rT w
_ -> Nothing
{- Start reloading if clip is empty. -}
{- | Start reloading if clip is empty. -}
crAutoReload :: Creature -> Creature
crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
Just 0 -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT)
@@ -290,7 +226,7 @@ crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
maxA = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo
{- Teleport a creature to the mouse position -}
{- | Teleport a creature to the mouse position -}
blinkAction
:: Int -- ^ Creature id
-> World
@@ -334,10 +270,7 @@ turnBy
-> World
-> World
turnBy a n = over (creatures . ix n . crDir) (+ a)
{-
Get your creature to drop the item under the cursor.
-}
{- | Get your creature to drop the item under the cursor. -}
youDropItem :: World -> World
youDropItem w = case yourItem w of
NoItem -> w
@@ -345,8 +278,7 @@ youDropItem w = case yourItem w of
. copyItemToFloor (you w) (_crInvSel $ you w)
$ soundOnce putDownSound
w
{- Copy an inventory item to the floor. -}
{- | Copy an inventory item to the floor. -}
copyItemToFloor
:: Creature
-> Int -- ^ Inventory position
@@ -354,9 +286,7 @@ copyItemToFloor
-> World
copyItemToFloor cr i w = case _crInv cr IM.! i of
NoItem -> w
it -> over floorItems (IM.insert flid theflit)
. updateLocation
$ set randGen g w
it -> over floorItems (IM.insert flid theflit) . updateLocation $ set randGen g w
where
(rot, g) = randomR (-pi,pi) $ _randGen w
offset = (_crRad cr + 2) *.* unitVectorAtAngle rot
@@ -370,16 +300,19 @@ copyItemToFloor cr i w = case _crInv cr IM.! i of
,_flItRot = rot
,_flItID = flid
}
{- Pick up a specific item. -}
pickUpItem :: FloorItem -> World -> World
pickUpItem flit w = case maybeInvSlot of
{- | Pick up a specific item. -}
pickUpItem
:: Int -- ^ Creature id
-> FloorItem
-> World
-> World
pickUpItem cid flit w = case maybeInvSlot of
Nothing -> w
Just i -> w
& soundOnce pickUpSound
& updateItLocation i
& floorItems %~ IM.delete (_flItID flit)
& creatures . ix 0 . crInv . ix i %~ addItem it
& creatures . ix cid . crInv . ix i %~ addItem it
where
it = _flIt flit
maybeInvSlot = checkInvSlotsYou it w
@@ -387,12 +320,48 @@ pickUpItem flit w = case maybeInvSlot of
Nothing -> w'
Just j -> w' & itemPositions . ix j .~ InInv 0 invid
{- | A creature attempts to move under its own steam.
{- | Creature attempts to moves under its own steam.
The idea is that this may or may not work, depending on the status of the creature.
For now, though, this cannot fail. -}
creatureMove :: Point2 -> Creature -> Creature
creatureMove p = crPos %~ (+.+ p)
crMvBy
:: Point2 -- ^ Movement translation vector
-> Creature
-> Creature
crMvBy p' cr = advanceStepCounter (magV p) $ over crPos (+.+ p) cr
where
p = (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p'
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
aimingFactor | (_posture $ _crStance cr) == Aiming
= fromMaybe 1 $ it ^? itAimingSpeed
| otherwise = 1
it = _crInv cr IM.! _crInvSel cr
crMvForward
:: Float -- ^ Speed
-> Creature
-> Creature
crMvForward speed cr = crMvBy (speed,0) cr
advanceStepCounter
:: Float -- ^ Speed
-> Creature
-> Creature
advanceStepCounter speed cr = over (crStance . carriage) f cr
where
f (w@Walking {}) = w {_stepToAdd = ceiling speed}
f s = s
creatureTurn :: Float -> Creature -> Creature
creatureTurn a = crDir +~ a
creatureTurnToward :: Point2 -> Float -> Creature -> Creature
creatureTurnToward p turnSpeed cr
| vToTarg == (0,0) = cr -- this should deal with the angleVV error
| errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
= cr & crDir .~ dirToTarget
| isLeftOfA dirToTarget (_crDir cr) = cr & crDir +~ turnSpeed
| otherwise = cr & crDir -~ turnSpeed
where
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
src/Dodge/Creature/ActionRat.hs
+25
View File
@@ -0,0 +1,25 @@
module Dodge.Creature.ActionRat
where
import Dodge.Data
import Dodge.Base.Collide
import Dodge.Creature.ChooseTarget
import Dodge.Creature.Rationality.Data
import Geometry
import Data.List
import Control.Lens
{- | Action update for a simple shooting creature -}
shootAtTarget
:: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> World
-> Creature
-> Creature
shootAtTarget targFunc w cr = case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crRationality . crAction %~ shootAtTarg w cr crTarg
shootAtTarg :: World -> Creature -> Creature -> [Action] -> [Action]
shootAtTarg w cr tcr as
| canSee (_crID cr) (_crID tcr) w = nub (ShootTillEmpty : as)
| otherwise = as
src/Dodge/Creature/ImpulseRat.hs
+41 -7
View File
@@ -5,21 +5,55 @@ import Dodge.Creature.ChooseTarget
import Dodge.Creature.Rationality.Data
import Geometry
chaseImpulse'
import Control.Lens
chaseTarget
:: (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
-> Creature
-> Creature
chaseTarget targFunc w cr = case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crRationality . crImpulse .~ chaseTarg cr crTarg
chaseTarg :: Creature -> Creature -> [Impulse]
chaseTarg cr crT
| dist tpos cpos < combinedRad + 5
&& abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
&& _crMeleeCooldown cr == Just 0
= [Melee (_crID crT)]
| otherwise = [MoveForward 3 , TurnToward 0.05 tpos]
| dist tpos cpos < combinedRad + 5
&& abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
= [ TurnToward tpos 0.05 ]
| abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
= [MoveForward 2.5 , TurnToward tpos 0.2, RandomTurn 0.2 ]
| otherwise = [MoveForward 2.5 , TurnToward tpos 0.05, RandomTurn 0.2 ]
where
cpos = _crPos cr
tpos = _crPos crT
combinedRad = _crRad cr + _crRad crT
impulseShootAtTarget
:: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> World
-> Creature
-> Creature
impulseShootAtTarget targFunc w cr = case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crRationality . crImpulse .~ impulseShootAtTarg cr crTarg
impulseShootAtTarg :: Creature -> Creature -> [Impulse]
impulseShootAtTarg 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 (tpos -.- cpos)) < pi/4
= [MoveForward 2.5 , TurnToward tpos 0.2, RandomTurn 0.2 ]
| otherwise = [MoveForward 2.5 , TurnToward tpos 0.05, RandomTurn 0.2 ]
where
cpos = _crPos cr
tpos = _crPos crT
src/Dodge/Creature/Picture.hs
+5 -1
View File
@@ -22,8 +22,9 @@ basicCrPict col cr = pictures [ onLayer CrLayer . piercingMod $ bluntScale naked
where
cdir = _crDir cr
naked
| strikeMelee = color white $ circleSolid $ _crRad cr
| pdam > 200 = color red $ circleSolid $ _crRad cr
| pdam > 100 = color white $ circleSolid $ _crRad cr
| pdam > 99 = color white $ circleSolid $ _crRad cr
| otherwise = pictures [color col' $ circleSolid $ _crRad cr, circLine $ _crRad cr]
pastDams = _crPastDamage $ _crState cr
pdam = sum $ concatMap (map _dmAmount) $ pastDams
@@ -41,6 +42,9 @@ basicCrPict col cr = pictures [ onLayer CrLayer . piercingMod $ bluntScale naked
piercingMod = case fmap argV piercingDam of
Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
_ -> id
strikeMelee = case _crMeleeCooldown cr of
Nothing -> False
Just x -> x > 5
drawEquipment
:: Creature
src/Dodge/Creature/Rationality.hs
+84 -12
View File
@@ -1,33 +1,105 @@
module Dodge.Creature.Rationality
where
import Dodge.Data
import Dodge.Base.Collide
import Dodge.Creature.Rationality.Data
import Dodge.Creature.Action
import Dodge.Creature.Action.UseItem
import Dodge.Creature.State.Data
import Dodge.SoundLogic
import Geometry
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import System.Random
import Control.Lens
impulsiveAI
:: (Impulse -> World -> Creature -> (World -> World, Creature))
-> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
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)
:: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
-> World
-> (World -> World,StdGen)
-> Creature
-> ((World -> World,StdGen), Maybe Creature)
impulsiveAI impF w (f,g) = followImpulses w (f,g) . impF w
applyBasicImpulse
followImpulses
:: World
-> (World -> World,StdGen)
-> Creature
-> ((World -> World,StdGen), Maybe Creature)
followImpulses w (f,g) cr
= (\(f''' ,cr) -> ((f''',g'),Just cr))
$ foldr
(\imp (f' , cr') -> let (f'', cr'') = followImpulse imp w cr' in (f'' . f', cr''))
(f, cr)
(_crImpulse $ _crRationality cr)
where
g' = snd $ next g
followImpulse
:: Impulse
-> World
-> Creature
-> (World -> World , Creature)
applyBasicImpulse imp w cr = case imp of
Move p -> (id, creatureMove p cr)
followImpulse imp w cr = case imp of
Move p -> (id, crMvBy p cr)
MoveForward x -> (id, crMvForward x cr)
Turn a -> (id, creatureTurn a cr)
TurnToward p a -> (id, creatureTurnToward p a cr)
UseItem -> (crUseItem cr, cr)
SwitchToItem i -> (id, cr & crInvSel .~ i)
_ -> (id, cr)
Melee crID ->
(hitCr crID
, crMvBy (10 *.* normalizeV (posFromID crID -.- cpos)) $ cr & crMeleeCooldown ?~ 20) -- randomise cooldown?
RandomTurn a -> (id, creatureTurn (rr a) cr)
_ -> (id , cr)
DropItem -> undefined
where
cpos = _crPos cr
posFromID cid = _crPos $ _creatures w IM.! cid
rr a = fst $ randomR (-a,a) $ _randGen w
hitCr i = over (creatures . ix i . crState . crDamage) (addDam i)
. soundOnce (fromIntegral hitSound)
addDam i dams = (( Blunt 100 cpos (posFromID i) (posFromID i) ) : dams )
actionUpdateAI
:: (World -> Creature -> Creature) -- ^ the function updating the actions
-> World
-> Creature
-> Creature
actionUpdateAI actF w c = performActions w $ actF w c
performActions :: World -> Creature -> Creature
performActions w cr = cr
& crRationality . crImpulse .~ concat iss
& crRationality . crAction .~ catMaybes mayas
where
(iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crRationality . crAction
{- | Performing an action means that a creature has some impulses for a frame, and
updates or deletes the action itself. -}
performAction
:: Creature
-> World
-> Action
-> ( [Impulse] , Maybe Action )
performAction cr w ac = case ac of
ShootTillEmpty -> case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
Just x | x > 0 -> ( [UseItem] , Just ShootTillEmpty )
_ -> ( [] , Nothing )
AimAtCloseSlow tcid p speed slowSpeed a
| canSee (_crID cr) tcid w && abs (normalizeAngle $ cdir - argV (tpos -.- cpos)) < a
-> ([TurnToward tpos slowSpeed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
| canSee (_crID cr) tcid w
-> ([TurnToward tpos speed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
| abs (normalizeAngle (cdir - (argV (p -.- cpos)))) < a
-> ([TurnToward p slowSpeed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
| otherwise -> ([TurnToward p speed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
where
tpos = _crPos (_creatures w IM.! tcid)
ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss)
ImpulsesList _ -> ([], Nothing)
where
cpos = _crPos cr
cdir = _crDir cr
src/Dodge/Creature/Rationality/Data.hs
+16 -3
View File
@@ -12,18 +12,19 @@ data Rationality
{_crImpulse :: [Impulse] }
| ActionRat
{_crImpulse :: [Impulse]
,_crAction :: Action
,_crAction :: [Action]
}
| StrategyRat
{_crImpulse :: [Impulse]
,_crAction :: Action
,_crAction :: [Action]
,_crStrategy :: Strategy
}
data Impulse
= Move Point2
| MoveForward Float
| Turn Float
| TurnToward Float Point2
| RandomTurn Float
| TurnToward Point2 Float
| UseItem
| SwitchToItem Int
| DropItem
@@ -33,9 +34,18 @@ data Impulse
| UseIntrinsicAbility
| Melee Int
| ChangePosture Posture
deriving (Eq,Ord,Show)
data Action
= Attack Int
| AimAtCloseSlow
{_targetID :: Int
,_targetSeenAt :: Point2
,_aimSpeed :: Float
,_slowAimSpeed :: Float
,_slowAimAngle :: Float
}
| MeleeAttack Point2 Int
| PathTo Point2
| FleeFrom Int
| HealSelf
@@ -44,6 +54,9 @@ data Action
| SearchFor Int
| Search
| PickupItem Int
| ShootTillEmpty
| ImpulsesList [[Impulse]]
deriving (Eq,Ord,Show)
data Strategy
= Flank Int
src/Dodge/Creature/Stance/Data.hs
+1 -1
View File
@@ -18,7 +18,7 @@ data Carriage
| Boosting Point2
deriving (Eq,Show)
data Posture = Aiming | AtEase
deriving (Eq,Show)
deriving (Eq,Ord,Show)
makeLenses ''Stance
makeLenses ''Carriage
src/Dodge/Creature/State.hs
+3
View File
@@ -36,6 +36,9 @@ import Control.Concurrent
type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
meleeCooldown :: CRUpdate -> CRUpdate
meleeCooldown u w (f,g) cr = u w (f,g) $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
-- | The movement is updated before the ai in order to correctly set the oldpos.
-- the whole of this update cycle could do with a rethink, it is becoming
-- convoluted
src/Dodge/Creature/YourControl.hs
+18 -48
View File
@@ -20,62 +20,32 @@ import System.Random
yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
yourControl w (f,g) cr = ( (updateUsingInput . f, g)
, Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr
, Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr
)
where
strafeSpeed = _varMovementSpeedModifier w * equipFactor * fromMaybe 1 (yourItem w ^? itAimingSpeed)
speed = _varMovementSpeedModifier w * equipFactor
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0
{-
Turns key presses into creature movement.
-}
wasdWithAiming :: World -> Float -> Float -> Int -> Creature -> Creature
wasdWithAiming w speed aimSpeed i cr
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming
&& diffAngles mouseDir (argV mov) < pi/2
-- = over crPos (+.+ (speed *.* mov))
= over crPos (+.+ (speed *.* unitVectorAtAngle mouseDir))
. set crDir mouseDir
$ set (crStance . carriage) (Boosting mov)
cr
| any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving && isAiming
= set crDir mouseDir
$ set (crStance . carriage) Floating
cr
| any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving
= over crPos (+.+ (speed *.* mov))
. over crDir (flip fromMaybe dir)
$ set (crStance . carriage) (Boosting mov)
cr
| any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isAiming
= set (crStance . carriage) Floating
$ set crDir mouseDir
cr
| any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
= set (crStance . carriage) Floating
cr
wasdWithAiming :: World -> Float -> Int -> Creature -> Creature
wasdWithAiming w speed i cr
| isAiming
= stepForward aimSpeed
$ over crPos (+.+ (aimSpeed *.* mov))
$ set crDir mouseDir
$ set (crStance . carriage) (Walking 0 0)
= set crDir mouseDir
$ crMvBy (speed *.* mov)
cr
| isMoving
= stepForward speed
$ over crPos (+.+ (speed *.* mov))
$ over crDir (`fromMaybe` dir)
$ set (crStance . carriage) (Walking 0 0)
= crMvForward speed -- controls the base speed
$ over crDir (`fromMaybe` dir)
cr
| otherwise
= over crDir (`fromMaybe` dir)
$ set (crStance . carriage) Standing
cr
| otherwise = cr
where
(mov',dir') = wasdComp (view keys w) w
(mov,dir) = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir')
isMoving = mov' /= (0,0)
dir = fmap (_cameraRot w +) dir'
mov = rotateV (negate $ _crDir cr) mov'
isAiming = _posture (_crStance cr) == Aiming
isMoving = mov' /= (0,0)
mouseDir = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment of
Just (Just ItScope{_scopePos = p}) -> normalizeAngle $ argV
@@ -97,12 +67,12 @@ wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks
where f (0,0) = ((0,0), Nothing)
f p = (errorNormalizeV 46 p, Just $ argV p)
{- | Set posture according to mouse presses. -}
mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
mouseActionsCr keys cr
| rbPressed
= set ( crStance . posture) Aiming cr
| otherwise
= set ( crStance . posture) AtEase cr
where lbPressed = SDL.ButtonLeft `S.member` keys
rbPressed = SDL.ButtonRight `S.member` keys
mouseActionsCr keys
| rbPressed = crStance . posture .~ Aiming
| otherwise = crStance . posture .~ AtEase
where
lbPressed = SDL.ButtonLeft `S.member` keys
rbPressed = SDL.ButtonRight `S.member` keys
src/Dodge/Data.hs
+1
View File
@@ -151,6 +151,7 @@ data Creature = Creature
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
, _crStance :: Stance
, _crRationality :: Rationality
, _crMeleeCooldown :: Maybe Int
}
data WorldState
= DoorNumOpen Int
src/Dodge/Default.hs
+1
View File
@@ -91,6 +91,7 @@ defaultCreature = Creature
, _crApplyDamage = defaultApplyDamage
, _crStance = Stance {_carriage=Walking 0 0,_posture=AtEase}
, _crRationality = ImpulseRat []
, _crMeleeCooldown = Nothing
}
defaultState = CrSt
{ _goals = []
src/Dodge/Event/Keyboard.hs
+6 -10
View File
@@ -34,10 +34,7 @@ see 'handlePressedKeyInGame'.
handleKeyboardEvent :: KeyboardEventData -> World -> Maybe World
handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
Released -> Just $ w & keys %~ S.delete kcode
Pressed -> handlePressedKey
(keyboardEventRepeat kev)
kcode
(w & keys %~ S.insert kcode)
Pressed -> handlePressedKey (keyboardEventRepeat kev) kcode (w & keys %~ S.insert kcode)
where
kcode = (keysymScancode . keyboardEventKeysym) kev
@@ -57,12 +54,11 @@ handlePressedKeyInGame scode w
handlePressedKeyInGame _ w = Just w
handlePressedKey :: Bool -> Scancode -> World -> Maybe World
handlePressedKey True _ w = Just w
handlePressedKey True _ w = Just w
handlePressedKey _ scode w
| null (_menuLayers w)
= handlePressedKeyInGame scode w
| otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w
handlePressedKey _ _ w = Just w
| null (_menuLayers w) = handlePressedKeyInGame scode w
| otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w
handlePressedKey _ _ w = Just w
debugKey :: Scancode -> World -> Maybe World
debugKey scancode w
@@ -78,7 +74,7 @@ spaceAction w = if _carteDisplay w
w & carteCenter .~ theLoc
else
case listToMaybe $ _closeActiveObjects w of
Just (Left flit) -> pickUpItem flit w
Just (Left flit) -> pickUpItem 0 flit w
Just (Right but) -> updateTopCloseObject (_btID but) $ _btEvent but but w
Nothing -> w
where
src/Dodge/Floor.hs
+3 -2
View File
@@ -49,8 +49,9 @@ roomTreex = do
t = treeFromTrunk
[[StartRoom]
,[Corridor]
,[Corridor]
,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 200]
,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
& rmPS %~ (PS (0,0) 0 (PutCrit miniGunCrit') :)
]
,[Corridor]
,[Corridor]
,[SpecificRoom . fmap (pure . Right) $ twinSlowDoorChasers 30]
src/Geometry/Vector.hs
+12 -4
View File
@@ -87,10 +87,18 @@ Always positive.
-}
angleVV :: Point2 -> Point2 -> Float
{-# INLINE angleVV #-}
angleVV a b = let ma = magV a
mb = magV b
d = a `dotV` b
in acos $ d / (ma * mb)
angleVV a b =
let ma = magV a
mb = magV b
d = a `dotV` b
in acos $ d / (ma * mb)
{- | Safe version of 'angleVV' that returns 0 if either vector is null. -}
safeAngleVV :: Point2 -> Point2 -> Float
{-# INLINE safeAngleVV #-}
safeAngleVV a b
| a == (0,0) || b == (0,0) = 0
| otherwise = angleVV a b
{- | Dot product.
-}