108 lines
4.4 KiB
Haskell
108 lines
4.4 KiB
Haskell
module Dodge.Creature.Impulse.UseItem (
|
|
useSelectedItem,
|
|
) where
|
|
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import Data.Maybe
|
|
import Dodge.Data.ComposedItem
|
|
import Dodge.Data.DoubleTree
|
|
import Dodge.Data.World
|
|
import Dodge.DoubleTree
|
|
import Dodge.Euse
|
|
import Dodge.HeldUse
|
|
import Dodge.Hotkey
|
|
import Dodge.Inventory
|
|
import Dodge.Item.Grammar
|
|
import Dodge.Item.Location
|
|
import qualified IntMapHelp as IM
|
|
|
|
useSelectedItem :: Int -> World -> World
|
|
useSelectedItem crid w = (worldEventFlags . at InventoryChange ?~ ()) . fromMaybe w $ do
|
|
cr <- w ^? cWorld . lWorld . creatures . ix crid
|
|
invid <- cr ^? crManipulation . manObject . imSelectedItem
|
|
itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2
|
|
let usedloc = case useLocation itmloc of
|
|
UseFromLocation -> itmloc ^. locLDT
|
|
UseFromRoot -> locToTop itmloc ^. locLDT
|
|
let itm = usedloc ^. ldtValue . _1
|
|
case usedloc ^. ldtValue . _2 of
|
|
HeldPlatformSF ->
|
|
return $
|
|
heldEffect (bimap _iatType fst3 usedloc) cr w
|
|
& pointerToItem itm . itUse . heldHammer .~ HammerDown
|
|
GadgetPlatformSF ->
|
|
return $
|
|
heldEffect (bimap _iatType fst3 usedloc) cr w
|
|
& pointerToItem itm . itUse . heldHammer .~ HammerDown
|
|
RemoteDetonatorSF -> do
|
|
guard (_crHammerPosition cr == HammerUp)
|
|
return $ activateDetonator usedloc w
|
|
_ | isJust $ itm ^? itUse . uequipEffect -> do
|
|
guard (_crHammerPosition cr == HammerUp)
|
|
invid' <- itm ^? itLocation . ilInvID
|
|
return $ toggleEquipmentAt invid' cr w
|
|
_ -> Nothing
|
|
where
|
|
fst3 (x, _, _) = x
|
|
|
|
activateDetonator ::
|
|
LabelDoubleTree ItemLink ComposedItem ->
|
|
World ->
|
|
World
|
|
activateDetonator det = fromMaybe id $ do
|
|
pjid <- det ^? ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0
|
|
return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0
|
|
|
|
useLocation :: LocationLDT ItemLink ComposedItem -> UseFocus
|
|
useLocation loc
|
|
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uequipEffect = UseFromLocation
|
|
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apLinkedProjectile . _Just =
|
|
UseFromLocation
|
|
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0 =
|
|
UseFromLocation
|
|
| otherwise = UseFromRoot
|
|
|
|
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 . crInv . ix invid . itLocation . ilEquipSite ?~ newp
|
|
& onequip itm cr
|
|
& cWorld . lWorld %~ assignNewHotkey invid
|
|
MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
|
|
w
|
|
& crpoint . crEquipment . at newp ?~ invid
|
|
& crpoint . crEquipment . at oldp .~ Nothing
|
|
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
|
|
SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
|
|
w
|
|
& crpoint . crEquipment . at newp ?~ invid
|
|
& crpoint . crEquipment . at oldp ?~ sid
|
|
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
|
|
& crpoint . crInv . ix sid . itLocation . ilEquipSite ?~ oldp
|
|
ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
|
|
w
|
|
& crpoint . crEquipment . at newp ?~ invid
|
|
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
|
|
& crpoint . crInv . ix rid . itLocation . ilEquipSite .~ Nothing
|
|
& onremove (itmat rid) cr
|
|
& onequip itm cr
|
|
& cWorld . lWorld %~ removeHotkey rid
|
|
& cWorld . lWorld %~ assignNewHotkey invid
|
|
RemoveEquipment{_allocOldPos = oldp} ->
|
|
w
|
|
& crpoint . crEquipment . at oldp .~ Nothing
|
|
& crpoint . crInv . ix invid . itLocation . ilEquipSite .~ Nothing
|
|
& onremove itm cr
|
|
& 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'
|