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

Unify item inventory effects somewhat

Browse Source
This commit is contained in:
justin
2025-06-20 17:41:32 +01:00
parent fe1ac8f5a4
commit b920a2ec72
4 changed files with 262 additions and 280 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/BackgroundEffect.hs
+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