Move towards working implementation of attachment tree ammo

This commit is contained in:
2024-09-14 10:44:35 +01:00
parent 51e133ebc1
commit cde7bc9aef
13 changed files with 496 additions and 351 deletions
+10 -11
View File
@@ -5,6 +5,9 @@ module Dodge.Creature.Impulse.UseItem (
useItemHotkey,
) where
import Dodge.Item.Grammar
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Control.Lens
import Control.Monad
import Data.Foldable
@@ -23,7 +26,7 @@ useItemRightClick :: Creature -> World -> World
useItemRightClick cr' w = fromMaybe (f w) $ do
cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr')
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
it <- cr ^? crInv . ix itRef
it <- invTrees (_crInv cr) ^? ix itRef
return $
itemEffect cr it w
& worldEventFlags . at InventoryChange ?~ ()
@@ -31,24 +34,20 @@ useItemRightClick cr' w = fromMaybe (f w) $ do
where
f = cWorld . lWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
getAmmoMags :: Item -> Creature -> [Item]
getAmmoMags itm cr = fromMaybe [] $ do
i <- itm ^? itLocation . ipInvID
return $ cr ^.. crInv . dropping (i + 1) traverse
itemEffect :: Creature -> Item -> World -> World
itemEffect cr it w = case it ^. itUse of
itemEffect :: Creature -> LabelDoubleTree ComposeLinkType Item -> World -> World
itemEffect cr it w = case it ^. ldtValue . itUse of
HeldUse{_heldUse = eff, _heldMods = usemods} ->
foldl' (&) (useHeld eff) (useMod usemods) (getAmmoMags it cr) it cr w
& pointerToItem it . itUse . heldHammer .~ HammerDown
foldl' (&) (useHeld eff) (useMod usemods) it cr w
& pointerToItem itm . itUse . heldHammer .~ HammerDown
LeftUse{} -> doequipmentchange
EquipUse{} -> doequipmentchange
-- ConsumeUse will cause problems if the item is not selected
(ConsumeUse eff) -> useC eff it cr $ rmInvItem (_crID cr) itRef w
(ConsumeUse eff) -> useC eff (_ldtValue it) cr $ rmInvItem (_crID cr) itRef w
CraftUse{} -> w
AttachUse{} -> w
AmmoMagUse{} -> w
where
itm = it ^. ldtValue
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
hammerTest f = case _crHammerPosition cr of
HammerUp -> f w & setuhamdown