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

Refactor ai

Browse Source
This commit is contained in:
justin
2021-05-12 14:24:31 +02:00
parent 86faf9fd01
commit ead87af3c1
25 changed files with 718 additions and 453 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+8
View File
@@ -355,6 +355,14 @@ advanceStepCounter speed cr = over (crStance . carriage) f cr
creatureTurn :: Float -> Creature -> Creature
creatureTurn a = crDir +~ a
creatureTurnTo :: Point2 -> Creature -> Creature
creatureTurnTo p cr
| vToTarg == (0,0) = cr -- this should deal with the angleVV error
| otherwise = cr & crDir .~ dirToTarget
where
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
creatureTurnToward :: Point2 -> Float -> Creature -> Creature
creatureTurnToward p turnSpeed cr
| vToTarg == (0,0) = cr -- this should deal with the angleVV error
src/Dodge/Creature/Action/UseItem.hs
+2 -1
View File
@@ -13,7 +13,8 @@ useItem :: Int -> World -> World
useItem n w = equippedItemEffect n w
crUseItem :: Creature -> World -> World
crUseItem cr = itemEffect (_crID cr) (_crInv cr IM.! _crInvSel cr)
--crUseItem cr = itemEffect (_crID cr) (_crInv cr IM.! _crInvSel cr)
crUseItem cr = tryUseItem (_crID cr)
tryUseItem
:: Int -- ^ Creature id
src/Dodge/Creature/ActionRat.hs
+194 -7
View File
@@ -1,25 +1,212 @@
module Dodge.Creature.ActionRat
( shootTargetWithStrat
, suppressShootTarget
, suppress
, shootAdvance
, shootFirstMiss
, doStrategyActions
, reloadOverride
, shootAdvanceStrat
, watchUpdateStrat
, goToPostStrat
, overrideInternal
)
where
import Dodge.Data
import Dodge.Base
import Dodge.Base.Collide
import Dodge.Creature.ChooseTarget
import Dodge.Creature.Rationality.Data
import Dodge.Creature.Stance.Data
import Dodge.Creature.Test
import Geometry
import Data.List
import qualified Data.IntMap.Strict as IM
import Control.Lens
shootTargetWithStrat
:: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> (World -> Creature -> Creature -> [Action] -> [Action])
-- ^ Function for determining shooting strategy given target
-> World
-> Creature
-> Creature
shootTargetWithStrat targFunc strat w cr = case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . crAction %~ strat w cr crTarg
{- | Action update for a simple shooting creature -}
shootAtTarget
suppressShootTarget
:: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> World
-> Creature
-> Creature
shootAtTarget targFunc w cr = case targFunc cr w of
suppressShootTarget targFunc w cr = case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crRationality . crAction %~ shootAtTarg w cr crTarg
Just crTarg -> cr & crActionPlan . crAction %~ suppress 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
suppress :: World -> Creature -> Creature -> [Action] -> [Action]
suppress w cr tcr as
| canSee (_crID cr) (_crID tcr) w && cr ^. crStance . posture /= Aiming
&& cr ^? crInv . ix (_crInvSel cr) . wpReloadState == Just 0 =
[ DrawWeapon
, WaitThen 50 ShootTillEmpty
, AimAtCloseSlow
{ _targetID = _crID tcr
, _targetSeenAt = _crPos cr
, _aimSpeed = 0.2
, _slowAimSpeed = 0.01
, _slowAimAngle = pi/4
}
]
| otherwise = as
shootFirstMiss :: Int -> World -> Creature -> Strategy
shootFirstMiss tcid w cr = StrategyActions acs (ShootAt tcid)
where
acs =
[ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction))
`DoActionThen`
LeadTarget (10,50)
`DoActionThen`
advanceShoot
`DoActionThen`
LeadTarget (50,0)
`DoActionThen`
(advanceShoot `DoActionWhileThen` lostest
$ DoReplicateThen advanceShoot 75
$ DoImpulses [ChangeStrategy WatchAndWait]
)
]
lostest (w,cr') = canSee (_crID cr') tcid w
advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
shootAdvanceStrat :: Int -> World -> Creature -> Strategy
shootAdvanceStrat tcid _ _ = StrategyActions acs (ShootAt tcid)
where
acs =
[ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction))
`DoActionThen`
(DoActionWhileThen advanceShoot lostest
. DoReplicateThen advanceShoot 75
$ DoImpulses [ChangeStrategy WatchAndWait]
)
, AimAtCloseSlow
{ _targetID = tcid
, _targetSeenAt = (0,0) -- hack
, _aimSpeed = 0.2
, _slowAimSpeed = 0.01
, _slowAimAngle = pi/8
}
]
lostest (w,cr') = canSee (_crID cr') tcid w
advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
goToPostStrat :: World -> Creature -> Strategy
goToPostStrat w cr = case find sentinelGoal $ _crGoal $ _crActionPlan cr of
Just (SentinelAt p _) -> StrategyActions
[DoActionThen (WaitThen 150 holsterIfAiming)
$ DoActionThen (PathTo p)
NoAction
-- $ DoImpulses [ChangeStrategy WatchAndWait]
] $ GetTo p
_ -> WatchAndWait
where
sentinelGoal (SentinelAt p dir) = True
sentinelGoal _ = False
holsterIfAiming
| crIsAiming (w,cr) = HolsterWeapon
| otherwise = NoAction
overrideInternal
:: ((World , Creature) -> Bool)
-> (World -> Creature -> Creature)
-> World
-> Creature
-> Creature
overrideInternal test update w cr
| test (w,cr) = update w cr
| otherwise = cr
shootAdvance :: World -> Creature -> Creature -> [Action] -> [Action]
shootAdvance w cr tcr as
| lostest (w,cr) && cr ^. crStance . posture /= Aiming
&& cr ^? crInv . ix (_crInvSel cr) . wpReloadState == Just 0 =
[ DrawWeapon
, DoImpulses [ChangeStrategy $ ShootAt $ _crID tcr]
, WaitThen 50
. DoActionWhileThen advanceShoot lostest
. DoReplicateThen advanceShoot 50
$ DoImpulses [ChangeStrategy WatchAndWait]
, AimAtCloseSlow
{ _targetID = _crID tcr
, _targetSeenAt = _crPos cr
, _aimSpeed = 0.2
, _slowAimSpeed = 0.01
, _slowAimAngle = pi/8
}
]
| cr ^. crStance . posture == Aiming && cr ^? crInv . ix (_crInvSel cr) . wpReloadState /= Just 0
= [ HolsterWeapon ]
| otherwise = as
where
lostest (w,cr') = canSee (_crID cr) (_crID tcr) w
advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
applyNewStrategies
:: World
-> Creature
-> Creature
applyNewStrategies w cr = case cr ^? crActionPlan . crStrategy of
Just (StrategyActions acs strat) -> cr & crActionPlan . crAction .~ acs
& crActionPlan . crStrategy .~ strat
otherwise -> cr
doStrategyActions
:: World
-> Creature
-> Creature
doStrategyActions w cr = case cr ^? crActionPlan . crStrategy of
Just (StrategyActions acs strat) -> cr & crActionPlan . crAction .~ acs
& crActionPlan . crStrategy .~ strat
otherwise -> cr
updateShoot
:: World
-> Creature
-> Creature
updateShoot w cr = case _crStrategy $ _crActionPlan cr of
WatchAndWait -> undefined
reloadOverride
:: World
-> Creature
-> Creature
reloadOverride _ cr
| cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0
&& cr ^. crStance . posture == Aiming
= cr & crActionPlan . crStrategy .~ StrategyActions reloadActions Reload
| otherwise = cr
where
reloadActions =
[ HolsterWeapon
, WaitThen 1 $ DoActionWhileThen NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait])
]
watchUpdateStrat
:: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ]
-> World
-> Creature
-> Creature
watchUpdateStrat fs w cr = case cr ^? crActionPlan . crStrategy of
Just WatchAndWait -> cr
& crActionPlan . crStrategy .~ listGuard (fs, (\_ _ -> WatchAndWait)) (w, cr) w cr
_ -> cr
listGuard :: ([(a -> Bool, b)] , b) -> a -> b
listGuard ( (test,y):ps, z ) x
| test x = y
| otherwise = listGuard (ps, z) x
listGuard (_,z) _ = z
src/Dodge/Creature/ImpulseRat.hs
+2 -2
View File
@@ -14,7 +14,7 @@ chaseTarget
-> Creature
chaseTarget targFunc w cr = case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crRationality . crImpulse .~ chaseTarg cr crTarg
Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg
chaseTarg :: Creature -> Creature -> [Impulse]
chaseTarg cr crT
@@ -40,7 +40,7 @@ impulseShootAtTarget
-> Creature
impulseShootAtTarget targFunc w cr = case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crRationality . crImpulse .~ impulseShootAtTarg cr crTarg
Just crTarg -> cr & crActionPlan . crImpulse .~ impulseShootAtTarg cr crTarg
impulseShootAtTarg :: Creature -> Creature -> [Impulse]
impulseShootAtTarg cr crT
src/Dodge/Creature/Inanimate.hs
+1 -3
View File
@@ -20,7 +20,7 @@ import Picture
import qualified Data.IntMap.Strict as IM
import Control.Lens
defaultInanimate = defaultCreature & crState . crIsAnimate .~ False
defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
lamp :: Creature
lamp = defaultInanimate
@@ -60,7 +60,6 @@ barrel = defaultInanimate
]
, _crState = defaultState
{_goals = [[Wait]]
,_faction = ChaseCritters
,_crSpState = Barrel []
}
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
@@ -76,7 +75,6 @@ explosiveBarrel = defaultInanimate
]
, _crState = defaultState
{_goals = [[Wait]]
,_faction = ChaseCritters
,_crSpState = Barrel []
}
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
src/Dodge/Creature/Picture.hs
+3 -2
View File
@@ -6,6 +6,7 @@ module Dodge.Creature.Picture
, circLine
) where
import Dodge.Data
import Dodge.Creature.Stance.Data
import Dodge.Creature.State.Data
import Dodge.Creature.AlertLevel.Data
import Dodge.Picture.Layer
@@ -21,7 +22,7 @@ basicCrPict
-> Picture
basicCrPict col cr = pictures
[ onLayer CrLayer . piercingMod $ bluntScale naked
, drawAwakeLevel cr
-- , drawAwakeLevel cr
, drawEquipment cr
]
where
@@ -66,7 +67,7 @@ drawEquipment
drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr)
where
f (i,it) = case it ^? itEquipPict of
Just g -> g cr i
Just g | (cr ^? crStance . posture) == Just Aiming -> g cr i
_ -> blank
circLine x = line [(0,0),(x,0)]
src/Dodge/Creature/Rationality.hs
+51 -10
View File
@@ -6,6 +6,7 @@ import Dodge.Creature.Rationality.Data
import Dodge.Creature.Action
import Dodge.Creature.Action.UseItem
import Dodge.Creature.State.Data
import Dodge.Creature.Stance.Data
import Dodge.SoundLogic
import Geometry
@@ -14,6 +15,8 @@ import qualified Data.IntMap.Strict as IM
import System.Random
import Control.Lens
-- Alternatives would probably be a very good fit for actions...
composeInternalAIs
:: [World -> Creature -> Creature]
-> World
@@ -39,7 +42,7 @@ followImpulses w (f,g) cr
$ foldr
(\imp (f' , cr') -> let (f'', cr'') = followImpulse imp w cr' in (f'' . f', cr''))
(f, cr)
(_crImpulse $ _crRationality cr)
(_crImpulse $ _crActionPlan cr)
where
g' = snd $ next g
@@ -53,14 +56,20 @@ followImpulse imp w cr = case imp of
MoveForward x -> (id, crMvForward x cr)
Turn a -> (id, creatureTurn a cr)
TurnToward p a -> (id, creatureTurnToward p a cr)
-- UseItem -> (crUseItem cr, cr)
TurnTo p -> (id, creatureTurnTo p cr)
ChangePosture post -> (id, cr & crStance . posture .~ post)
UseItem -> (crUseItem cr, cr)
SwitchToItem i -> (id, cr & crInvSel .~ i)
Melee crID ->
(hitCr crID
, crMvBy (10 *.* normalizeV (posFromID crID -.- cpos)) $ cr & crMeleeCooldown ?~ 20) -- randomise cooldown?
RandomTurn a -> (id, creatureTurn (rr a) cr)
_ -> (id , cr)
MakeSound sid -> ( soundOnceOrigin sid (CrSound (_crID cr)) (_crPos cr) , cr )
DropItem -> undefined
ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat)
AddGoal gl -> (id, cr & crActionPlan . crGoal %~ (gl :) )
ArbitraryCreatureImpulse f -> (id, f w cr)
_ -> (id , cr)
where
cpos = _crPos cr
posFromID cid = _crPos $ _creatures w IM.! cid
@@ -78,10 +87,10 @@ 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
& crActionPlan . crImpulse .~ concat iss
& crActionPlan . crAction .~ catMaybes mayas
where
(iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crRationality . crAction
(iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . crAction
{- | Performing an action means that a creature has some impulses for a frame, and
updates or deletes the action itself. -}
@@ -91,9 +100,9 @@ performAction
-> 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 )
ShootTillEmpty -> case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of
Just x | x == 0 -> ( [UseItem] , Just ShootTillEmpty )
_ -> ( [] , Just (WaitThen 20 HolsterWeapon) )
AimAtCloseSlow tcid p speed slowSpeed a
| canSee (_crID cr) tcid w && safeAngleVV (unitVectorAtAngle cdir) (tpos -.- cpos) < a
-> ([TurnToward tpos slowSpeed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
@@ -104,9 +113,41 @@ performAction cr w ac = case ac of
| otherwise -> ([TurnToward p speed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
where
tpos = _crPos (_creatures w IM.! tcid)
WaitThen 0 newAc -> ([] , Just newAc)
WaitThen t newAc -> ([] , Just (WaitThen (t-1) newAc))
ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss)
ImpulsesList _ -> ([], Nothing)
DoImpulses imps -> (imps, Nothing)
DrawWeapon -> ([ChangePosture Aiming, MakeSound pickUpSound] , Nothing)
HolsterWeapon -> ([ChangePosture AtEase, MakeSound putDownSound] , Nothing)
DoActionThen ac ac' -> case performAction cr w ac of
(imps , Just ac'') -> (imps, Just (DoActionThen ac'' ac'))
(imps , Nothing ) -> (imps, Just ac')
DoActionWhile ac f
| f (w,cr) -> (fst $ performAction cr w ac, Just $ DoActionWhile ac f)
| otherwise -> ([], Nothing)
DoActionIfElse ac f ac'
| f (w,cr) -> performAction cr w ac
| otherwise -> performAction cr w ac'
DoActionWhileThen ac f ac'
| f (w,cr) -> (fst $ performAction cr w ac, Just $ DoActionWhileThen ac f ac')
| otherwise -> performAction cr w ac'
DoReplicateThen ac 0 ac' -> performAction cr w ac'
DoReplicateThen ac t ac' -> (fst $ performAction cr w ac, Just $ DoReplicateThen ac (t-1) ac')
DoActions [] -> ([], Nothing)
DoActions acs ->
let (imps, newAcs) = unzip $ map (performAction cr w) acs
in (concat imps, Just . DoActions $ catMaybes newAcs)
StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing)
PathTo p
| dist cpos p < 5 -> ([], Nothing)
| 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)
_ -> ([], Nothing)
_ -> ([], Nothing)
where
cpos = _crPos cr
cdir = _crDir cr
src/Dodge/Creature/Rationality/Data.hs
-61
View File
@@ -6,64 +6,3 @@ import Dodge.Creature.Stance.Data
import Geometry.Data
import Control.Lens
data Rationality
= NonRat
| ImpulseRat
{_crImpulse :: [Impulse] }
| ActionRat
{_crImpulse :: [Impulse]
,_crAction :: [Action]
}
| StrategyRat
{_crImpulse :: [Impulse]
,_crAction :: [Action]
,_crStrategy :: Strategy
}
data Impulse
= Move Point2
| MoveForward Float
| Turn Float
| RandomTurn Float
| TurnToward Point2 Float
| UseItem
| SwitchToItem Int
| DropItem
| PickupNearby Int
| UseWorldObject Int
| Bark -- placeholder for various communication types
| 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
| DefendSelf
| Protect Int
| SearchFor Int
| Search
| PickupItem Int
| ShootTillEmpty
| ImpulsesList [[Impulse]]
deriving (Eq,Ord,Show)
data Strategy
= Flank Int
| Ambush Int
| Lure Int Point2
| GuardArea Point2
| Patrol [Point2]
makeLenses ''Rationality
makeLenses ''Impulse
src/Dodge/Creature/SetTarget.hs
+16
View File
@@ -0,0 +1,16 @@
{- |
Deals with setting a target for creatures
-}
module Dodge.Creature.SetTarget
where
import Dodge.Data
import Dodge.Creature.AlertLevel.Data
import Control.Lens
targetYouWhenCognizant
:: World
-> Creature
-> Creature
targetYouWhenCognizant w cr = case cr ^? crAwarenessLevel . ix 0 of
Just (Cognizant _) -> cr & crTarget .~ Just 0
_ -> cr & crTarget .~ Nothing
src/Dodge/Creature/State.hs
+69 -69
View File
@@ -116,23 +116,24 @@ movementSideEff cr w
| 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
oldPos = _crOldPos cr
momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr)
momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum'
| otherwise = momentum'
momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng
(randDir,g) = randomR (-0.5,0.5) $ _randGen w
(randAng,_) = randomR (0,2*pi) $ _randGen w
where
hasJetPack = any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
oldPos = _crOldPos cr
momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr)
momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum'
| otherwise = momentum'
momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng
(randDir,g) = randomR (-0.5,0.5) $ _randGen w
(randAng,_) = randomR (0,2*pi) $ _randGen w
(v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w
(r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[])
(v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w
(r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[])
crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5
takeStep x y | crHasMoved && x < 20 && x + y >= 20 = soundMultiFrom footor 22 3 0
| crHasMoved && x < 80 && x + y >= 80 = soundMultiFrom footor 23 3 0
| otherwise = id
footor = [FootstepSound 0,FootstepSound 1]
crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5
takeStep x y | crHasMoved && x < 20 && x + y >= 20 = soundMultiFrom footor 22 3 0
| crHasMoved && x < 80 && x + y >= 80 = soundMultiFrom footor 23 3 0
| otherwise = id
footor = [FootstepSound 0,FootstepSound 1]
invSideEff :: Creature -> World -> World
invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
@@ -142,29 +143,22 @@ invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
weaponReloadSounds :: Creature -> World -> World
weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
Just (Weapon {_wpReloadState = 0})
-> w
Just (Weapon {_wpReloadState = 1})
-> stopSoundFrom (CrReloadSound cid) w
Just (Weapon {})
-> soundFrom (CrReloadSound cid) reloadSound (1) 0 w
_
-> w
where cid = _crID cr
Just (Weapon {_wpReloadState = 0}) -> w
Just (Weapon {_wpReloadState = 1}) -> stopSoundFrom (CrReloadSound cid) w
Just (Weapon {}) -> soundFrom (CrReloadSound cid) reloadSound (1) 0 w
_ -> w
where
cid = _crID cr
updateMovement :: StdGen -> Creature -> (Creature, StdGen)
updateMovement g cr
| isFrictionless cr
= (over crPos (+.+ momentum) $ setOldPos cr, g')
| otherwise
= case cr ^? crStance . carriage of
Just (Walking x y)
-> (set (crStance . carriage) (Walking ((x+y)`mod`120) 0)
$ setOldPos
cr, g)
_ -> (set (crStance . carriage) (Walking 0 0)
$ setOldPos
cr, g)
| isFrictionless cr = (over crPos (+.+ momentum) $ setOldPos cr, g')
| otherwise = case cr ^? crStance . carriage of
Just (Walking x y)
-> (set (crStance . carriage) (Walking ((x+y)`mod`120) 0) $ setOldPos cr
, g)
_ -> (set (crStance . carriage) (Walking 0 0) $ setOldPos cr
, g)
where
momentum' = 0.98 *.* (_crPos cr -.- _crOldPos cr)
momentum'' | magV momentum' > 1 = 1 *.* normalizeV momentum'
@@ -180,25 +174,30 @@ isFrictionless cr = case cr ^? crStance . carriage of
updateReloadCounter :: Creature -> Creature
updateReloadCounter cr = over (crInv . ix iSel . itUseTime) decreaseToZero
. over (crInv . ix iSel . wpReloadState) decreaseToZero
$ cr
where iSel = _crInvSel cr
. over (crInv . ix iSel . wpReloadState) decreaseToZero
$ cr
where
iSel = _crInvSel cr
decreaseToZero :: Int -> Int
decreaseToZero x | x > 0 = x - 1
| otherwise = 0
decreaseToZero x = max 0 (x - 1)
onDeath :: (Creature -> World -> World) -> CRUpdate -> CRUpdate
onDeath h u w (f,g) cr
| _crHP cr > 0 = u w (f,g) cr
| otherwise = ( ( h cr . f, g ) , Nothing )
updateBarrel ::
World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature)
updateBarrel w (f,g) cr | _crHP cr > 0 = ((f, g), newCr)
| otherwise = ((f, g), Nothing)
where damages = _crDamage $ _crState cr
newCr = Just $ doDamage cr
updateBarrel
:: World
-> (World -> World,StdGen)
-> Creature
-> ((World -> World , StdGen), Maybe Creature)
updateBarrel w (f,g) cr
| _crHP cr > 0 = ((f, g), newCr)
| otherwise = ((f, g), Nothing)
where
damages = _crDamage $ _crState cr
newCr = Just $ doDamage cr
-- it is easy to leave off the "f" here
-- should find some better way of doing all this that is less prone to error
@@ -207,29 +206,30 @@ updateExpBarrel ::
updateExpBarrel w (f,g) cr
| _crHP cr > 0 = ((f . foldr (.) id pierceSparks . hiss, g'), newCr)
| otherwise = ((f . makeExplosionAt (_crPos cr) . stopSounds , g'), Nothing)
where damages = _crDamage $ _crState cr
pierceSparks :: [World -> World]
pierceSparks
= zipWith4 (\p a colid time-> (createBarrelSpark time colid (_crPos cr +.+ p) (a + argV p))
(Just $ _crID cr))
poss as colids times
as = randomRs (-0.7,0.7) $ g
colids = randomRs (0,11) $ g
times = randomRs (2,5) $ g
(g',_) = split g
poss = _piercedPoints $ _crSpState $ _crState cr
--newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages
newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr
perforate :: DamageType -> Creature -> Creature
perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints)
((:) $ int -.- _crPos cr) cr
perforate _ cr = cr
applyFuseDamage cr = over crHP (\hp -> hp - length (_piercedPoints
$ _crSpState $ _crState cr))
cr
hiss | poss == [] = id
| otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] 41 50 1
stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
where
damages = _crDamage $ _crState cr
pierceSparks :: [World -> World]
pierceSparks
= zipWith4 (\p a colid time-> (createBarrelSpark time colid (_crPos cr +.+ p) (a + argV p))
(Just $ _crID cr))
poss as colids times
as = randomRs (-0.7,0.7) $ g
colids = randomRs (0,11) $ g
times = randomRs (2,5) $ g
(g',_) = split g
poss = _piercedPoints $ _crSpState $ _crState cr
--newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages
newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr
perforate :: DamageType -> Creature -> Creature
perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints)
((:) $ int -.- _crPos cr) cr
perforate _ cr = cr
applyFuseDamage cr = over crHP (\hp -> hp - length (_piercedPoints
$ _crSpState $ _crState cr))
cr
hiss | poss == [] = id
| otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] 41 50 1
stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
damToExpBarrel :: [DamageType] -> Creature -> Creature
damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
src/Dodge/Creature/State/Data.hs
+3 -2
View File
@@ -6,17 +6,16 @@ import Geometry
import Dodge.Data.DamageType
import Dodge.Creature.Impulse.Data
import Dodge.Creature.Stance.Data
import Picture.Data
import Control.Lens
data CreatureState = CrSt
{ _goals :: [[Impulse]]
, _faction :: Faction
, _crDamage :: [DamageType]
, _crPastDamage :: [[DamageType]]
, _crSpState :: CrSpState
, _crDropsOnDeath :: CreatureDropType
, _crIsAnimate :: Bool
}
data CreatureDropType
@@ -36,6 +35,8 @@ data Faction
| ChaseCritters
| SpawnedBy Int
| NoFaction
| ColorFaction Color
| PlayerFaction
deriving (Eq,Show)
makeLenses ''CreatureState
src/Dodge/Creature/Test.hs
+54
View File
@@ -0,0 +1,54 @@
{- |
Module testing for properties of creatures, whether they are reloading, etc.
Each function takes the world and a creature and returns a bool.
Note that the creature NEED NOT be the same as the creature with that id in the world,
in fact in some cases a creature with that id may not even exist.
-}
module Dodge.Creature.Test
where
import Dodge.Data
import Dodge.Base.Collide
import Dodge.Creature.Stance.Data
import Geometry
import SameConstr
import Data.List (find)
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import Control.Lens
andTest :: (a -> Bool) -> (a -> Bool) -> a -> Bool
andTest f g a = f a && g a
onBoth :: (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c
onBoth f g h x = f (g x) (h x)
crIsReloading :: (World, Creature) -> Bool
crIsReloading (w,cr) = case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of
Just t -> t > 0
_ -> False
crCanSeeCID :: Int -> (World, Creature) -> Bool
crCanSeeCID cid (w,cr) = hasLOS (_crPos cr) (_crPos $ _creatures w IM.! cid) w
crIsAiming :: (World,Creature) -> Bool
crIsAiming (_,cr) = _posture (_crStance cr) == Aiming
crHasTarget :: (World,Creature) -> Bool
crHasTarget (_,cr) = isJust $ cr ^? crTarget . _Just
crHasTargetLOS :: (World,Creature) -> Bool
crHasTargetLOS (w,cr) = case cr ^? crTarget . _Just of
Just i -> crCanSeeCID i (w,cr)
Nothing -> False
crStratConMatches :: Strategy -> (World,Creature) -> Bool
crStratConMatches strat (_,cr) = eqConstr strat (_crStrategy $ _crActionPlan cr)
crAwayFromPost :: (World,Creature) -> Bool
crAwayFromPost (_,cr) = case find sentinelGoal $ _crGoal $ _crActionPlan cr of
Just (SentinelAt p dir) -> dist p (_crPos cr) > 15
_ -> False
where
sentinelGoal (SentinelAt p dir) = True
sentinelGoal _ = False