Add attached/aiming checks on item usage
This commit is contained in:
@@ -1,10 +1,11 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Dodge.Creature.Impulse.UseItem (
|
||||
useItem,
|
||||
-- useSelectedItem,
|
||||
) where
|
||||
|
||||
import Control.Lens
|
||||
--import Control.Monad
|
||||
import Control.Monad
|
||||
import Data.Maybe
|
||||
import Dodge.Data.ComposedItem
|
||||
import Dodge.Data.DoubleTree
|
||||
@@ -22,69 +23,56 @@ useItem :: Int -> PressType -> World -> World
|
||||
useItem invid pt w = (worldEventFlags . at InventoryChange ?~ ()) . fromMaybe w $ do
|
||||
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
||||
itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2
|
||||
usedloc <- useLocation itmloc
|
||||
let usedloc = useLocation itmloc
|
||||
useItemLoc cr usedloc pt w
|
||||
|
||||
useItemLoc :: Creature -> LocationLDT ItemLink ComposedItem -> PressType
|
||||
-> World -> Maybe World
|
||||
useItemLoc ::
|
||||
Creature ->
|
||||
LocationLDT ItemLink ComposedItem ->
|
||||
PressType ->
|
||||
World ->
|
||||
Maybe World
|
||||
useItemLoc cr loc pt w = case loc ^. locLDT . ldtValue . _2 of
|
||||
HeldPlatformSF ->
|
||||
return $
|
||||
heldEffect pt (bimap _iatType (^. _1) ldt) cr w
|
||||
-- & pointerToItem itm . itUse . heldHammer .~ HammerDown
|
||||
GadgetPlatformSF ->
|
||||
return $
|
||||
heldEffect pt (bimap _iatType (^. _1) ldt) cr w
|
||||
-- & pointerToItem itm . itUse . heldHammer .~ HammerDown
|
||||
RemoteDetonatorSF -> do
|
||||
return $ activateDetonator ldt w
|
||||
-- & pointerToItem itm . itUse . heldHammer .~ HammerDown
|
||||
_ | isJust $ itm ^? itUse . uequipEffect -> do
|
||||
invid' <- itm ^? itLocation . ilInvID
|
||||
return $ toggleEquipmentAt invid' cr w
|
||||
_ -> Nothing
|
||||
HeldPlatformSF -> do
|
||||
guard $ fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsRoot
|
||||
guard $ cr ^. crStance . posture == Aiming
|
||||
return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
|
||||
GadgetPlatformSF ->
|
||||
return $
|
||||
heldEffect pt (bimap _iatType (^. _1) ldt) cr w
|
||||
UnderBarrelPlatformSF -> do
|
||||
guard $ fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
|
||||
guard $ cr ^. crStance . posture == Aiming
|
||||
return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
|
||||
RemoteDetonatorSF -> do
|
||||
guard $ pt == InitialPress
|
||||
return $ activateDetonator ldt w
|
||||
_ | isJust $ itm ^? itUse . uequipEffect -> do
|
||||
guard $ pt == InitialPress
|
||||
invid' <- itm ^? itLocation . ilInvID
|
||||
return $ toggleEquipmentAt invid' cr w
|
||||
_ -> Nothing
|
||||
where
|
||||
ldt = loc ^. locLDT
|
||||
itm = ldt ^. ldtValue . _1
|
||||
|
||||
useLocation :: LocationLDT ItemLink ComposedItem
|
||||
-> Maybe (LocationLDT ItemLink ComposedItem)
|
||||
useLocation ::
|
||||
LocationLDT ItemLink ComposedItem ->
|
||||
LocationLDT ItemLink ComposedItem
|
||||
useLocation loc
|
||||
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uequipEffect = return loc
|
||||
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apLinkedProjectile . _Just
|
||||
= return loc
|
||||
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0
|
||||
= return loc
|
||||
| otherwise = return $ locToTop loc
|
||||
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uequipEffect = loc
|
||||
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0 =
|
||||
loc
|
||||
| sf <- loc ^. locLDT . ldtValue . _2
|
||||
, structureUseAtLoc sf =
|
||||
loc
|
||||
| otherwise = locToTop loc
|
||||
|
||||
--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
|
||||
-- return $ activateDetonator usedloc w
|
||||
-- & pointerToItem itm . itUse . heldHammer .~ HammerDown
|
||||
-- _ | isJust $ itm ^? itUse . uequipEffect -> do
|
||||
---- guard (_crHammerPosition cr == HammerUp)
|
||||
-- invid' <- itm ^? itLocation . ilInvID
|
||||
-- return $ toggleEquipmentAt invid' cr w
|
||||
-- _ -> Nothing
|
||||
-- where
|
||||
-- fst3 (x, _, _) = x
|
||||
structureUseAtLoc :: ItemStructuralFunction -> Bool
|
||||
structureUseAtLoc = \case
|
||||
HeldPlatformSF -> True
|
||||
UnderBarrelPlatformSF -> True
|
||||
_ -> False
|
||||
|
||||
activateDetonator ::
|
||||
LabelDoubleTree ItemLink ComposedItem ->
|
||||
@@ -102,7 +90,7 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
|
||||
& crpoint . crEquipment . at newp ?~ invid
|
||||
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
|
||||
& onequip itm cr
|
||||
-- & cWorld . lWorld %~ assignNewHotkey invid
|
||||
-- & cWorld . lWorld %~ assignNewHotkey invid
|
||||
MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
|
||||
w
|
||||
& crpoint . crEquipment . at newp ?~ invid
|
||||
@@ -121,15 +109,16 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
|
||||
& crpoint . crInv . ix rid . itLocation . ilEquipSite .~ Nothing
|
||||
& onremove (itmat rid) cr
|
||||
& onequip itm cr
|
||||
-- & cWorld . lWorld %~ removeHotkey rid
|
||||
-- & cWorld . lWorld %~ assignNewHotkey invid
|
||||
-- & 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
|
||||
-- & cWorld . lWorld %~ removeHotkey invid
|
||||
|
||||
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
|
||||
itmat i = _crInv cr IM.! i
|
||||
itm = itmat itRef
|
||||
|
||||
@@ -53,9 +53,6 @@ useHotkey w (NInt itid, pt) = fromMaybe w $ do
|
||||
invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
|
||||
return $ useItem invid pt w
|
||||
|
||||
--allHotkeys :: [SDL.Scancode]
|
||||
--allHotkeys = map hotkeyToScancode [minBound .. maxBound]
|
||||
|
||||
hotkeyToScancode :: Hotkey -> SDL.Scancode
|
||||
hotkeyToScancode x = case x of
|
||||
HotkeyQ -> SDL.ScancodeQ
|
||||
|
||||
@@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
--{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE StrictData #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
@@ -15,7 +14,6 @@ import Dodge.Data.Item.Targeting
|
||||
|
||||
data ItemType
|
||||
= HELD {_ibtHeld :: HeldItemType}
|
||||
-- | LEFT {_ibtLeft :: LeftItemType}
|
||||
| EQUIP {_ibtEquip :: EquipItemType}
|
||||
| CRAFT {_ibtCraft :: CraftType}
|
||||
| ATTACH {_ibtAttach :: AttachType}
|
||||
@@ -115,12 +113,6 @@ data EquipItemType
|
||||
| WRIST_ECG
|
||||
deriving (Eq, Ord, Show, Read)
|
||||
|
||||
--data LeftItemType
|
||||
-- = STOPWATCH
|
||||
-- | SCROLLWATCH
|
||||
-- | SPAWNER
|
||||
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
||||
|
||||
data HeldItemType
|
||||
= BANGSTICK {_xNum :: Int}
|
||||
| REWINDER
|
||||
|
||||
@@ -65,9 +65,7 @@ data TriggerType = AutoTrigger | HammerTrigger
|
||||
deriving (Eq, Show, Read)
|
||||
|
||||
data AttachParams
|
||||
= APLinkProjectile
|
||||
{_apLinkedProjectile :: Maybe Int}
|
||||
| APProjectiles
|
||||
= APProjectiles
|
||||
{_apProjectiles :: [Int]}
|
||||
| APInt {_apInt :: Int}
|
||||
| APNothing
|
||||
|
||||
@@ -102,7 +102,7 @@ itemNumberDisplay cr ci
|
||||
["!TARG!"]
|
||||
| Just x <- ci ^? _1 . itConsumables . magLoadStatus . iaLoaded = [shortShow x]
|
||||
| UseAttach (APInt i) <- ci ^. _1 . itUse = [show i]
|
||||
| UseAttach (APLinkProjectile i) <- ci ^. _1 . itUse = [show i]
|
||||
-- | UseAttach (APLinkProjectile i) <- ci ^. _1 . itUse = [show i]
|
||||
| UseAttach (APProjectiles x) <- ci ^. _1 . itUse = [show x]
|
||||
| UseScope OpticScope{_opticZoom = x} <- ci ^. _1 . itUse = [shortShow x]
|
||||
| otherwise = mempty
|
||||
|
||||
@@ -69,7 +69,8 @@ augmentedHUD = makeAttach AUGMENTEDHUD
|
||||
|
||||
remoteScreen :: Item
|
||||
remoteScreen = makeAttach REMOTESCREEN
|
||||
& itUse . uaParams .~ APLinkProjectile Nothing
|
||||
-- & itUse . uaParams .~ APLinkProjectile Nothing
|
||||
& itUse . uaParams .~ APProjectiles []
|
||||
|
||||
remoteDetonator :: Item
|
||||
remoteDetonator = makeAttach REMOTEDETONATOR
|
||||
|
||||
@@ -72,8 +72,10 @@ createShell mdetonator mscreen stab pjtype payload muz cr w = w
|
||||
updatescreen = fromMaybe id $ do
|
||||
screenid <- mscreen
|
||||
return $ pointerToItemID screenid . itUse . uaParams
|
||||
. apLinkedProjectile
|
||||
?~ i
|
||||
. apProjectiles
|
||||
.:~ i
|
||||
-- . apLinkedProjectile
|
||||
-- ?~ i
|
||||
i = IM.newKey $ w ^. cWorld . lWorld . projectiles
|
||||
dir = _crDir cr + _mzRot muz
|
||||
pos = _crPos cr +.+ rotateV dir (_mzPos muz)
|
||||
|
||||
@@ -3,7 +3,6 @@ module Dodge.Projectile.Update (
|
||||
updateProjectile,
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Data.Foldable
|
||||
import Data.List (delete)
|
||||
import Data.Maybe
|
||||
@@ -118,9 +117,7 @@ destroyProjectile mitid pjid w =
|
||||
removelink = fromMaybe id $ do
|
||||
itid <- fmap _unNInt mitid
|
||||
loc <- w ^? cWorld . lWorld . itemLocations . ix itid
|
||||
itm <- w ^? pointerToItemLocation loc . itUse . uaParams . apLinkedProjectile . _Just
|
||||
guard $ itm == pjid
|
||||
return $ pointerToItemLocation loc . itUse . uaParams . apLinkedProjectile .~ Nothing
|
||||
return $ pointerToItemLocation loc . itUse . uaParams . apProjectiles %~ delete pjid
|
||||
|
||||
doThrust :: Projectile -> Maybe RocketSmoke -> World -> World
|
||||
doThrust pj smoke w =
|
||||
|
||||
@@ -58,7 +58,7 @@ translateFloatingCamera theinput cam = fromMaybe cam $ do
|
||||
cam & camCenter +~ thetran
|
||||
& camViewFrom +~ thetran
|
||||
else do
|
||||
a <- (theinput ^. heldPos . at SDL.ButtonRight)
|
||||
a <- theinput ^. heldPos . at SDL.ButtonRight
|
||||
return $ cam & camRot -~ angleBetween (theinput ^. mousePos) a
|
||||
|
||||
translateFloatingCameraKeys :: Input -> Camera -> Camera
|
||||
@@ -93,7 +93,8 @@ moveZoomCamera cfig theinput cr w campos =
|
||||
where
|
||||
mremotepos = do
|
||||
i <- cr ^? crManipulation . manObject . imSelectedItem
|
||||
j <- cr ^? crInv . ix i . itUse . uaParams . apLinkedProjectile . _Just
|
||||
j <- cr ^? crInv . ix i . itUse . uaParams . apProjectiles . ix 0
|
||||
guard $ Just REMOTESCREEN == cr ^? crInv . ix i . itType . ibtAttach
|
||||
w ^? cWorld . lWorld . projectiles . ix j . pjPos
|
||||
docamrot = rotateV (campos ^. camRot)
|
||||
offset = fromMaybe noscopeoffset $ do
|
||||
|
||||
Reference in New Issue
Block a user