121 lines
4.5 KiB
Haskell
121 lines
4.5 KiB
Haskell
--{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.Creature.Impulse.UseItem (useItem) where
|
|
|
|
import qualified Data.IntSet as IS
|
|
import Dodge.Euse
|
|
import NewInt
|
|
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
|
|
|
|
--note :: a -> Maybe b -> Either a b
|
|
--note x = maybe (Left x) Right
|
|
|
|
useItem :: Int -> Int -> World -> Maybe World
|
|
useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
|
|
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
|
itmloc <- invIndents ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
|
|
^? ix invid . _2
|
|
useItemLoc cr itmloc pt w
|
|
|
|
useItemLoc :: Creature -> LocationDT OItem -> Int -> World -> Maybe World
|
|
useItemLoc cr loc pt w
|
|
| aimuse
|
|
, fromMaybe False $ do
|
|
i <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
|
|
is <- w ^? hud . manObject . hiAttachedItems
|
|
return $ i `IS.member` is
|
|
, Aiming{} <- cr ^. crStance . posture =
|
|
return $ gadgetEffect pt loc cr w
|
|
| GadgetPlatformSF <- sf =
|
|
return $ gadgetEffect pt loc cr w
|
|
| RemoteDetonatorSF <- sf
|
|
, pt == 0 =
|
|
return $ activateDetonator ldt w
|
|
| ITEMSCAN <- itm ^. itType
|
|
, pt == 0 =
|
|
return $ toggleExamineInv w
|
|
| MAPPER <- itm ^. itType
|
|
, pt == 0 =
|
|
return $ toggleMapperInv itm w
|
|
| Just b <- itm ^? itUse . useToggle
|
|
, pt == 0 =
|
|
return $ w & pointerToItem itm . itUse . useToggle .~ not b
|
|
| isJust $ itm ^? itType . ibtEquip
|
|
, pt == 0
|
|
, Just invid <- itm ^? itLocation . ilInvID =
|
|
return $ toggleEquipmentAt invid cr w
|
|
| otherwise = (\loc' -> useItemLoc cr loc' pt w) =<< locUp' loc
|
|
where
|
|
aimuse
|
|
| LaserWeaponXSF {} <- sf = True
|
|
| HeldPlatformSF <- sf = True
|
|
| PulseBallSF <- sf = True
|
|
| PlasmaSF <- sf = True
|
|
| UnderBarrelPlatformSF <- sf = True
|
|
| otherwise = False
|
|
sf = loc ^. locDT . dtValue . _2
|
|
ldt = loc ^. locDT
|
|
itm = ldt ^. dtValue . _1
|
|
|
|
activateDetonator :: DTree OItem -> World -> World
|
|
activateDetonator det = fromMaybe id $ do
|
|
pjid <- det ^? dtValue . _1 . itUse . uaParams . apProjectiles . ix 0
|
|
return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0
|
|
|
|
toggleEquipmentAt :: NewInt InvInt -> Creature -> World -> World
|
|
toggleEquipmentAt invid cr w = case equipmentDesignation invid w of
|
|
DoNotMoveEquipment -> w
|
|
PutOnEquipment{_allocNewPos = newp} ->
|
|
w
|
|
& toequipment . at newp ?~ NInt itid
|
|
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
|
|
& effectOnEquip itm cr
|
|
MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
|
|
w
|
|
& toequipment . at newp ?~ NInt itid
|
|
& toequipment . at oldp .~ Nothing
|
|
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
|
|
SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
|
|
w
|
|
& toequipment . at newp ?~ NInt itid
|
|
& toequipment . at oldp ?~ sid
|
|
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
|
|
& toitems . ix (_unNInt sid) . itLocation . ilEquipSite ?~ oldp
|
|
ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
|
|
w
|
|
& toequipment . at newp ?~ NInt itid
|
|
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
|
|
& toitems . ix (_unNInt rid) . itLocation . ilEquipSite .~ Nothing
|
|
& effectOnRemove (itmat rid) cr
|
|
& effectOnEquip itm cr
|
|
RemoveEquipment{_allocOldPos = oldp} ->
|
|
w
|
|
& toequipment . at oldp .~ Nothing
|
|
& toitems . ix itid . itLocation . ilEquipSite .~ Nothing
|
|
& effectOnRemove itm cr
|
|
where
|
|
toitems = cWorld . lWorld . items
|
|
itid = cr ^?! crInv . ix invid
|
|
toequipment = cWorld . lWorld . creatures . ix (_crID cr) . crEquipment
|
|
itmat i = w ^?! cWorld . lWorld . items . ix (_unNInt i)
|
|
itm = w ^?! cWorld . lWorld . items . ix itid
|
|
|
|
toggleExamineInv :: World -> World
|
|
toggleExamineInv w = case w ^? hud . subInventory of
|
|
Just ExamineInventory{} -> w & hud . subInventory .~ NoSubInventory
|
|
_ -> w & hud . subInventory .~ ExamineInventory
|
|
|
|
toggleMapperInv :: Item -> World -> World
|
|
toggleMapperInv itm w = case w ^? hud . subInventory of
|
|
Just MapperInventory{} -> w & hud . subInventory .~ NoSubInventory
|
|
_ -> w & hud . subInventory .~ MapperInventory 0 1 (_itID itm)
|