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

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