138 lines
5.5 KiB
Haskell
138 lines
5.5 KiB
Haskell
module Dodge.Creature.Impulse.UseItem (
|
|
useRootItem,
|
|
useItemLeftClick,
|
|
useItemHotkey,
|
|
) where
|
|
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import Data.Maybe
|
|
import Dodge.Cuse
|
|
import Dodge.Data.ComposedItem
|
|
import Dodge.Data.DoubleTree
|
|
import Dodge.Data.World
|
|
import Dodge.Euse
|
|
import Dodge.HeldUse
|
|
import Dodge.Hotkey
|
|
import Dodge.Inventory
|
|
import Dodge.Item.Grammar
|
|
import Dodge.Item.Location
|
|
import Dodge.Luse
|
|
import Dodge.SelectUse
|
|
import qualified IntMapHelp as IM
|
|
|
|
useRootItem :: Int -> World -> World
|
|
useRootItem crid w = (worldEventFlags . at InventoryChange ?~ ()) . fromMaybe w $ do
|
|
cr <- w ^? cWorld . lWorld . creatures . ix crid
|
|
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
|
|
itmtree <- invRootTrees (_crInv cr) ^? ix itRef
|
|
let itm = itmtree ^. ldtValue . _1
|
|
case itmtree ^. ldtValue . _2 of
|
|
HeldPlatformSF ->
|
|
return $
|
|
heldEffect (bimap _iatType fst3 itmtree) cr w
|
|
& pointerToItem itm . itUse . heldHammer .~ HammerDown
|
|
GadgetPlatformSF ->
|
|
return $
|
|
heldEffect (bimap _iatType fst3 itmtree) cr w
|
|
& pointerToItem itm . itUse . heldHammer .~ HammerDown
|
|
EquipmentPlatformSF -> do
|
|
guard (_crHammerPosition cr == HammerUp)
|
|
invid <- itm ^? itLocation . ilInvID
|
|
return $ toggleEquipmentAt invid cr w
|
|
_ -> Nothing
|
|
where
|
|
fst3 (x,_,_) = x
|
|
|
|
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
|
|
& crpoint . crInv . ix invid . itLocation . ilEquipPosition ?~ newp
|
|
& onequip itm cr
|
|
-- & crpoint %~ assignNewHotkey invid
|
|
& cWorld . lWorld %~ assignNewHotkey invid
|
|
MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
|
|
w
|
|
& crpoint . crEquipment . at newp ?~ invid
|
|
& crpoint . crEquipment . at oldp .~ Nothing
|
|
-- & crpoint . crInvEquipped . at invid ?~ newp
|
|
& crpoint . crInv . ix invid . itLocation . ilEquipPosition ?~ 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 . crInv . ix invid . itLocation . ilEquipPosition ?~ newp
|
|
-- & crpoint . crInvEquipped . at sid ?~ oldp
|
|
& crpoint . crInv . ix sid . itLocation . ilEquipPosition ?~ oldp
|
|
ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
|
|
w
|
|
& crpoint . crEquipment . at newp ?~ invid
|
|
-- & crpoint . crInvEquipped . at invid ?~ newp
|
|
& crpoint . crInv . ix invid . itLocation . ilEquipPosition ?~ newp
|
|
-- & crpoint . crInvEquipped . at rid .~ Nothing
|
|
& crpoint . crInv . ix rid . itLocation . ilEquipPosition .~ Nothing
|
|
& onremove (itmat rid) cr
|
|
& onequip itm cr
|
|
-- & crpoint %~ removeHotkey rid
|
|
-- & crpoint %~ assignNewHotkey invid
|
|
& cWorld . lWorld %~ removeHotkey rid
|
|
& cWorld . lWorld %~ assignNewHotkey invid
|
|
RemoveEquipment{_allocOldPos = oldp} ->
|
|
w
|
|
& crpoint . crEquipment . at oldp .~ Nothing
|
|
-- & crpoint . crInvEquipped . at invid .~ Nothing
|
|
& crpoint . crInv . ix invid . itLocation . ilEquipPosition .~ Nothing
|
|
& onremove itm cr
|
|
-- & crpoint %~ removeHotkey invid
|
|
& cWorld . lWorld %~ removeHotkey invid
|
|
where
|
|
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
|
|
itmat i = _crInv cr IM.! i
|
|
itm = itmat itRef
|
|
itRef = cr ^?! crManipulation . manObject . imSelectedItem -- unsafe!! TODO change?
|
|
onequip itm' = doItmCrWdWd ((_eeOnEquip . _uequipEffect . _itUse) itm') itm'
|
|
onremove itm' = doItmCrWdWd ((_eeOnRemove . _uequipEffect . _itUse) itm') itm'
|
|
|
|
-- need to make sure that the root item is not erroneously selected in the
|
|
-- following
|
|
useItemLeftClick :: Creature -> World -> World
|
|
useItemLeftClick cr w = fromMaybe w $ do
|
|
guard . not $ _crInvLock cr
|
|
invid <- cr ^? crManipulation . manObject . imSelectedItem
|
|
itm <- cr ^? crInv . ix invid
|
|
ituse <- cr ^? crInv . ix invid . itUse
|
|
case ituse of
|
|
UseHeld{} -> return w
|
|
UseConsume eff -> return $ useC eff itm cr w
|
|
UseEquip{} -> return $ doequipmentchange invid
|
|
UseHotkey{} -> return $ doequipmentchange invid
|
|
UseNothing{} -> return w
|
|
UseAttach{} -> do
|
|
return $ selectUse itm cr w
|
|
_ -> Nothing
|
|
where
|
|
doequipmentchange invid = fromMaybe w $ do
|
|
guard (_crHammerPosition cr == HammerUp)
|
|
return $ toggleEquipmentAt invid cr w
|
|
|
|
-- & f
|
|
-- where
|
|
-- f = 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
|