132 lines
5.2 KiB
Haskell
132 lines
5.2 KiB
Haskell
module Dodge.Creature.Impulse.UseItem (
|
|
useItemRightClick,
|
|
useItemLeftClick,
|
|
itemEffect,
|
|
useItemHotkey,
|
|
) where
|
|
|
|
import Dodge.Item.Grammar
|
|
import Dodge.Data.ComposedItem
|
|
import Dodge.Data.DoubleTree
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import Data.Foldable
|
|
import Data.Maybe
|
|
import Dodge.Cuse
|
|
import Dodge.Data.World
|
|
import Dodge.Euse
|
|
import Dodge.HeldUse
|
|
import Dodge.Hotkey
|
|
import Dodge.Inventory
|
|
import Dodge.Item.Location
|
|
import Dodge.Luse
|
|
import qualified IntMapHelp as IM
|
|
|
|
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 <- invTrees (_crInv cr) ^? ix itRef
|
|
return $
|
|
itemEffect cr it w
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
& f
|
|
where
|
|
f = cWorld . lWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
|
|
|
|
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) 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 (_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
|
|
_ -> w & setuhamdown
|
|
setuhamdown = cWorld . lWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
|
|
doequipmentchange = hammerTest $ toggleEquipmentAt itRef cr
|
|
|
|
toggleEquipmentAt :: Int -> Creature -> World -> World
|
|
toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
|
|
DoNotMoveEquipment -> w
|
|
PutOnEquipment{_allocNewPos = newp} ->
|
|
w
|
|
& crpoint . crEquipment . at newp ?~ invid
|
|
& crpoint . crInvEquipped . at invid ?~ newp
|
|
& onequip itm cr
|
|
& crpoint %~ assignNewHotkey invid
|
|
MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
|
|
w
|
|
& crpoint . crEquipment . at newp ?~ invid
|
|
& crpoint . crEquipment . at oldp .~ Nothing
|
|
& crpoint . crInvEquipped . at invid ?~ newp
|
|
SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
|
|
w
|
|
& crpoint . crEquipment . at newp ?~ invid
|
|
& crpoint . crEquipment . at oldp ?~ sid
|
|
& crpoint . crInvEquipped . at invid ?~ newp
|
|
& crpoint . crInvEquipped . at sid ?~ oldp
|
|
ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
|
|
w
|
|
& crpoint . crEquipment . at newp ?~ invid
|
|
& crpoint . crInvEquipped . at invid ?~ newp
|
|
& crpoint . crInvEquipped . at rid .~ Nothing
|
|
& onremove (itmat rid) cr
|
|
& onequip itm cr
|
|
& crpoint %~ removeHotkey rid
|
|
& crpoint %~ assignNewHotkey invid
|
|
RemoveEquipment{_allocOldPos = oldp} ->
|
|
w
|
|
& crpoint . crEquipment . at oldp .~ Nothing
|
|
& crpoint . crInvEquipped . at invid .~ Nothing
|
|
& onremove itm cr
|
|
& crpoint %~ removeHotkey invid
|
|
where
|
|
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
|
|
itmat i = _crInv cr IM.! i
|
|
itm = itmat itRef
|
|
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change?
|
|
onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
|
|
onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm'
|
|
|
|
useItemLeftClick :: Creature -> World -> World
|
|
useItemLeftClick cr w = fromMaybe w $ do
|
|
guard . not $ _crInvLock cr
|
|
invid <- cr ^? crManipulation . manObject . inInventory . ispItem
|
|
ituse <- cr ^? crInv . ix invid . itUse
|
|
case ituse of
|
|
--HeldUse{} -> return $ hammerTest (cWorld . lWorld . creatures . ix (_crID cr) %~ crReloadToggle)
|
|
HeldUse{} -> return w
|
|
ConsumeUse{} -> return $ useItemRightClick cr w
|
|
EquipUse{} -> return $ useItemRightClick cr w
|
|
LeftUse{} -> return $ useItemRightClick cr w
|
|
AmmoMagUse{} -> return w
|
|
--AmmoMagUse{} -> return $ hammerTest (cWorld . lWorld . creatures . ix (_crID cr) %~ crReloadToggle)
|
|
_ -> Nothing
|
|
where
|
|
--hammerTest f = case _crHammerPosition cr of
|
|
-- HammerUp -> f w & setuhamdown
|
|
-- _ -> w & setuhamdown
|
|
--setuhamdown = cWorld . lWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
|
|
|
|
useItemHotkey :: Int -> Int -> World -> World
|
|
useItemHotkey crid invid w = fromMaybe w $ do
|
|
cr <- w ^? cWorld . lWorld . creatures . ix crid
|
|
itm <- cr ^? crInv . ix invid
|
|
luse <- itm ^? itUse . leftUse
|
|
return $
|
|
w
|
|
& cWorld . lWorld . creatures . ix crid . crInv . ix invid . itUse . leftHammer .~ HammerDown
|
|
& useL luse itm cr
|
|
|
|
-- TODO determine itmShouldBeUsed with reference to config options
|