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