Unify item inventory effects somewhat

This commit is contained in:
2025-06-20 17:41:32 +01:00
parent fe1ac8f5a4
commit b920a2ec72
4 changed files with 262 additions and 280 deletions
+20 -4
View File
@@ -3,6 +3,9 @@ module Dodge.Creature.State (
doDamage,
) where
import Dodge.Item.BackgroundEffect
import Dodge.Item.Location
import Dodge.Inventory.SelectionList
import Control.Applicative
import Control.Monad
import qualified Data.Map.Strict as M
@@ -23,7 +26,6 @@ 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
@@ -145,9 +147,7 @@ applyPastDamages cr w
-- a loop going over all inventory items
invSideEff :: Creature -> World -> World
invSideEff cr = alaf Endo foldMap f (_crInv cr) . updateHeldRootItem cr
where
f it = itBackgroundEffect it cr
invSideEff cr = updateHeldRootItem cr
-- a loop going over all root inventory items
invRootItemEffs :: Creature -> World -> World
@@ -161,6 +161,11 @@ invItemLocUpdate :: Creature -> LocationLDT ItemLink ComposedItem -> World -> Wo
invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
ATTACH BULLETSYNTH -> trySynthBullet loc w
EQUIP WRIST_ECG | haspulse -> tryUseParent loc w
COPIER _ -> copierItemUpdate itm cr w
HELD FLATSHIELD -> rootNotrootEff createShieldWall removeShieldWall itm cr w
HELD MINIGUNX{} ->
w & pointerToItem itm . itParams . wTime
%~ (max 0 . subtract 1)
_ -> w
where
haspulse =
@@ -168,6 +173,17 @@ invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
== Just 0
itm = loc ^. locLDT . ldtValue . _1
copierItemUpdate :: Item -> Creature -> World -> World
copierItemUpdate itm cr w = fromMaybe w $ do
x <- itm ^? itScroll . itsInt
invid <- itm ^? itLocation . ilInvID
ip <- itm ^? itType . ibtPathing
i <- getInventoryPath x ip invid cr
itm' <- cr ^? crInv . ix i
v <- getItemValue itm' w cr
return $ w & pointerToItem itm . itUse . uValue .~ v
doAnyEquipmentEffect :: LocationLDT ItemLink ComposedItem -> Creature -> World -> World
doAnyEquipmentEffect loc cr = case itm ^? itLocation . ilEquipSite . _Just of
Just _ -> equipBackgroundEffect loc cr
-2
View File
@@ -119,9 +119,7 @@ useTimeCheck f item cr w = case useDelay $ item ^. ldtValue of
FixedRate rate
| w ^. cWorld . lWorld . lClock - rate > lastused -> f item cr $ setUseRate w
FixedRate{} -> w
--Just (WarmUpNoDelay wt wm ws)
WarmUpNoDelay wm ws
-- | wt < wm ->
| _wTime (_itParams $ _ldtValue item) < wm ->
w
& soundContinue (CrWeaponSound cid 0) (_crPos cr) ws (Just 2)
+14 -33
View File
@@ -1,13 +1,12 @@
module Dodge.Item.BackgroundEffect (
itBackgroundEffect,
itEffectOnPickup,
itEffectOnDrop,
rootNotrootEff,
createShieldWall,
removeShieldWall,
) where
import Dodge.Creature.Radius
import Dodge.Inventory.SelectionList
--import Dodge.Inventory.Path
import Data.Maybe
import Color
import Dodge.Default.Wall
import Dodge.Wall.Delete
@@ -20,45 +19,25 @@ import Dodge.Item.Location
import Dodge.Data.World
import Control.Lens
itBackgroundEffect :: Item -> Creature -> World -> World
itBackgroundEffect itm cr w = case itm ^. itType of
COPIER _ -> copierItemUpdate' itm cr w
ITEMSCAN -> cancelExamineInventory' w
HELD FLATSHIELD -> rootNotrootEff' createShieldWall' removeShieldWall' itm cr w
HELD MINIGUNX{} ->
w & pointerToItem itm . itParams . wTime
%~ (max 0 . subtract 1)
_ -> w
copierItemUpdate' :: Item -> Creature -> World -> World
copierItemUpdate' itm cr w = fromMaybe w $ do
x <- itm ^? itScroll . itsInt
invid <- itm ^? itLocation . ilInvID
ip <- itm ^? itType . ibtPathing
i <- getInventoryPath x ip invid cr
itm' <- cr ^? crInv . ix i
v <- getItemValue itm' w cr
return $ w & pointerToItem itm . itUse . uValue .~ v
cancelExamineInventory' :: World -> World
cancelExamineInventory' = hud . hudElement . subInventory %~ f
cancelExamineInventory :: World -> World
cancelExamineInventory = hud . hudElement . subInventory %~ f
where
f ExamineInventory = NoSubInventory
f x = x
rootNotrootEff' ::
rootNotrootEff ::
(Item -> Creature -> World -> World) ->
(Item -> Creature -> World -> World) ->
Item ->
Creature ->
World ->
World
rootNotrootEff' f g it
rootNotrootEff f g it
| it ^? itLocation . ilIsRoot == Just True = f it
| otherwise = g it
createShieldWall' :: Item -> Creature -> World -> World
createShieldWall' it cr w = case it ^? itParams . flatShieldWlMIX . _Just of
createShieldWall :: Item -> Creature -> World -> World
createShieldWall it cr w = case it ^? itParams . flatShieldWlMIX . _Just of
Nothing ->
let (wlid, w') = createWall ((shieldWall' crid){_wlLine = wlline, _wlID = wlid}) w
in w' & pointerToItem it . itParams .~ FlatShieldParams (Just wlid)
@@ -75,8 +54,8 @@ createShieldWall' it cr w = case it ^? itParams . flatShieldWlMIX . _Just of
| crIsAiming cr = vNormal
| otherwise = rotateV (twoFlatHRot cr) . vNormal
removeShieldWall' :: Item -> Creature -> World -> World
removeShieldWall' it _ w = case it ^? itParams . flatShieldWlMIX . _Just of
removeShieldWall :: Item -> Creature -> World -> World
removeShieldWall it _ w = case it ^? itParams . flatShieldWlMIX . _Just of
Nothing -> w
Just wid ->
w & deleteWallID wid
@@ -86,8 +65,10 @@ itEffectOnPickup :: Item -> Creature -> World -> World
itEffectOnPickup _ _ = id
itEffectOnDrop :: Item -> Creature -> World -> World
itEffectOnDrop itm _ w = case itm ^. itType of
itEffectOnDrop itm cr w = case itm ^. itType of
HELD MINIGUNX{} -> w & pointerToItemID (_itID itm) . itParams . wTime .~ 0
ITEMSCAN -> cancelExamineInventory w
HELD FLATSHIELD -> removeShieldWall itm cr w
_ -> w
shieldWall' :: Int -> Wall