Add attached/aiming checks on item usage

src/Dodge/Creature/Impulse/UseItem.hs

@@ -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,24 +23,32 @@ 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 
+useItemLoc ::
-    -> World -> Maybe World
+    Creature ->
+    LocationLDT ItemLink ComposedItem ->
+    PressType ->
+    World ->
+    Maybe World
 useItemLoc cr loc pt w = case loc ^. locLDT . ldtValue . _2 of
-        HeldPlatformSF ->
+    HeldPlatformSF -> do
-            return $
+        guard $ fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsRoot
-                heldEffect pt (bimap _iatType (^. _1) ldt) cr w
+        guard $ cr ^. crStance . posture == Aiming
---                    & pointerToItem itm . itUse . heldHammer .~ HammerDown
+        return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
     GadgetPlatformSF ->
         return $
             heldEffect pt (bimap _iatType (^. _1) ldt) cr w
---                    & pointerToItem itm . itUse . heldHammer .~ HammerDown
+    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
---                    & pointerToItem itm . itUse . heldHammer .~ HammerDown
     _ | isJust $ itm ^? itUse . uequipEffect -> do
+        guard $ pt == InitialPress
         invid' <- itm ^? itLocation . ilInvID
         return $ toggleEquipmentAt invid' cr w
     _ -> Nothing
@@ -47,44 +56,23 @@ useItemLoc cr loc pt w = case loc ^. locLDT . ldtValue . _2 of
     ldt = loc ^. locLDT
     itm = ldt ^. ldtValue . _1
 
-useLocation :: LocationLDT ItemLink ComposedItem 
+useLocation ::
-    -> Maybe (LocationLDT ItemLink ComposedItem)
+    LocationLDT ItemLink ComposedItem ->
+    LocationLDT ItemLink ComposedItem
 useLocation loc
-    | isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uequipEffect = return loc
+    | isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uequipEffect = loc
-    | isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apLinkedProjectile . _Just
+    | isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0 =
-        = return loc
+        loc
-    | isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0 
+    | sf <- loc ^. locLDT . ldtValue . _2
-        = return loc
+      , structureUseAtLoc sf =
-    | otherwise = return $ locToTop loc
+        loc
+    | otherwise = locToTop loc
 
---useSelectedItem :: Int -> World -> World
+structureUseAtLoc :: ItemStructuralFunction -> Bool
---useSelectedItem crid w = (worldEventFlags . at InventoryChange ?~ ()) . fromMaybe w $ do
+structureUseAtLoc = \case
---    cr <- w ^? cWorld . lWorld . creatures . ix crid
+    HeldPlatformSF -> True
---    invid <- cr ^? crManipulation . manObject . imSelectedItem
+    UnderBarrelPlatformSF -> True
---    itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2
+    _ -> False
---    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
 
 activateDetonator ::
     LabelDoubleTree ItemLink ComposedItem ->
@@ -128,8 +116,9 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
             & 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

src/Dodge/Creature/YourControl.hs

@@ -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

src/Dodge/Data/Item/Combine.hs

@@ -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

src/Dodge/Data/Item/Use.hs

@@ -65,9 +65,7 @@ data TriggerType = AutoTrigger | HammerTrigger
     deriving (Eq, Show, Read)
 
 data AttachParams
-    = APLinkProjectile
+    = APProjectiles
-        {_apLinkedProjectile :: Maybe Int}
-    | APProjectiles
         {_apProjectiles :: [Int]}
     | APInt {_apInt :: Int}
     | APNothing

src/Dodge/Item/Display.hs

@@ -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

src/Dodge/Item/Scope.hs

@@ -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

src/Dodge/Projectile/Create.hs

@@ -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
+                . apProjectiles
-                ?~ i
+                .:~ i
+--                . apLinkedProjectile
+--                ?~ i
     i = IM.newKey $ w ^. cWorld . lWorld . projectiles
     dir = _crDir cr + _mzRot muz
     pos = _crPos cr +.+ rotateV dir (_mzPos muz)

src/Dodge/Projectile/Update.hs

@@ -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
+        return $ pointerToItemLocation loc . itUse . uaParams . apProjectiles %~ delete pjid
-        guard $ itm == pjid
-        return $ pointerToItemLocation loc . itUse . uaParams . apLinkedProjectile .~ Nothing
 
 doThrust :: Projectile -> Maybe RocketSmoke -> World -> World
 doThrust pj smoke w =

src/Dodge/Update/Camera.hs

@@ -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