141 lines
5.3 KiB
Haskell
141 lines
5.3 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.Creature.Impulse.UseItem (
|
|
useItem,
|
|
) where
|
|
|
|
import Dodge.Equipment
|
|
import Control.Lens
|
|
import Data.Maybe
|
|
import Dodge.Data.ComposedItem
|
|
import Dodge.Data.DoubleTree
|
|
import Dodge.Data.World
|
|
import Dodge.DoubleTree
|
|
import Dodge.HeldUse
|
|
import Dodge.Inventory
|
|
import Dodge.Item.Grammar
|
|
import Dodge.Item.Location
|
|
import qualified IntMapHelp as IM
|
|
|
|
useItem :: Int -> PressType -> World -> Maybe World
|
|
useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
|
|
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
|
itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2
|
|
let usedloc = useLocation itmloc
|
|
useItemLoc cr usedloc pt w
|
|
|
|
useItemLoc ::
|
|
Creature ->
|
|
LocationLDT ItemLink ComposedItem ->
|
|
PressType ->
|
|
World ->
|
|
Maybe World
|
|
useItemLoc cr loc pt w
|
|
| HeldPlatformSF <- sf
|
|
, fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsRoot
|
|
, Aiming {} <- cr ^. crStance . posture =
|
|
return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
|
|
| GadgetPlatformSF <- sf =
|
|
return $ gadgetEffect pt loc cr w
|
|
| UnderBarrelPlatformSF <- sf
|
|
, fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
|
|
, Aiming {} <- cr ^. crStance . posture =
|
|
return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
|
|
| RemoteDetonatorSF <- sf
|
|
, pt == InitialPress =
|
|
return $ activateDetonator ldt w
|
|
| ITEMSCAN <- itm ^. itType
|
|
, pt == InitialPress =
|
|
return $ toggleExamineInv w
|
|
| MAPPER <- itm ^. itType
|
|
, pt == InitialPress =
|
|
return $ toggleMapperInv itm w
|
|
| Just b <- itm ^? itUse . useToggle
|
|
, pt == InitialPress =
|
|
return $ w & pointerToItem itm . itUse . useToggle .~ not b
|
|
| isJust $ itm ^? itType . ibtEquip
|
|
, pt == InitialPress
|
|
, Just invid' <- itm ^? itLocation . ilInvID =
|
|
return $ toggleEquipmentAt invid' cr w
|
|
| otherwise = Nothing
|
|
where
|
|
sf = loc ^. locLDT . ldtValue . _2
|
|
ldt = loc ^. locLDT
|
|
itm = ldt ^. ldtValue . _1
|
|
|
|
useLocation :: LocationLDT ItemLink ComposedItem -> LocationLDT ItemLink ComposedItem
|
|
useLocation loc
|
|
| isJust $ loc ^? locLDT . ldtValue . _1 . itType . ibtEquip = loc
|
|
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0 =
|
|
loc
|
|
| sf <- loc ^. locLDT . ldtValue . _2
|
|
, structureUseAtLoc sf =
|
|
loc
|
|
| otherwise = locToTop loc
|
|
|
|
structureUseAtLoc :: ItemStructuralFunction -> Bool
|
|
structureUseAtLoc = \case
|
|
HeldPlatformSF -> True
|
|
UnderBarrelPlatformSF -> True
|
|
GadgetPlatformSF -> True
|
|
MapperSF -> True
|
|
_ -> False
|
|
|
|
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
|
|
|
|
toggleEquipmentAt :: Int -> Creature -> World -> World
|
|
toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
|
|
DoNotMoveEquipment -> w
|
|
PutOnEquipment{_allocNewPos = newp} ->
|
|
w
|
|
& crpoint . crEquipment . at newp ?~ invid
|
|
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
|
|
& onequip itm cr
|
|
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
|
|
RemoveEquipment{_allocOldPos = oldp} ->
|
|
w
|
|
& crpoint . crEquipment . at oldp .~ Nothing
|
|
& crpoint . crInv . ix invid . itLocation . ilEquipSite .~ Nothing
|
|
& onremove itm cr
|
|
where
|
|
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
|
|
itmat i = _crInv cr IM.! i
|
|
itm = itmat invid
|
|
--onequip itm' = doItmCrWdWd ((_eeOnEquip . _uequipEffect . _itUse) itm') itm'
|
|
onequip itm' = effectOnEquip itm'
|
|
--onremove itm' = doItmCrWdWd ((_eeOnRemove . _uequipEffect . _itUse) itm') itm'
|
|
onremove itm' = effectOnRemove itm'
|
|
|
|
toggleExamineInv :: World -> World
|
|
toggleExamineInv w = case w ^? hud . hudElement . subInventory of
|
|
Just ExamineInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
|
|
_ -> w & hud . hudElement . subInventory .~ ExamineInventory
|
|
|
|
toggleMapperInv :: Item -> World -> World
|
|
toggleMapperInv itm w = case w ^? hud . hudElement . subInventory of
|
|
Just MapperInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
|
|
_ -> w & hud . hudElement . subInventory .~ MapperInventory 0 1 (_itID itm)
|