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

Cleanup

Browse Source
This commit is contained in:
justin
2025-06-19 22:55:46 +01:00
parent 4f0fa95e13
commit fe1ac8f5a4
2 changed files with 101 additions and 118 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/State.hs
+88 -98
View File
@@ -3,11 +3,7 @@ module Dodge.Creature.State (
doDamage,
) where
import Dodge.Data.Damage.Type
import Dodge.Item.BackgroundEffect
import Dodge.Item.MaxAmmo
import Control.Applicative
import Dodge.HeldUse
import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -21,12 +17,16 @@ import Dodge.Creature.State.WalkCycle
import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Data.ComposedItem
import Dodge.Data.Damage.Type
import Dodge.Data.DoubleTree
import Dodge.Data.World
import Dodge.DoubleTree
import Dodge.Euse
import Dodge.HeldUse
import Dodge.Item.BackgroundEffect
import Dodge.Item.Grammar
import Dodge.Item.HeldOffset
import Dodge.Item.MaxAmmo
import Dodge.Prop.Gib
import Dodge.SoundLogic
import Dodge.Targeting.Draw
@@ -62,13 +62,14 @@ crUpdate f =
foldCr
[ doDamage -- these two
, checkDeath -- must be in this order 24/7/22
, footstepSideEffect
, updateWalkCycle
, f
-- , updateInv -- upInv must be called before invSideEff 22.05.23
, invRootItemEffs
, -- , updateInv -- upInv must be called before invSideEff 22.05.23
invRootItemEffs
, invSideEff
-- , equipmentEffects
-- , equipmentEffects
]
-- I have changed the ordering of item/equipment effects, which may have
-- unforseen consequences, be aware
@@ -79,36 +80,36 @@ checkDeath cr w
& cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ []
| _crHP cr <= -200 =
w
& dropByState cr -- the order of
& dropAll cr -- the order of
& removecr -- these is important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& addCrGibs cr
| _crHP cr > -200 && _crDeathTimer cr < 5 =
| _crHP cr > -200 && _crDeathTimer cr < 5 =
w
& cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ []
& cWorld . lWorld . creatures . ix (_crID cr) . crDeathTimer +~ 1
| otherwise =
w
& dropByState cr -- the order of
& dropAll cr -- the order of
& removecr -- these is important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& corpseOrGib cr
where
removecr
| _crID cr == 0 =
-- (cWorld . lWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
| _crID cr == 0 = id
-- cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
-- hack to get around player creature being killed but left with more than 0 hp
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
-- could look at the amount of damage here (given by maxDamage) too
corpseOrGib :: Creature -> World -> World
corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
Just CookingDamage -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
Just PoisonDamage -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
Just CookingDamage -> addcorpse (thecorpse & cpSPic %~ scorchSPic)
Just PoisonDamage -> addcorpse (thecorpse & cpSPic %~ poisonSPic)
Just PhysicalDamage | _crPastDamage cr > 200 -> addCrGibs cr
_ -> plNew (cWorld . lWorld . corpses) cpID thecorpse
_ -> addcorpse thecorpse
where
addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
thecorpse = makeCorpse cr
scorchSPic :: SPic -> SPic
@@ -120,12 +121,8 @@ poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
{- | Drop items according to the creature state.
TODO make sure this doesn't mess up any ItemPosition
-}
dropByState :: Creature -> World -> World
dropByState cr w = foldl' (flip (dropItem cr)) w $ IM.keys $ _crInv cr
-- case cr ^. crState . csDropsOnDeath of
-- DropAll -> IM.keys $ _crInv cr
-- DropSpecific xs -> xs
-- DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
dropAll :: Creature -> World -> World
dropAll cr w = foldl' (flip (dropItem cr)) w $ IM.keys $ _crInv cr
doDamage :: Creature -> World -> World
doDamage cr = applyPastDamages cr . applyCreatureDamage dams cr
@@ -135,31 +132,21 @@ doDamage cr = applyPastDamages cr . applyCreatureDamage dams 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 . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
& randGen .~ g
| _crPastDamage cr > 20 =
let (p, g) = runState (randInCirc 2) (_randGen w)
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
& randGen .~ g
| _crPastDamage cr > 0 =
let (p, g) = runState (randInCirc 1) (_randGen w)
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1))
& randGen .~ g
| _crPastDamage cr > 200 = dojitter 3 100
| _crPastDamage cr > 20 = dojitter 2 10
| _crPastDamage cr > 0 = dojitter 1 1
| otherwise = w
-- a map updating all inventory items
--updateInv :: Creature -> World -> World
--updateInv cr =id
--updateInv cr = cWorld . lWorld . creatures . ix (_crID cr) . crInv . each
-- . itUse . heldDelay . warmTime %~ (max 0 . subtract 1)
where
dojitter x y =
let (p, g) = runState (randInCirc x) (_randGen w)
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvBy p
& cWorld . lWorld . creatures . ix (_crID cr) . crPastDamage -~ y
& randGen .~ g
-- a loop going over all inventory items
invSideEff :: Creature -> World -> World
invSideEff cr = alaf Endo foldMap f (_crInv cr) . updateHeldRootItem cr
where
--f it = maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
f it = itBackgroundEffect it cr
-- a loop going over all root inventory items
@@ -176,8 +163,8 @@ invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
EQUIP WRIST_ECG | haspulse -> tryUseParent loc w
_ -> w
where
haspulse =
w ^? cWorld . lWorld . creatures . ix 0 . crType . avatarPulse . pulseProgress
haspulse =
w ^? cWorld . lWorld . creatures . ix 0 . crType . avatarPulse . pulseProgress
== Just 0
itm = loc ^. locLDT . ldtValue . _1
@@ -197,57 +184,57 @@ tryUseParent loc w = fromMaybe w $ do
trySynthBullet :: LocationLDT ItemLink ComposedItem -> World -> World
trySynthBullet loc w = fromMaybe w $ do
i <- itm ^? itLocation . ilInvID
x <- itm ^? itUse . uaParams . apInt
if x < 100
then do
bat <- loc ^? locLDT . ldtLeft . ix 0 . _2 . ldtValue . _1
j <- bat ^? itLocation . ilInvID
y <- bat ^. itConsumables
guard $ y > 0
return $
w
& cWorld . lWorld . creatures
. ix 0
. crInv
. ix i
. itUse
. uaParams
. apInt
+~ 1
& cWorld . lWorld . creatures
. ix 0
. crInv
. ix j
. itConsumables
. _Just
-~ 1
else do
mag <- loc ^? locLdtContext . cldtParent . _1
j <- mag ^? itLocation . ilInvID
y <- mag ^. itConsumables
ymax <- maxAmmo mag-- ^? itConsumables . magLoadStatus . iaMax
guard $ y < ymax
return $
w
& cWorld . lWorld . creatures
. ix 0
. crInv
. ix i
. itUse
. uaParams
. apInt
.~ 0
& cWorld . lWorld . creatures
. ix 0
. crInv
. ix j
. itConsumables
. _Just
+~ 1
i <- itm ^? itLocation . ilInvID
x <- itm ^? itUse . uaParams . apInt
if x < 100
then do
bat <- loc ^? locLDT . ldtLeft . ix 0 . _2 . ldtValue . _1
j <- bat ^? itLocation . ilInvID
y <- bat ^. itConsumables
guard $ y > 0
return $
w
& cWorld . lWorld . creatures
. ix 0
. crInv
. ix i
. itUse
. uaParams
. apInt
+~ 1
& cWorld . lWorld . creatures
. ix 0
. crInv
. ix j
. itConsumables
. _Just
-~ 1
else do
mag <- loc ^? locLdtContext . cldtParent . _1
j <- mag ^? itLocation . ilInvID
y <- mag ^. itConsumables
ymax <- maxAmmo mag
guard $ y < ymax
return $
w
& cWorld . lWorld . creatures
. ix 0
. crInv
. ix i
. itUse
. uaParams
. apInt
.~ 0
& cWorld . lWorld . creatures
. ix 0
. crInv
. ix j
. itConsumables
. _Just
+~ 1
where
itm = loc ^. locLDT . ldtValue . _1
updateHeldRootItem :: Creature -> World -> World
updateHeldRootItem cr = fromMaybe id $ do
invid <- cr ^? crManipulation . manObject . imRootSelectedItem
@@ -270,7 +257,7 @@ chainLinkOrientation ::
ItemLink ->
ComposedItem ->
(Point3, Q.Quaternion Float)
chainLinkOrientation (p,q) par (ILink lt f) child = (p + Q.rotate q p1, q * q1)
chainLinkOrientation (p, q) par (ILink lt f) child = (p + Q.rotate q p1, q * q1)
where
(p1, q1) = f (par ^. _1) lt (child ^. _1)
@@ -294,8 +281,10 @@ updateItemWithOrientation cr m loc@(LocLDT _ itmtree) w =
drawARHUD :: LocationLDT ItemLink ComposedItem -> World -> World
drawARHUD (LocLDT con _) w = fromMaybe w $ do
itm <- con ^? cldtParent . _1
return $ w & cWorld . lWorld . flares <>~ fold
(drawTargetingAR itm w <|> drawMapperAR itm w)
return $
w & cWorld . lWorld . flares
<>~ fold
(drawTargetingAR itm w <|> drawMapperAR itm w)
shineTargetLaser ::
Creature ->
@@ -397,8 +386,9 @@ updateItemTargeting tt cr itm w = case tt of
setRBCreatureTargeting :: Creature -> World -> ItemTargeting -> ItemTargeting
setRBCreatureTargeting cr w ituse
| SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (ituse ^? itTgID . _Just)
&& canSeeTarget =
| SDL.ButtonRight `M.member` _mouseButtons (_input w)
, isJust (ituse ^? itTgID . _Just)
, canSeeTarget =
ituse & updatePos & itTgActive .~ True
| otherwise = ituse & itTgID .~ fmap _crID newtarg & updatePos & itTgActive .~ False
where
src/Dodge/Creature/State/WalkCycle.hs
+13 -20
View File
@@ -1,8 +1,7 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.State.WalkCycle (
-- updateWalkCycle,
footstepSideEffect,
updateWalkCycle,
) where
import Control.Lens
@@ -10,10 +9,18 @@ import Dodge.Data.World
import Dodge.SoundLogic
import Sound.Data
updateWalkCycle :: Stance -> Stance
updateWalkCycle s = case s ^. carriage of
Walking x ff | x > s ^. strideLength -> s & carriage .~ Walking 0 (normalGait ff)
_ -> s
updateWalkCycle :: Creature -> World -> World
updateWalkCycle cr =
case cr ^. crStance . carriage of
Walking x ff
| x > cr ^. crStance . strideLength ->
soundMultiFrom
[FootstepSound i | i <- [0 .. 10]]
(cr ^. crPos)
(chooseFootSound ff)
Nothing
. over (cWorld . lWorld . creatures . ix (cr ^. crID) . crStance . carriage) resetStride
_ -> id
resetStride :: Carriage -> Carriage
resetStride (Walking _ ff) = Walking 0 (normalGait ff)
@@ -26,20 +33,6 @@ normalGait = \case
RightForward -> LeftForward
WasRightForward -> LeftForward
footstepSideEffect :: Creature -> World -> World
footstepSideEffect cr =
case cr ^. crStance . carriage of
Walking x ff
| x > cr ^. crStance . strideLength ->
soundMultiFrom
[FootstepSound i | i <- [0 .. 10]]
(cr ^. crPos)
(chooseFootSound ff)
Nothing
.
over (cWorld . lWorld . creatures . ix (cr ^. crID) . crStance . carriage) resetStride
_ -> id
chooseFootSound :: FootForward -> SoundID
chooseFootSound LeftForward = foot1S
chooseFootSound _ = foot2S