Unify item inventory effects somewhat
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user