Add attached/aiming checks on item usage

This commit is contained in:
2025-01-01 11:36:33 +00:00
parent 99114c7351
commit 91111fc89c
10 changed files with 393 additions and 423 deletions
+49 -60
View File
@@ -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
-3
View File
@@ -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
-8
View File
@@ -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
+1 -3
View File
@@ -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
+1 -1
View File
@@ -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
+2 -1
View File
@@ -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
+4 -2
View File
@@ -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)
+1 -4
View File
@@ -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 =
+3 -2
View File
@@ -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
+332 -339
View File
File diff suppressed because it is too large Load Diff