Refactor, try to limit dependencies
This commit is contained in:
+188
-146
@@ -1,124 +1,143 @@
|
||||
module Dodge.Creature.State
|
||||
( stateUpdate
|
||||
, doDamage
|
||||
) where
|
||||
import Dodge.Corpse.Make
|
||||
import Dodge.Data
|
||||
import Dodge.Targeting
|
||||
import Dodge.ItEffect
|
||||
import Dodge.Euse
|
||||
import Dodge.EnergyBall
|
||||
import Dodge.Damage
|
||||
import Dodge.Hammer
|
||||
import Dodge.Reloading
|
||||
import Dodge.Prop.Gib
|
||||
module Dodge.Creature.State (
|
||||
stateUpdate,
|
||||
doDamage,
|
||||
) where
|
||||
|
||||
import Dodge.Base
|
||||
import Dodge.Creature.State.WalkCycle
|
||||
import Dodge.Creature.Impulse.Movement
|
||||
import Dodge.Creature.Damage
|
||||
import Dodge.LightSource.Torch
|
||||
import Dodge.SoundLogic
|
||||
import RandomHelp
|
||||
import Dodge.Corpse.Make
|
||||
import Dodge.Creature.Action
|
||||
import Dodge.Creature.Damage
|
||||
import Dodge.Creature.Impulse.Movement
|
||||
import Dodge.Creature.State.WalkCycle
|
||||
import Dodge.Damage
|
||||
import Dodge.Data.World
|
||||
import Dodge.EnergyBall
|
||||
import Dodge.Euse
|
||||
import Dodge.Hammer
|
||||
import Dodge.ItEffect
|
||||
import Dodge.LightSource.Torch
|
||||
import Dodge.Prop.Gib
|
||||
import Dodge.Reloading
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.Targeting
|
||||
import Geometry
|
||||
import Picture
|
||||
import Shape
|
||||
import ShapePicture
|
||||
import qualified IntMapHelp as IM
|
||||
import LensHelp
|
||||
import Picture
|
||||
import RandomHelp
|
||||
import Shape
|
||||
import ShapePicture
|
||||
|
||||
foldCr :: [Creature -> World -> World]
|
||||
-> Creature -> World -> World
|
||||
foldCr ::
|
||||
[Creature -> World -> World] ->
|
||||
Creature ->
|
||||
World ->
|
||||
World
|
||||
--foldCr xs cr w = foldr ($ cr) w xs
|
||||
foldCr xs cr w = foldr f w xs
|
||||
where
|
||||
f g w' = case w' ^? cWorld . creatures . ix (_crID cr) of
|
||||
Just cr' -> g cr' w'
|
||||
Nothing -> w'
|
||||
Nothing -> w'
|
||||
|
||||
-- | this seems to work, but I am not sure about the ordering:
|
||||
-- previously, the movement was updated before the ai in order to correctly set the oldpos.
|
||||
-- This should be made more sensible: should the movement side effects apply to
|
||||
-- the creature before or after it has moved?
|
||||
-- at what point invSideEffects is applied wrt to when the creature moves
|
||||
-- may affect whether the shield moves correctly
|
||||
{- | this seems to work, but I am not sure about the ordering:
|
||||
previously, the movement was updated before the ai in order to correctly set the oldpos.
|
||||
This should be made more sensible: should the movement side effects apply to
|
||||
the creature before or after it has moved?
|
||||
at what point invSideEffects is applied wrt to when the creature moves
|
||||
may affect whether the shield moves correctly
|
||||
-}
|
||||
stateUpdate :: (Creature -> World -> World) -> Creature -> World -> World
|
||||
stateUpdate f = foldCr
|
||||
[ equipmentEffects
|
||||
, invSideEff
|
||||
, upInv -- upInv must be called before invSideEff 22.05.23
|
||||
, movementSideEff
|
||||
, f
|
||||
, internalUpdate
|
||||
, clearDamage -- these three
|
||||
, checkDeath -- must be in
|
||||
, doDamage -- this order 22/06/05
|
||||
]
|
||||
stateUpdate f =
|
||||
foldCr
|
||||
[ equipmentEffects
|
||||
, invSideEff
|
||||
, upInv -- upInv must be called before invSideEff 22.05.23
|
||||
, movementSideEff
|
||||
, f
|
||||
, internalUpdate
|
||||
, clearDamage -- these three
|
||||
, checkDeath -- must be in
|
||||
, doDamage -- this order 22/06/05
|
||||
]
|
||||
|
||||
checkDeath :: Creature -> World -> World
|
||||
checkDeath cr w
|
||||
| _crHP cr > 0 = w
|
||||
| otherwise = w
|
||||
-- & creatures . at (_crID cr) .~ Nothing
|
||||
& dropByState cr
|
||||
& removecr
|
||||
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
|
||||
& corpseOrGib cr
|
||||
| otherwise =
|
||||
w
|
||||
-- & creatures . at (_crID cr) .~ Nothing
|
||||
& dropByState cr
|
||||
& removecr
|
||||
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
|
||||
& corpseOrGib cr
|
||||
where
|
||||
removecr
|
||||
| _crID cr == 0 = (cWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
|
||||
. (cWorld . creatures . ix (_crID cr) . crHP .~ 0)
|
||||
-- hack to get around player creature being killed but left with more than 0 hp
|
||||
| otherwise = cWorld . creatures . at (_crID cr) .~ Nothing
|
||||
| _crID cr == 0 =
|
||||
(cWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
|
||||
. (cWorld . creatures . ix (_crID cr) . crHP .~ 0)
|
||||
-- hack to get around player creature being killed but left with more than 0 hp
|
||||
| otherwise = cWorld . creatures . at (_crID cr) .~ Nothing
|
||||
|
||||
corpseOrGib :: Creature -> World -> World
|
||||
corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
|
||||
Just (FLAMING,_) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
|
||||
Just (ELECTRICAL,_) -> w & plNew (cWorld . corpses) cpID thecorpse
|
||||
Just (POISONDAM,_) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
|
||||
_ | _crPastDamage cr > 200 -> w & addCrGibs cr
|
||||
& bloodPuddleAt cpos
|
||||
& bloodPuddleAt cpos
|
||||
& bloodPuddleAt cpos
|
||||
_ -> w
|
||||
& bloodPuddleAt cpos
|
||||
& bloodPuddleAt cpos
|
||||
& plNew (cWorld . corpses) cpID thecorpse
|
||||
Just (FLAMING, _) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
|
||||
Just (ELECTRICAL, _) -> w & plNew (cWorld . corpses) cpID thecorpse
|
||||
Just (POISONDAM, _) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
|
||||
_
|
||||
| _crPastDamage cr > 200 ->
|
||||
w & addCrGibs cr
|
||||
& bloodPuddleAt cpos
|
||||
& bloodPuddleAt cpos
|
||||
& bloodPuddleAt cpos
|
||||
_ ->
|
||||
w
|
||||
& bloodPuddleAt cpos
|
||||
& bloodPuddleAt cpos
|
||||
& plNew (cWorld . corpses) cpID thecorpse
|
||||
where
|
||||
cpos = _crPos cr
|
||||
thecorpse = makeDefaultCorpse cr
|
||||
|
||||
scorchSPic :: SPic -> SPic
|
||||
scorchSPic = over _1 $
|
||||
overColSH (mixColors 0.9 0.1 black . normalizeColor)
|
||||
scorchSPic =
|
||||
over _1 $
|
||||
overColSH (mixColors 0.9 0.1 black . normalizeColor)
|
||||
|
||||
poisonSPic :: SPic -> SPic
|
||||
poisonSPic = over _1 $
|
||||
overColSH (mixColors 0.5 0.5 green . normalizeColor)
|
||||
poisonSPic =
|
||||
over _1 $
|
||||
overColSH (mixColors 0.5 0.5 green . normalizeColor)
|
||||
|
||||
--scorchSPic :: World -> SPic -> SPic
|
||||
--scorchSPic w sp = evalState (scorchSPic' sp) (_randGen w)
|
||||
--
|
||||
--scorchSPic' :: SPic -> State StdGen SPic
|
||||
--scorchSPic' = _1 $ overColSHM $ \col -> takeOne [col,black]
|
||||
---- (return . mixColorsLinear 0.9 0.1 black)
|
||||
---- (return . mixColorsLinear 0.9 0.1 black)
|
||||
|
||||
bloodPuddleAt :: Point2 -> World -> World
|
||||
bloodPuddleAt p w = w
|
||||
& snd . plNewID (cWorld . decorations)
|
||||
(color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10)
|
||||
& randGen .~ g
|
||||
bloodPuddleAt p w =
|
||||
w
|
||||
& snd
|
||||
. plNewID
|
||||
(cWorld . decorations)
|
||||
(color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10)
|
||||
& randGen .~ g
|
||||
where
|
||||
(q,g) = randInCirc 10 & runState $ _randGen w
|
||||
(q, g) = randInCirc 10 & runState $ _randGen w
|
||||
|
||||
internalUpdate :: Creature -> World -> World
|
||||
internalUpdate cr = cWorld . creatures . ix (_crID cr) %~
|
||||
( (crHammerPosition %~ moveHammerUp)
|
||||
. stepReloading
|
||||
. updateMovement
|
||||
)
|
||||
internalUpdate cr =
|
||||
cWorld . creatures . ix (_crID cr)
|
||||
%~ ( (crHammerPosition %~ moveHammerUp)
|
||||
. stepReloading
|
||||
. updateMovement
|
||||
)
|
||||
|
||||
-- | Drop items according to the creature state.
|
||||
-- TODO make sure this doesn't mess up any ItemPosition
|
||||
{- | Drop items according to the creature state.
|
||||
TODO make sure this doesn't mess up any ItemPosition
|
||||
-}
|
||||
dropByState :: Creature -> World -> World
|
||||
dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath of
|
||||
DropAll -> IM.keys $ _crInv cr
|
||||
@@ -126,79 +145,91 @@ dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath o
|
||||
DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
|
||||
|
||||
clearDamage :: Creature -> World -> World
|
||||
clearDamage cr w = w
|
||||
& cWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
|
||||
clearDamage cr w =
|
||||
w
|
||||
& cWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
|
||||
|
||||
doDamage :: Creature -> World -> World
|
||||
doDamage cr w = w
|
||||
& applyPastDamages cr
|
||||
& applyCreatureDamage dams cr
|
||||
where
|
||||
doDamage cr w =
|
||||
w
|
||||
& applyPastDamages cr
|
||||
& applyCreatureDamage dams cr
|
||||
where
|
||||
dams = _csDamage $ _crState cr
|
||||
|
||||
-- TODO generalise shake to arbitrary damage amounts
|
||||
applyPastDamages :: Creature -> World -> World
|
||||
applyPastDamages cr w
|
||||
| _crPastDamage cr > 200 = let (p,g) = runState (randInCirc 3) (_randGen w)
|
||||
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
|
||||
& randGen .~ g
|
||||
| _crPastDamage cr > 20 = let (p,g) = runState (randInCirc 2) (_randGen w)
|
||||
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
|
||||
& randGen .~ g
|
||||
| _crPastDamage cr > 0 = let (p,g) = runState (randInCirc 1) (_randGen w)
|
||||
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1))
|
||||
& randGen .~ g
|
||||
| _crPastDamage cr > 200 =
|
||||
let (p, g) = runState (randInCirc 3) (_randGen w)
|
||||
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
|
||||
& randGen .~ g
|
||||
| _crPastDamage cr > 20 =
|
||||
let (p, g) = runState (randInCirc 2) (_randGen w)
|
||||
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
|
||||
& randGen .~ g
|
||||
| _crPastDamage cr > 0 =
|
||||
let (p, g) = runState (randInCirc 1) (_randGen w)
|
||||
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1))
|
||||
& randGen .~ g
|
||||
| otherwise = w
|
||||
|
||||
movementSideEff :: Creature -> World -> World
|
||||
movementSideEff cr w
|
||||
| hasJetPack = case cr ^? crStance . carriage of
|
||||
Just (Boosting v) -> w
|
||||
& randGen .~ g
|
||||
& makeFlamelet
|
||||
(oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
|
||||
20
|
||||
(momentum +.+ 1 *.* rotateV randDir (vInverse v))
|
||||
1
|
||||
20
|
||||
_ -> w
|
||||
Just (Boosting v) ->
|
||||
w
|
||||
& randGen .~ g
|
||||
& makeFlamelet
|
||||
(oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
|
||||
20
|
||||
(momentum +.+ 1 *.* rotateV randDir (vInverse v))
|
||||
1
|
||||
20
|
||||
_ -> w
|
||||
| otherwise = footstepSideEffect cr w
|
||||
where
|
||||
where
|
||||
hasJetPack = any (\it -> it ^? itType . iyBase == Just (EQUIP JETPACK)) $ _crInv cr
|
||||
oldPos = _crOldPos cr
|
||||
momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr)
|
||||
momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum'
|
||||
| otherwise = momentum'
|
||||
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
|
||||
(randDir, g) = randomR (-0.5, 0.5) $ _randGen w
|
||||
(randAng, _) = randomR (0, 2 * pi) $ _randGen w
|
||||
|
||||
useUpdate :: ItemUse -> ItemUse
|
||||
useUpdate = (useHammer %~ moveHammerUp)
|
||||
. (useDelay . warmTime %~ decreaseToZero)
|
||||
. (useDelay . rateTime %~ decreaseToZero)
|
||||
useUpdate =
|
||||
(heldHammer %~ moveHammerUp)
|
||||
. (heldDelay . warmTime %~ decreaseToZero)
|
||||
. (heldDelay . rateTime %~ decreaseToZero)
|
||||
|
||||
useEquipment :: Creature -> Int -> World -> World
|
||||
useEquipment cr i = useE (_eqUse (_eqEq $ _itUse itm)) itm cr
|
||||
useEquipment cr i = useE (_eeUse (_equipEffect $ _itUse itm)) itm cr
|
||||
where
|
||||
itm = _crInv cr IM.! i
|
||||
|
||||
-- a map updating all inventory items
|
||||
upInv :: Creature -> World -> World
|
||||
upInv cr = cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr)
|
||||
|
||||
-- a loop going over equipped items
|
||||
equipmentEffects :: Creature -> World -> World
|
||||
equipmentEffects cr = flip (foldr $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
|
||||
|
||||
-- a loop going over all inventory items
|
||||
invSideEff :: Creature -> World -> World
|
||||
invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
|
||||
where
|
||||
f i it w' = itemInvSideEffect cr it
|
||||
$ doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
|
||||
where
|
||||
f i it w' =
|
||||
itemInvSideEffect cr it $
|
||||
doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
|
||||
|
||||
itemInvSideEffect :: Creature -> Item -> World -> World
|
||||
itemInvSideEffect cr it
|
||||
| hastorchattach = createAttachLight cr it
|
||||
| otherwise = id
|
||||
| otherwise = id
|
||||
where
|
||||
hastorchattach = it ^? itType . iyModules . ix ModHeldAttach == Just ATTACHTORCH && _itIsHeld it
|
||||
|
||||
@@ -210,57 +241,68 @@ createAttachLight cr it = createTorchLightOffset cr it attachoff
|
||||
itemUpdate :: Creature -> Int -> Item -> Item
|
||||
itemUpdate cr i
|
||||
| i == crSel cr = baseupdate True
|
||||
| otherwise = baseupdate False
|
||||
| otherwise = baseupdate False
|
||||
where
|
||||
baseupdate bool = updateAutoRecharge . (itUse %~ useUpdate)
|
||||
. (itLocation .~ InInv (_crID cr) i)
|
||||
. (itIsHeld .~ bool)
|
||||
baseupdate bool =
|
||||
updateAutoRecharge . (itUse %~ useUpdate)
|
||||
. (itLocation .~ InInv (_crID cr) i)
|
||||
. (itIsHeld .~ bool)
|
||||
|
||||
updateAutoRecharge :: Item -> Item
|
||||
updateAutoRecharge it = case it ^? itUse . leftConsumption of
|
||||
Just (AutoRecharging l m t p)
|
||||
| l < m && p <= 0 -> it & itUse . leftConsumption .~ AutoRecharging (l+1) m t t
|
||||
| l < m && p <= 0 -> it & itUse . leftConsumption .~ AutoRecharging (l + 1) m t t
|
||||
| l < m -> it & itUse . leftConsumption . arProgress -~ 1
|
||||
_ -> it
|
||||
|
||||
doItemTargeting :: Int -> Creature -> World -> World
|
||||
doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
|
||||
Nothing -> w
|
||||
Just NoTargeting -> w
|
||||
Just t -> let (w',t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t
|
||||
in w' & cWorld . creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t'
|
||||
Just t ->
|
||||
let (w', t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t
|
||||
in w' & cWorld . creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t'
|
||||
|
||||
weaponReloadSounds :: Creature -> World -> World
|
||||
weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of
|
||||
Just ReloadAction{_reloadAction = la} -> soundContinue
|
||||
(CrReloadSound cid) (_crPos cr) (_actionSound la) (Just 1) w
|
||||
Just ReloadAction{_reloadAction = la} ->
|
||||
soundContinue
|
||||
(CrReloadSound cid)
|
||||
(_crPos cr)
|
||||
(_actionSound la)
|
||||
(Just 1)
|
||||
w
|
||||
_ -> w
|
||||
-- PassiveReload stype | Just (_laReloadTime am) == am ^? laTransfer . transferTime
|
||||
-- -> soundContinue (CrReloadSound 0) (_crPos cr) stype Nothing w
|
||||
-- PassiveReload _ -> w
|
||||
-- ActiveClear | am ^? laTransfer . transferTime == Just 0 -> stopSoundFrom (CrReloadSound cid) w
|
||||
-- ActiveClear | _laTransfer am == NoTransfer -> w
|
||||
-- ActiveClear -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
|
||||
-- ActivePartial{} | am ^? laTransfer . transferTime == Just 0 -> stopSoundFrom (CrReloadSound cid) w
|
||||
-- ActivePartial{} | _laTransfer am == NoTransfer -> w
|
||||
-- ActivePartial{} -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
|
||||
-- Just ChargeableAmmo {} -> w
|
||||
-- Just NoConsumption {} -> w
|
||||
-- Just ItemItselfConsumable {} -> w
|
||||
-- Nothing -> w
|
||||
where
|
||||
where
|
||||
-- PassiveReload stype | Just (_laReloadTime am) == am ^? laTransfer . transferTime
|
||||
-- -> soundContinue (CrReloadSound 0) (_crPos cr) stype Nothing w
|
||||
-- PassiveReload _ -> w
|
||||
-- ActiveClear | am ^? laTransfer . transferTime == Just 0 -> stopSoundFrom (CrReloadSound cid) w
|
||||
-- ActiveClear | _laTransfer am == NoTransfer -> w
|
||||
-- ActiveClear -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
|
||||
-- ActivePartial{} | am ^? laTransfer . transferTime == Just 0 -> stopSoundFrom (CrReloadSound cid) w
|
||||
-- ActivePartial{} | _laTransfer am == NoTransfer -> w
|
||||
-- ActivePartial{} -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
|
||||
-- Just ChargeableAmmo {} -> w
|
||||
-- Just NoConsumption {} -> w
|
||||
-- Just ItemItselfConsumable {} -> w
|
||||
-- Nothing -> w
|
||||
|
||||
cid = _crID cr
|
||||
|
||||
updateMovement :: Creature -> Creature
|
||||
updateMovement cr
|
||||
updateMovement cr
|
||||
| isFrictionless cr = over crPos (+.+ momentum) cr
|
||||
| otherwise = updateWalkCycle cr
|
||||
where
|
||||
momentum' = 0.98 *.* (_crPos cr -.- _crOldPos cr)
|
||||
momentum'' | magV momentum' > 1 = 1 *.* normalizeV momentum'
|
||||
| otherwise = momentum'
|
||||
momentum''
|
||||
| magV momentum' > 1 = 1 *.* normalizeV momentum'
|
||||
| otherwise = momentum'
|
||||
momentum = momentum''
|
||||
|
||||
isFrictionless :: Creature -> Bool
|
||||
isFrictionless cr = case cr ^? crStance . carriage of
|
||||
Just (Boosting _) -> True
|
||||
Just Floating -> True
|
||||
_ -> False
|
||||
Just Floating -> True
|
||||
_ -> False
|
||||
|
||||
Reference in New Issue
Block a user