Set lasGun muzzle position correctly
This commit is contained in:
@@ -1,6 +1,8 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Creature.Impulse
|
||||
( impulsiveAI
|
||||
, followImpulses
|
||||
, followThenClearImpulses
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Creature.Vocalization
|
||||
@@ -19,51 +21,50 @@ impulsiveAI :: (World -> Creature -> Creature)
|
||||
-> Creature
|
||||
-> World
|
||||
-> (World -> World , Creature)
|
||||
impulsiveAI impf cr w = followImpulses w $ impf w cr
|
||||
impulsiveAI f cr w = followImpulses w $ f w cr
|
||||
|
||||
followThenClearImpulses :: World -> Creature -> (World -> World, Creature)
|
||||
followThenClearImpulses w = second f . followImpulses w
|
||||
where
|
||||
f = crActionPlan . crImpulse .~ []
|
||||
|
||||
followImpulses :: World -> Creature -> (World -> World, Creature)
|
||||
followImpulses w cr = foldr
|
||||
foldf
|
||||
(id, cr)
|
||||
(_crImpulse $ _crActionPlan cr)
|
||||
followImpulses w cr = foldr f (id, cr) (_crImpulse $ _crActionPlan cr)
|
||||
where
|
||||
foldf imp (f,cr') = first ( . f) $ followImpulse cr' w imp
|
||||
f imp (theupdate,cr') = first (. theupdate) $ followImpulse cr' w imp
|
||||
|
||||
followImpulse :: Creature -> World -> Impulse -> (World -> World , Creature)
|
||||
followImpulse cr w imp = case imp of
|
||||
Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr)
|
||||
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)
|
||||
TurnTo p -> (id, creatureTurnTo p cr)
|
||||
ChangePosture post -> (id, cr & crStance . posture .~ post)
|
||||
UseItem -> (tryUseItem cr, cr)
|
||||
SwitchToItem i -> (id, cr & crInvSel .~ i)
|
||||
Melee cid' -> (hitCr cid'
|
||||
Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr)
|
||||
Move p -> crup $ crMvBy p cr
|
||||
MoveForward x -> crup $ crMvForward x cr
|
||||
Turn a -> crup $ creatureTurn a cr
|
||||
TurnToward p a -> crup $ creatureTurnToward p a cr
|
||||
TurnTo p -> crup $ creatureTurnTo p cr
|
||||
ChangePosture post -> crup $ cr & crStance . posture .~ post
|
||||
UseItem -> (tryUseItem cr, cr)
|
||||
SwitchToItem i -> crup $ cr & crInvSel .~ i
|
||||
Melee cid' -> (hitCr cid'
|
||||
, crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20)
|
||||
RandomTurn a -> (id, creatureTurn (rr a) cr)
|
||||
MakeSound sid -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr )
|
||||
DropItem -> undefined
|
||||
ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat)
|
||||
AddGoal gl -> (id, cr & crActionPlan . crGoal .:~ gl )
|
||||
ArbitraryImpulseFunction f -> (id, f w cr)
|
||||
ArbitraryImpulse f -> followImpulse cr w (f cr w)
|
||||
ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
|
||||
RandomTurn a -> crup $ creatureTurn (rr a) cr
|
||||
MakeSound sid -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr )
|
||||
DropItem -> undefined
|
||||
ChangeStrategy strat -> crup $ cr & crActionPlan . crStrategy .~ strat
|
||||
AddGoal gl -> crup $ cr & crActionPlan . crGoal .:~ gl
|
||||
ArbitraryImpulseFunction f -> crup $ f w cr
|
||||
ArbitraryImpulse f -> followImpulse cr w (f cr w)
|
||||
ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
|
||||
Just tcr -> followImpulse cr w (f $ _crID tcr)
|
||||
_ -> (id,cr)
|
||||
_ -> crup cr
|
||||
ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
|
||||
Just tcr -> followImpulse cr w (f tcr)
|
||||
_ -> (id,cr)
|
||||
-- ImpulseUseTarget f -> fromMaybe (id,cr) $ do
|
||||
-- cid <- cr ^? crIntention . targetCr . _Just
|
||||
-- tcr <- w ^? creatures . ix cid
|
||||
-- return $ followImpulse cr w (f tcr)
|
||||
_ -> crup cr
|
||||
ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
|
||||
MvForward -> (id, crMvForward speed cr)
|
||||
MvTurnToward p -> (id, creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr)
|
||||
-- _ -> (id , cr)
|
||||
MvForward -> crup $ crMvForward speed cr
|
||||
MvTurnToward p -> crup
|
||||
$ creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
|
||||
where
|
||||
crup = (id,)
|
||||
mvType = _crMvType cr
|
||||
speed = _mvSpeed mvType
|
||||
turnRad = _mvTurnRad mvType
|
||||
@@ -72,6 +73,6 @@ followImpulse cr w imp = case imp of
|
||||
cid = _crID 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)
|
||||
hitCr i = (creatures . ix i . crState . crDamage %~ addDam i)
|
||||
. soundStart (CrSound cid) cpos hitS Nothing
|
||||
addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams
|
||||
addDam i = ( Blunt 100 cpos (posFromID i) (posFromID i) : )
|
||||
|
||||
Reference in New Issue
Block a user